Added a new library to grass called ccmath (LGPL license) to replace the

NR algorithms of the gmath library.
Moved the linear equation solver code from gpde lib to gmath lib.
Added blas level 1, 2 and 3 algorithm in gmath lib.
Modified the gmath solver to use the grass blas implementation.
Added wrapper for ATLAS blas level 1 algorithms.
Updated the gpde library tests.
Added gmath library tests for the numerical part and ccmath wrapper.
Modified the groundwater flow modules (raster, raster3d)to use the gmath
solver.
Patched i.cca, i.pca and i.smap to use gmath vecotr and matrix functions
and the ccmath wrapper for eigen value computation.
Removed NR svd and eigen value code.



git-svn-id: https://svn.osgeo.org/grass/grass/trunk@39389 15284696-431f-4ddb-bdfa-cd5b030d7da7

imagery/i.cca/local_proto.h

@@ -3,22 +3,19 @@
 
 #include <grass/raster.h>
 
-#define MX 9
-#define MC 50
-
 /* matrix.c */
-int product(double[MX], double, double[MX][MX], int);
-int setdiag(double[MX], int, double[MX][MX]);
-int getsqrt(double[MX][MX], int, double[MX][MX], double[MX][MX]);
-int solveq(double[MX][MX], int, double[MX][MX], double[MX][MX]);
-int matmul(double[MX][MX], double[MX][MX], double[MX][MX], int);
+int product(double*, double, double**, int);
+int setdiag(double*, int, double**);
+int getsqrt(double**, int, double**, double**);
+int solveq(double**, int, double**, double**);
+int print_matrix(double **matrix, int bands);
 
 /* stats.c */
-int within(int, int, double[MC], double[MC][MX][MX], double[MX][MX], int);
-int between(int, int, double[MC], double[MC][MX], double[MX][MX], int);
+int within(int, int, double*, double***, double**, int);
+int between(int, int, double*, double**, double**, int);
 
 /* transform.c */
-int transform(int[MX], int[MX], int, int, double[MX][MX], int, CELL[MX],
-	      CELL[MX]);
+int transform(int*, int*, int, int, double**, int, CELL*,
+	      CELL*);
 
 #endif /* __LOCAL_PROTO_H__ */

imagery/i.cca/main.c

@@ -53,26 +53,26 @@ int main(int argc, char *argv[])
     int bands;			/* Number of image bands */
     int nclass;			/* Number of classes */
     int samptot;		/* Total number of sample points */
-    double mu[MC][MX];		/* Mean vector for image classes */
-    double w[MX][MX];		/* Within Class Covariance Matrix */
-    double p[MX][MX];		/* Between class Covariance Matrix */
-    double l[MX][MX];		/* Diagonal matrix of eigenvalues */
-    double q[MX][MX];		/* Transformation matrix */
-    double cov[MC][MX][MX];	/* Individual class Covariance Matrix */
-    double nsamp[MC];		/* Number of samples in a given class */
-    double eigval[MX];		/* Eigen value vector */
-    double eigmat[MX][MX];	/* Eigen Matrix */
-    char tempname[50];
+    double **mu;		/* Mean vector for image classes */
+    double **w;		/* Within Class Covariance Matrix */
+    double **p;		/* Between class Covariance Matrix */
+    double **l;		/* Diagonal matrix of eigenvalues */
+    double **q;		/* Transformation matrix */
+    double ***cov;	/* Individual class Covariance Matrix */
+    double *nsamp;		/* Number of samples in a given class */
+    double *eigval;		/* Eigen value vector */
+    double **eigmat;	/* Eigen Matrix */
+    char tempname[1024];
 
     /* used to make the color tables */
-    CELL outbandmax[MX];	/* will hold the maximums found in the out maps */
-    CELL outbandmin[MX];	/* will hold the minimums found in the out maps */
+    CELL *outbandmax;	/* will hold the maximums found in the out maps */
+    CELL *outbandmin;	/* will hold the minimums found in the out maps */
     struct Colors color_tbl;
     struct Signature sigs;
     FILE *sigfp;
     struct Ref refs;
-    int datafds[MX];
-    int outfds[MX];
+    int *datafds;
+    int *outfds;
 
     struct GModule *module;
     struct Option *grp_opt, *subgrp_opt, *sig_opt, *out_opt;
@@ -129,9 +129,28 @@ int main(int argc, char *argv[])
 
     /* check the number of input bands */
     bands = refs.nfiles;
-    if (bands > MX - 1)
-	G_fatal_error(_("Subgroup too large.  Maximum number of bands is %d\n."),
-		      MX - 1);
+
+    /*memory allocation*/
+    mu = G_alloc_matrix(nclass, bands);
+    w = G_alloc_matrix(bands, bands);
+    p = G_alloc_matrix(bands, bands);
+    l = G_alloc_matrix(bands, bands);
+    q = G_alloc_matrix(bands, bands);
+    eigmat = G_alloc_matrix(bands, bands);
+    nsamp = G_alloc_vector(nclass);
+    eigval = G_alloc_vector(bands);
+
+    cov = (double***)G_calloc(nclass, sizeof(double**));
+    for(i = 0; i < nclass; i++)
+    {
+        cov[i] = G_alloc_matrix(bands,bands);
+    }
+
+    outbandmax = (CELL*)G_calloc(nclass, sizeof(CELL));
+    outbandmin = (CELL*)G_calloc(nclass, sizeof(CELL));
+    datafds = (int*)G_calloc(nclass, sizeof(int));
+    outfds = (int*)G_calloc(nclass, sizeof(int));
+
 
     /*
        Here is where the information regarding
@@ -154,14 +173,26 @@ int main(int argc, char *argv[])
 
     within(samptot, nclass, nsamp, cov, w, bands);
     between(samptot, nclass, nsamp, mu, p, bands);
-    jacobi(w, (long)bands, eigval, eigmat);
-    egvorder(eigval, eigmat, (long)bands);
+    G_math_d_copy(w[0], eigmat[0], bands*bands);
+    G_math_eigen(eigmat, eigval, bands);
+    G_math_egvorder(eigval, eigmat, bands);
     setdiag(eigval, bands, l);
     getsqrt(w, bands, l, eigmat);
     solveq(q, bands, w, p);
-    jacobi(q, (long)bands, eigval, eigmat);
-    egvorder(eigval, eigmat, (long)bands);
-    matmul(q, eigmat, w, bands);
+    G_math_d_copy(q[0], eigmat[0], bands*bands);
+    G_math_eigen(eigmat, eigval, bands);
+    G_math_egvorder(eigval, eigmat, bands);
+    G_math_d_AB(eigmat, w, q, bands, bands, bands);
+
+    for(i = 0; i < bands; i++)
+    {
+        G_verbose_message("%i. eigen value: %+6.5f", i, eigval[i]);
+        G_verbose_message("eigen vector:");
+	for(j = 0; j < bands; j++)
+            G_verbose_message("%+6.5f ", eigmat[i][j]);
+
+    }
+
 
     /* open the cell maps */
     for (i = 1; i <= bands; i++) {
@@ -205,6 +236,25 @@ int main(int argc, char *argv[])
 
     I_free_signatures(&sigs);
     I_free_group_ref(&refs);
+    
+    /*free memory*/
+    G_free_matrix(mu);
+    G_free_matrix(w);
+    G_free_matrix(p);
+    G_free_matrix(l);
+    G_free_matrix(q);
+    G_free_matrix(eigmat);
+    for(i = 0; i < nclass; i++)
+        G_free_matrix(cov[i]);
+    G_free(cov);
+
+    G_free_vector(nsamp);
+    G_free_vector(eigval);
+
+    G_free(outbandmax);
+    G_free(outbandmin);
+    G_free(datafds);
+    G_free(outfds);
 
     exit(EXIT_SUCCESS);
 }

imagery/i.cca/matrix.c

@@ -4,25 +4,39 @@
 #include "local_proto.h"
 
 
-int product(double vector[MX], double factor, double matrix1[MX][MX],
+int print_matrix(double **matrix, int bands)
+{
+    int i, j;
+
+    for (i = 0; i < bands; i++)
+    {
+	for (j = 0; j < bands; j++) {
+	    printf("%g ", matrix[i][j]);
+	}
+        printf("\n");
+    }
+    return 0;
+}
+
+int product(double *vector, double factor, double **matrix1,
 	    int bands)
 {
     int i, j;
 
-    for (i = 1; i <= bands; i++)
-	for (j = 1; j <= bands; j++) {
+    for (i = 0; i < bands; i++)
+	for (j = 0; j < bands; j++) {
 	    matrix1[i][j] = (double)factor *(vector[i] * vector[j]);
 	}
     return 0;
 }
 
 
-int setdiag(double eigval[MX], int bands, double l[MX][MX])
+int setdiag(double *eigval, int bands, double **l)
 {
     int i, j;
 
-    for (i = 1; i <= bands; i++)
-	for (j = 1; j <= bands; j++)
+    for (i = 0; i < bands; i++)
+	for (j = 0; j < bands; j++)
 	    if (i == j)
 		l[i][j] = eigval[i];
 	    else
@@ -32,43 +46,37 @@ int setdiag(double eigval[MX], int bands, double l[MX][MX])
 
 
 int
-getsqrt(double w[MX][MX], int bands, double l[MX][MX], double eigmat[MX][MX])
+getsqrt(double **w, int bands, double **l, double **eigmat)
 {
     int i;
-    double tmp[MX][MX];
+    double **tmp;
+
+    tmp = G_alloc_matrix(bands, bands);
 
-    for (i = 1; i <= bands; i++)
+    for (i = 0; i < bands; i++)
 	l[i][i] = 1.0 / sqrt(l[i][i]);
-    matmul(tmp, eigmat, l, bands);
-    transpose(eigmat, bands);
-    matmul(w, tmp, eigmat, bands);
-    return 0;
-}
 
+    G_math_d_AB(eigmat, l, tmp, bands, bands, bands);
+    G_math_d_A_T(eigmat, bands);
+    G_math_d_AB(tmp, eigmat, w, bands, bands, bands);
 
-int solveq(double q[MX][MX], int bands, double w[MX][MX], double p[MX][MX])
-{
-    double tmp[MX][MX];
+    G_free_matrix(tmp);
 
-    matmul(tmp, w, p, bands);
-    matmul(q, tmp, w, bands);
     return 0;
 }
 
 
-int matmul(double res[MX][MX], double m1[MX][MX], double m2[MX][MX], int dim)
+int solveq(double **q, int bands, double **w, double **p)
 {
-    int i, j, k;
-    double sum;
-
-    for (i = 1; i <= dim; i++) {
-	for (j = 1; j <= dim; j++) {
-	    sum = 0.0;
-	    for (k = 1; k <= dim; k++)
-		sum += m1[i][k] * m2[k][j];
-	    res[i][j] = sum;
-	}
-    }
+    double **tmp;
+
+    tmp = G_alloc_matrix(bands, bands);
+
+    G_math_d_AB(w, p, tmp, bands, bands, bands);
+    G_math_d_AB(tmp, w, q, bands, bands, bands);
+
+    G_free_matrix(tmp);
 
     return 0;
 }
+

imagery/i.cca/stats.c

@@ -1,25 +1,26 @@
 #include <grass/gis.h>
-#include "local_proto.h"
+#include <grass/gmath.h>
 
+#include "local_proto.h"
 
 int
-within(int samptot, int nclass, double nsamp[MC], double cov[MC][MX][MX],
-       double w[MX][MX], int bands)
+within(int samptot, int nclass, double *nsamp, double ***cov,
+       double **w, int bands)
 {
     int i, j, k;
 
     /* Initialize within class covariance matrix */
-    for (i = 1; i <= bands; i++)
-	for (j = 1; j <= bands; j++)
+    for (i = 0; i < bands; i++)
+	for (j = 0; j < bands; j++)
 	    w[i][j] = 0.0;
 
-    for (i = 1; i <= nclass; i++)
-	for (j = 1; j <= bands; j++)
-	    for (k = 1; k <= bands; k++)
+    for (i = 0; i < nclass; i++)
+	for (j = 0; j < bands; j++)
+	    for (k = 0; k < bands; k++)
 		w[j][k] += (nsamp[i] - 1) * cov[i][j][k];
 
-    for (i = 1; i <= bands; i++)
-	for (j = 1; j <= bands; j++)
+    for (i = 0; i < bands; i++)
+	for (j = 0; j < bands; j++)
 	    w[i][j] = (1.0 / ((double)(samptot - nclass))) * w[i][j];
 
     return 0;
@@ -27,50 +28,41 @@ within(int samptot, int nclass, double nsamp[MC], double cov[MC][MX][MX],
 
 
 int
-between(int samptot, int nclass, double nsamp[MC], double mu[MC][MX],
-	double p[MX][MX], int bands)
+between(int samptot, int nclass, double *nsamp, double **mu,
+	double **p, int bands)
 {
     int i, j, k;
-    double tmp0[MX][MX], tmp1[MX][MX], tmp2[MX][MX];
-    double newvec[MX];
-
-    for (i = 0; i < MX; i++)
-	newvec[i] = 0.0;
+    double **tmp0, **tmp1, **tmp2;
+    double *newvec;
 
-    for (i = 1; i <= bands; i++)
-	for (j = 1; j <= bands; j++)
-	    tmp1[i][j] = tmp2[i][j] = 0.0;
+    tmp0 = G_alloc_matrix(bands, bands);
+    tmp1 = G_alloc_matrix(bands, bands);
+    tmp2 = G_alloc_matrix(bands, bands);
+    newvec = G_alloc_vector(bands);
 
-    /*  for (i = 1 ; i <= nclass ; i++)
-       product(mu[i],nsamp[i],tmp0,tmp1,bands);
-       for (i = 1 ; i <= nclass ; i++)
-       for (j = 1 ; j <= bands ; j++)
-       newvec[j] += nsamp[i] * mu[i][j];
-       for (i = 1 ; i <= bands ; i++)
-       for (j = 1 ; i <= bands ; j++)
-       tmp2[i][j] = (newvec[i] * newvec[j]) / samptot;
-       for (i = 1 ; i <= bands ; i++)
-       for (j = 1 ; j <= bands ; j++)
-       p[i][j] = (tmp1[i][j] - tmp2[i][j]) / (nclass - 1);
-     */
-
-    for (i = 1; i <= nclass; i++)
-	for (j = 1; j <= bands; j++)
+    for (i = 0; i < nclass; i++)
+	for (j = 0; j < bands; j++)
 	    newvec[j] += nsamp[i] * mu[i][j];
-    for (i = 1; i <= bands; i++)
-	for (j = 1; j <= bands; j++)
+    for (i = 0; i < bands; i++)
+	for (j = 0; j < bands; j++)
 	    tmp1[i][j] = (newvec[i] * newvec[j]) / samptot;
 
-    for (k = 1; k <= nclass; k++) {
+    for (k = 0; k < nclass; k++) {
 	product(mu[k], nsamp[k], tmp0, bands);
-	for (i = 1; i <= bands; i++)
-	    for (j = 1; j <= bands; j++)
+	for (i = 0; i < bands; i++)
+	    for (j = 0; j < bands; j++)
 		tmp2[i][j] += tmp0[i][j] - tmp1[i][j];
     }
 
-    for (i = 1; i <= bands; i++)
-	for (j = 1; j <= bands; j++)
+    for (i = 0; i < bands; i++)
+	for (j = 0; j < bands; j++)
 	    p[i][j] = tmp2[i][j] / (nclass - 1);
 
+    G_free_matrix(tmp0);
+    G_free_matrix(tmp1);
+    G_free_matrix(tmp2);
+    G_free_vector(newvec);
+
     return 0;
 }
+

imagery/i.cca/transform.c

@@ -1,38 +1,43 @@
 #include <stdlib.h>
+
 #include <grass/gis.h>
-#include <grass/raster.h>
+#include <grass/gmath.h>
 #include <grass/glocale.h>
-#include "local_proto.h"
 
+#include "local_proto.h"
 
 int
-transform(int datafds[MX], int outfds[MX], int rows, int cols,
-	  double eigmat[MX][MX], int bands, CELL mins[MX], CELL maxs[MX])
+transform(int *datafds, int *outfds, int rows, int cols,
+	  double **eigmat, int bands, CELL *mins, CELL *maxs)
 {
     int i, j, k, l;
-    double sum[MX];
-    CELL *rowbufs[MX];
+    double *sum;
+    CELL **rowbufs;
+
+    sum = G_alloc_vector(bands);
+    rowbufs = (CELL**)G_calloc(bands, sizeof(CELL*));
+
 
     /* allocate row buffers for each band */
-    for (i = 1; i <= bands; i++)
+    for (i = 0; i < bands; i++)
 	if ((rowbufs[i] = Rast_allocate_c_buf()) == NULL)
 	    G_fatal_error(_("Unable to allocate cell buffers."));
 
     for (i = 0; i < rows; i++) {
 	/* get one row of data */
-	for (j = 1; j <= bands; j++)
+	for (j = 0; j < bands; j++)
 	    if (Rast_get_c_row(datafds[j], rowbufs[j], i) < 0)
 		G_fatal_error(_("Error reading cell map during transform."));
 
 	/* transform each cell in the row */
 	for (l = 0; l < cols; l++) {
-	    for (j = 1; j <= bands; j++) {
+	    for (j = 0; j < bands; j++) {
 		sum[j] = 0.0;
-		for (k = 1; k <= bands; k++) {
+		for (k = 0; k < bands; k++) {
 		    sum[j] += eigmat[j][k] * (double)rowbufs[k][l];
 		}
 	    }
-	    for (j = 1; j <= bands; j++) {
+	    for (j = 0; j < bands; j++) {
 		rowbufs[j][l] = (CELL) (sum[j] + 0.5);
 		if (rowbufs[j][l] > maxs[j])
 		    maxs[j] = rowbufs[j][l];
@@ -42,13 +47,16 @@ transform(int datafds[MX], int outfds[MX], int rows, int cols,
 	}
 
 	/* output the row of data */
-	for (j = 1; j <= bands; j++)
+	for (j = 0; j < bands; j++)
 	    if (Rast_put_row(outfds[j], rowbufs[j], CELL_TYPE) < 0)
 		G_fatal_error(_("Error writing cell map during transform."));
     }
-    for (i = 1; i <= bands; i++)
+    for (i = 0; i < bands; i++)
 	G_free(rowbufs[i]);
 
+    G_free(rowbufs);
+    G_free_vector(sum);
+
     G_message(_("Transform completed.\n"));
 
     return 0;

imagery/i.pca/main.c

@@ -104,21 +104,11 @@ int main(int argc, char *argv[])
     set_output_scale(opt_scale, &scale, &scale_min, &scale_max);
 
     /* allocate memory */
-    covar = (double **)G_calloc(bands, sizeof(double *));
-    mu = (double *)G_malloc(bands * sizeof(double));
-    inp_fd = (int *)G_malloc(bands * sizeof(int));
-    eigmat = (double **)G_calloc(bands, sizeof(double *));
-    eigval = (double *)G_calloc(bands, sizeof(double));
-
-    /* allocate memory for matrices */
-    for (i = 0; i < bands; i++) {
-	covar[i] = (double *)G_malloc(bands * sizeof(double));
-	eigmat[i] = (double *)G_calloc(bands, sizeof(double));
-
-	/* initialize covariance matrix */
-	for (j = 0; j < bands; j++)
-	    covar[i][j] = 0.;
-    }
+    covar = G_alloc_matrix(bands, bands);
+    mu = G_alloc_vector(bands);
+    inp_fd = G_alloc_ivector(bands);
+    eigmat = G_alloc_matrix(bands, bands);
+    eigval = G_alloc_vector(bands);
 
     /* open and check input/output files */
     for (i = 0; i < bands; i++) {
@@ -146,8 +136,9 @@ int main(int argc, char *argv[])
 	}
     }
 
+    G_math_d_copy(covar[0], eigmat[0], bands*bands);
     G_debug(1, "Calculating eigenvalues and eigenvectors...");
-    eigen(covar, eigmat, eigval, bands);
+    G_math_eigen(eigmat, eigval, bands);
 
 #ifdef PCA_DEBUG
     /* dump eigen matrix and eigen values */
@@ -155,10 +146,10 @@ int main(int argc, char *argv[])
 #endif
 
     G_debug(1, "Ordering eigenvalues in descending order...");
-    egvorder2(eigval, eigmat, bands);
+    G_math_egvorder(eigval, eigmat, bands);
 
     G_debug(1, "Transposing eigen matrix...");
-    transpose2(eigmat, bands);
+    G_math_d_A_T(eigmat, bands);
 
     /* write output images */
     write_pca(eigmat, inp_fd, opt_out->answer, bands, scale, scale_min,
@@ -176,6 +167,13 @@ int main(int argc, char *argv[])
 	/* close output file */
 	Rast_unopen(inp_fd[i]);
     }
+    
+    /* free memory */
+    G_free_matrix(covar);
+    G_free_vector(mu);
+    G_free_ivector(inp_fd);
+    G_free_matrix(eigmat);
+    G_free_vector(eigval);
 
     exit(EXIT_SUCCESS);
 }

imagery/i.smap/model.c

@@ -16,12 +16,15 @@ void extract_init(struct SigSet *S)
     int b1, b2;
     int nbands;
     double *lambda;
+    double **tmp_mat;
     struct ClassSig *C;
     struct SubSig *SubS;
 
     nbands = S->nbands;
     /* allocate scratch memory */
-    lambda = (double *)G_malloc(nbands * sizeof(double));
+    lambda = G_alloc_vector(nbands);
+    tmp_mat = G_alloc_matrix(nbands, nbands);
+
 
     /* invert matrix and compute constant for each subclass */
 
@@ -41,10 +44,12 @@ void extract_init(struct SigSet *S)
 				  m + 1, i + 1);
 
 		    SubS->Rinv[b1][b2] = SubS->R[b1][b2];
+		    tmp_mat[b1][b2] = SubS->R[b1][b2];
+
 		}
 
 	    /* Test for positive definite matrix */
-	    eigen(SubS->Rinv, NULL, lambda, nbands);
+	    G_math_eigen(tmp_mat, lambda, nbands);
 	    for (b1 = 0; b1 < nbands; b1++) {
 		if (lambda[b1] <= 0.0)
 		    G_warning(_("Nonpositive eigenvalues for class %d subclass %d"),
@@ -61,7 +66,8 @@ void extract_init(struct SigSet *S)
 	    invert(SubS->Rinv, nbands);
 	}
     }
-    G_free((char *)lambda);
+    G_free_vector(lambda);
+    G_free_matrix(tmp_mat);
 }
 
 

include/Make/Grass.make

@@ -115,6 +115,7 @@ libs = \
 	BTREE:btree \
 	CAIRODRIVER:cairodriver \
 	CDHC:cdhc \
+	CCMATH:ccmath \
 	CLUSTER:cluster \
 	COORCNV:coorcnv \
 	DATETIME:datetime \
@@ -194,7 +195,7 @@ DSPFDEPS         = $(GISLIB)
 FORMDEPS         = $(DBMILIB) $(GISLIB)
 G3DDEPS          = $(RASTERLIB) $(GISLIB) $(XDRLIB)
 GISDEPS          = $(DATETIMELIB) $(ZLIBLIBPATH) $(ZLIB) $(INTLLIB) $(PTHREADLIBPATH) $(PTHREADLIB) $(MATHLIB)
-GMATHDEPS        = $(GISLIB) $(FFTWLIB) $(LAPACKLIB) $(BLASLIB)
+GMATHDEPS        = $(GISLIB) $(FFTWLIB) $(LAPACKLIB) $(BLASLIB) $(CCMATHLIB)
 GPDEDEPS         = $(G3DLIB) $(RASTERLIB) $(GISLIB) $(MATHLIB)
 GPROJDEPS        = $(GISLIB) $(GDALLIBS) $(PROJLIB) $(MATHLIB)
 HTMLDRIVERDEPS   = $(DRIVERLIB) $(GISLIB) $(MATHLIB)

include/gmath.h

@@ -1,11 +1,10 @@
-
 /******************************************************************************
  * gmath.h
  * Top level header file for gmath units
 
  * @Copyright David D.Gray <ddgray@armadce.demon.co.uk>
  * 27th. Sep. 2000
- * Last updated: 2007-08-26
+ * Last updated: $Id$
  *
 
  * This file is part of GRASS GIS. It is free software. You can 
@@ -31,71 +30,194 @@
 #endif
 #include <stddef.h>
 
-/* fft.c */
-int fft(int, double *[2], int, int, int);
-int fft2(int, double (*)[2], int, int, int);
-
-/* gauss.c */
-double G_math_rand_gauss(int, double);
-
-/* max_pow2.c */
-long G_math_max_pow2(long);
-long G_math_min_pow2(long);
-
-/* rand1.c */
-float G_math_rand(int);
-
-/* del2g.c */
-int del2g(double *[2], int, double);
-
-/* findzc.c */
-int G_math_findzc(double[], int, double[], double, int);
-
-/* getg.c */
-int getg(double, double *[2], int);
-
-/* eigen.c */
-int eigen(double **, double **, double *, int);
-int egvorder2(double *, double **, long);
-int transpose2(double **, long);
-
-/* jacobi.c */
-#define MX 9
-int jacobi(double[MX][MX], long, double[MX], double[MX][MX]);
-int egvorder(double[MX], double[MX][MX], long);
-int transpose(double[MX][MX], long);
-
-/* mult.c */
-int mult(double *v1[2], int size1, double *v2[2], int size2, double *v3[2],
-	 int size3);
+/*solver names */
+#define G_MATH_SOLVER_DIRECT_GAUSS "gauss"
+#define G_MATH_SOLVER_DIRECT_LU "lu"
+#define G_MATH_SOLVER_DIRECT_CHOLESKY "cholesky"
+#define G_MATH_SOLVER_ITERATIVE_JACOBI "jacobi"
+#define G_MATH_SOLVER_ITERATIVE_SOR "sor"
+#define G_MATH_SOLVER_ITERATIVE_CG "cg"
+#define G_MATH_SOLVER_ITERATIVE_PCG "pcg"
+#define G_MATH_SOLVER_ITERATIVE_BICGSTAB "bicgstab"
+
+/*preconditioner */
+#define G_MATH_DIAGONAL_PRECONDITION 1
+#define G_MATH_ROWSCALE_ABSSUMNORM_PRECONDITION 2
+#define G_MATH_ROWSCALE_EUKLIDNORM_PRECONDITION 3
+#define G_MATH_ROWSCALE_MAXNORM_PRECONDITION 4
 
 /* dalloc.c */
 double *G_alloc_vector(size_t);
 double **G_alloc_matrix(int, int);
-float *G_alloc_fvector(size_t);
-float **G_alloc_fmatrix(int, int);
+float  *G_alloc_fvector(size_t);
+float  **G_alloc_fmatrix(int, int);
 void G_free_vector(double *);
 void G_free_matrix(double **);
 void G_free_fvector(float *);
 void G_free_fmatrix(float **);
 
-/* eigen_tools.c */
-int G_tqli(double[], double[], int, double **);
-void G_tred2(double **, int, double[], double[]);
-
 /* ialloc.c */
 int *G_alloc_ivector(size_t);
 int **G_alloc_imatrix(int, int);
 void G_free_ivector(int *);
 void G_free_imatrix(int **);
 
-/* lu.c */
-int G_ludcmp(double **, int, int *, double *);
-void G_lubksb(double **, int, int *, double[]);
+/* fft.c */
+extern int fft(int, double *[2], int, int, int);
+extern int fft2(int, double (*)[2], int, int, int);
+
+/* gauss.c */
+extern double G_math_rand_gauss(int, double);
+
+/* max_pow2.c */
+extern long G_math_max_pow2 (long n);
+extern long G_math_min_pow2 (long n);
 
-/* svd.c */
-int G_svdcmp(double **, int, int, double *, double **);
-int G_svbksb(double **, double[], double **, int, int, double[], double[]);
-int G_svelim(double *, int);
+/* rand1.c */
+extern float G_math_rand(int);
+
+/* del2g.c */
+extern int del2g(double *[2], int, double);
+
+/* getg.c */
+extern int getg(double, double *[2], int);
+
+/* eigen_tools.c */
+extern int G_math_egvorder(double *, double **, long);
+
+/* mult.c */
+extern int G_math_complex_mult (double *v1[2], int size1, double *v2[2], int size2, double *v3[2], int size3);
+
+/* lu.c*/
+extern int G_ludcmp(double **, int, int *, double *);
+extern void G_lubksb(double **a, int n, int *indx, double b[]);
+
+/* findzc.c */
+extern int G_math_findzc(double conv[], int size, double zc[], double thresh, int num_orients);
+
+
+/* *************************************************************** */
+/* ***** WRAPPER FOR CCMATH FUNCTIONS USED IN GRASS ************** */
+/* *************************************************************** */
+extern int G_math_solv(double **,double *,int);
+extern int G_math_solvps(double **,double *,int);
+extern void G_math_solvtd(double *,double *,double *,double *,int);
+extern int G_math_solvru(double **,double *,int);
+extern int G_math_minv(double **,int);
+extern int G_math_psinv(double **,int);
+extern int G_math_ruinv(double **,int);
+extern void G_math_eigval(double **,double *,int);
+extern void G_math_eigen(double **,double *,int);
+extern double G_math_evmax(double **,double *,int);
+extern int G_math_svdval(double *,double **,int,int);
+extern int G_math_sv2val(double *,double **,int,int);
+extern int G_math_svduv(double *,double **,double **, int,double **,int);
+extern int G_math_sv2uv(double *,double **,double **,int,double **,int);
+extern int G_math_svdu1v(double *,double **,int,double **,int);
+
+
+/* *************************************************************** */
+/* *************** LINEARE EQUATION SYSTEM PART ****************** */
+/* *************************************************************** */
+
+/*!
+ * \brief The row vector of the sparse matrix
+ * */
+typedef struct
+{
+    double *values;		/*The non null values of the row */
+    unsigned int cols;		/*Number of entries */
+    unsigned int *index;	/*the index number */
+} G_math_spvector;
+
+/* Sparse matrix and sparse vector functions
+ * */
+extern G_math_spvector *G_math_alloc_spvector(int );
+extern G_math_spvector **G_math_alloc_spmatrix(int );
+extern void G_math_free_spmatrix(G_math_spvector ** , int );
+extern void G_math_free_spvector(G_math_spvector * );
+extern int G_math_add_spvector(G_math_spvector **, G_math_spvector * , int );
+
+/*linear equation solver, most of them are multithreaded wih OpenMP*/
+extern int G_math_solver_gauss(double **, double *, double *, int );
+extern int G_math_solver_lu(double **, double *, double *, int );
+extern int G_math_solver_cholesky(double **, double *, double *, int , int );
+extern int G_math_solver_jacobi(double **, double *, double *, int , int , double , double );
+extern int G_math_solver_gs(double **, double *, double *, int , int , double , double );
+extern int G_math_solver_pcg(double **, double *, double *, int , int , double , int );
+extern int G_math_solver_cg(double **, double *, double *, int , int , double );
+extern int G_math_solver_bicgstab(double **, double *, double *, int , int , double );
+extern int G_math_solver_sparse_jacobi(G_math_spvector **, double *, double *, int , int , double , double );
+extern int G_math_solver_sparse_gs(G_math_spvector **, double *, double *, int , int , double , double );
+extern int G_math_solver_sparse_pcg(G_math_spvector **, double *, double *, int , int , double , int );
+extern int G_math_solver_sparse_cg(G_math_spvector **, double *, double *, int , int , double );
+extern int G_math_solver_sparse_bicgstab(G_math_spvector **, double *, double *, int , int , double );
+/* solver algoithms and helper functions*/
+extern void G_math_gauss_elimination(double **, double *, int );
+extern void G_math_lu_decomposition(double **, double *, int );
+extern int G_math_cholesky_decomposition(double **, int , int );
+extern void G_math_backward_solving(double **, double *, double *, int );
+extern void G_math_forward_solving(double **, double *, double *, int );
+extern int G_math_pivot_create(double **, double *, int , int );
+
+
+/*BLAS like level 1,2 and 3 functions*/
+
+/*level 1 vector - vector grass implementation with OpenMP thread support*/
+extern void G_math_d_x_dot_y(double *, double *, double *, int );
+extern void G_math_d_asum_norm(double *, double *, int );
+extern void G_math_d_euclid_norm(double *, double *, int );
+extern void G_math_d_max_norm(double *, double *, int );
+extern void G_math_d_ax_by(double *, double *, double *, double , double , int );
+extern void G_math_d_copy(double *, double *, int );
+
+extern void G_math_f_x_dot_y(float *, float *, float *, int );
+extern void G_math_f_asum_norm(float *, float *, int );
+extern void G_math_f_euclid_norm(float *, float *, int );
+extern void G_math_f_max_norm(float *, float *, int );
+extern void G_math_f_ax_by(float *, float *, float *, float , float , int );
+extern void G_math_f_copy(float *, float *, int );
+
+extern void G_math_i_x_dot_y(int *, int *,  double *, int );
+extern void G_math_i_asum_norm(int *,  double *, int );
+extern void G_math_i_euclid_norm(int *,  double *,int );
+extern void G_math_i_max_norm(int *,  int *, int );
+extern void G_math_i_ax_by(int *, int *, int *, int , int , int );
+extern void G_math_i_copy(int *, int *, int );
+
+/*ATLAS blas level 1 wrapper*/
+extern double G_math_ddot(double *, double *, int );
+extern float G_math_sdot(float *, float *, int );
+extern float G_math_sdsdot(float *, float *, float , int );
+extern double G_math_dnrm2(double *, int );
+extern double G_math_dasum(double *, int );
+extern double G_math_idamax(double *, int );
+extern float  G_math_snrm2(float *, int );
+extern float  G_math_sasum(float *, int );
+extern float  G_math_isamax(float *, int );
+extern void G_math_dscal(double *, double , int );
+extern void G_math_sscal(float *, float , int );
+extern void G_math_dcopy(double *, double *, int );
+extern void G_math_scopy(float *, float *, int );
+extern void G_math_daxpy(double *, double *, double , int );
+extern void G_math_saxpy(float *, float *, float , int );
+
+/*level 2 matrix - vector grass implementation with OpenMP thread support*/
+extern void G_math_Ax_sparse(G_math_spvector **, double *, double *, int );
+extern void G_math_d_Ax(double **, double *, double *, int , int );
+extern void G_math_f_Ax(float **, float *, float *, int , int );
+extern void G_math_d_x_dyad_y(double *, double *, double **, int, int );
+extern void G_math_f_x_dyad_y(float *, float *, float **, int, int );
+extern void G_math_d_aAx_by(double **, double *, double *, double , double , double *, int , int );
+extern void G_math_f_aAx_by(float **, float *, float *, float , float , float *, int , int );
+extern int G_math_d_A_T(double **A, int rows);
+extern int G_math_f_A_T(float **A, int rows);
+
+/*level 3 matrix - matrix grass implementation with OpenMP thread support*/
+extern void G_math_d_aA_B(double **, double **, double , double **, int , int );
+extern void G_math_f_aA_B(float **, float **, float , float **, int , int );
+extern void G_math_d_AB(double **, double **, double **, int , int , int );
+extern void G_math_f_AB(float **,  float **,  float **,  int , int , int );
 
 #endif /* GMATH_H_ */
+

lib/Makefile

@@ -7,6 +7,7 @@ SUBDIRS = \
 	datetime \
 	gis \
 	raster \
+	external \
 	gmath \
 	linkm \
 	driver \
@@ -18,7 +19,6 @@ SUBDIRS = \
 	btree \
 	display \
 	db \
-	external \
 	fonts \
 	gtcltk \
 	form \

lib/external/Makefile

@@ -3,6 +3,7 @@ MODULE_TOPDIR = ../..
 
 SUBDIRS = \
 	bwidget \
+	ccmath  \
 	shapelib
 
 include $(MODULE_TOPDIR)/include/Make/Dir.make

lib/external/ccmath/Makefile

@@ -0,0 +1,14 @@
+MODULE_TOPDIR = ../../..
+
+LIB = CCMATH
+
+include $(MODULE_TOPDIR)/include/Make/Lib.make
+
+default: $(ARCH_INCDIR)/ccmath_grass.h
+	$(MAKE) lib
+
+$(ARCH_INCDIR)/ccmath_grass.h: ccmath.h
+	$(INSTALL_DATA) ccmath.h $(ARCH_INCDIR)/ccmath_grass.h
+
+#doxygen:
+DOXNAME=ccmath

lib/external/ccmath/README

@@ -0,0 +1,5 @@
+The code in this directory is a part of the
+ccmath library version 2.2.1.
+
+This code is licensed under the terms of the LGPL.
+See the lgpl.license file for details.

lib/external/ccmath/atou1.c

@@ -0,0 +1,51 @@
+/*  atou1.c    CCMATH mathematics library source code.
+ *
+ *  Copyright (C)  2000   Daniel A. Atkinson    All rights reserved.
+ *  This code may be redistributed under the terms of the GNU library
+ *  public license (LGPL). ( See the lgpl.license file for details.)
+ * ------------------------------------------------------------------------
+ */
+#include <stdlib.h>
+void atou1(double *a, int m, int n)
+{
+    double *p0, *p, *q, *w;
+
+    int i, j, k, mm;
+
+    double s, h;
+
+    w = (double *)calloc(m, sizeof(double));
+    p0 = a + n * n - 1;
+    i = n - 1;
+    mm = m - n;
+    if (mm == 0) {
+	*p0 = 1.;
+	p0 -= n + 1;
+	--i;
+	++mm;
+    }
+    for (; i >= 0; --i, ++mm, p0 -= n + 1) {
+	if (*p0 != 0.) {
+	    for (j = 0, p = p0 + n; j < mm; p += n)
+		w[j++] = *p;
+	    h = *p0;
+	    *p0 = 1. - h;
+	    for (j = 0, p = p0 + n; j < mm; p += n)
+		*p = -h * w[j++];
+	    for (k = i + 1, q = p0 + 1; k < n; ++k) {
+		for (j = 0, p = q + n, s = 0.; j < mm; p += n)
+		    s += w[j++] * *p;
+		s *= h;
+		for (j = 0, p = q + n; j < mm; p += n)
+		    *p -= s * w[j++];
+		*q++ = -s;
+	    }
+	}
+	else {
+	    *p0 = 1.;
+	    for (j = 0, p = p0 + n, q = p0 + 1; j < mm; ++j, p += n)
+		*p = *q++ = 0.;
+	}
+    }
+    free(w);
+}

lib/external/ccmath/atovm.c

@@ -0,0 +1,43 @@
+/*  atovm.c    CCMATH mathematics library source code.
+ *
+ *  Copyright (C)  2000   Daniel A. Atkinson    All rights reserved.
+ *  This code may be redistributed under the terms of the GNU library
+ *  public license (LGPL). ( See the lgpl.license file for details.)
+ * ------------------------------------------------------------------------
+ */
+void atovm(double *v, int n)
+{
+    double *p0, *q0, *p, *q, *qq;
+
+    double h, s;
+
+    int i, j, k, mm;
+
+    q0 = v + n * n - 1;
+    *q0 = 1.;
+    q0 -= n + 1;
+    p0 = v + n * n - n - n - 1;
+    for (i = n - 2, mm = 1; i >= 0; --i, p0 -= n + 1, q0 -= n + 1, ++mm) {
+	if (i && *(p0 - 1) != 0.) {
+	    for (j = 0, p = p0, h = 1.; j < mm; ++j, ++p)
+		h += *p * *p;
+	    h = *(p0 - 1);
+	    *q0 = 1. - h;
+	    for (j = 0, q = q0 + n, p = p0; j < mm; ++j, q += n)
+		*q = -h * *p++;
+	    for (k = i + 1, q = q0 + 1; k < n; ++k) {
+		for (j = 0, qq = q + n, p = p0, s = 0.; j < mm; ++j, qq += n)
+		    s += *qq * *p++;
+		s *= h;
+		for (j = 0, qq = q + n, p = p0; j < mm; ++j, qq += n)
+		    *qq -= s * *p++;
+		*q++ = -s;
+	    }
+	}
+	else {
+	    *q0 = 1.;
+	    for (j = 0, p = q0 + 1, q = q0 + n; j < mm; ++j, q += n)
+		*q = *p++ = 0.;
+	}
+    }
+}

lib/external/ccmath/ccmath.h

@@ -0,0 +1,181 @@
+/*  ccmath.h    CCMATH mathematics library source code.
+ *
+ *  Copyright (C)  2000   Daniel A. Atkinson    All rights reserved.
+ *  This code may be redistributed under the terms of the GNU library
+ *  public license (LGPL). ( See the lgpl.license file for details.)
+ *
+ * Modified by Soeren gebbert 2009/01/08
+ * Removed al unued functions in grass. Only the linear algebra
+ * functions are used. 
+ * ------------------------------------------------------------------------
+ */
+/*
+                               CCM
+
+                Numerical Analysis Toolkit Header File
+                      ELF Shared Library Version
+*/
+               /* Required for Shared Library */
+#ifndef _CCMATH_H_
+#define _CCMATH_H_
+#define XMATH 1
+
+          /* Define File Pointers and Standard Library */
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <math.h>
+
+               /* Definitions of Types */
+
+#ifndef NULL
+#define NULL ((void *)0
+#endif
+
+               /* Complex Types */
+
+#ifndef CPX
+struct complex {double re,im;};
+typedef struct complex Cpx;
+#define CPX  1
+#endif
+
+/*   Linear Algebra     */
+
+
+ /* Real Linear Systems */
+
+
+     int minv(double *a,int n) ;
+
+     int psinv(double *v,int n) ;
+
+     int ruinv(double *a,int n) ;
+
+     int solv(double *a,double *b,int n) ;
+
+     int solvps(double *s,double *x,int n) ;
+
+     int solvru(double *a,double *b,int n) ;
+
+     void solvtd(double *a,double *b,double *c,double *x,int m) ;
+
+     void eigen(double *a,double *eval,int n) ;
+
+     void eigval(double *a,double *eval,int n) ;
+
+     double evmax(double *a,double *u,int n) ;
+
+     int svdval(double *d,double *a,int m,int n) ;
+
+     int sv2val(double *d,double *a,int m,int n) ;
+
+     int svduv(double *d,double *a,double *u,int m,double *v,int n) ;
+
+     int sv2uv(double *d,double *a,double *u,int m,double *v,int n) ;
+
+     int svdu1v(double *d,double *a,int m,double *v,int n) ;
+
+     int sv2u1v(double *d,double *a,int m,double *v,int n) ;
+
+     void mmul(double *mat,double *a,double *b,int n) ;
+
+     void rmmult(double *mat,double *a,double *b,int m,int k,int n) ;
+
+     void vmul(double *vp,double *mat,double *v,int n) ;
+
+     double vnrm(double *u,double *v,int n) ;
+     
+     void matprt(double *a,int n,int m,char *fmt) ;
+
+     void fmatprt(FILE *fp,double *a,int n,int m,char *fmt) ;
+
+     void trnm(double *a,int n) ;
+
+     void mattr(double *a,double *b,int m,int n) ;
+
+     void otrma(double *at,double *u,double *a,int n) ;
+
+     void otrsm(double *st,double *u,double *s0,int n) ;
+
+     void mcopy(double *a,double *b,int m) ;
+
+     void ortho(double *evc,int n) ;
+
+     void smgen(double *a,double *eval,double *evec,int n) ;
+
+   /* utility routines for real symmertic eigensystems */
+
+     void house(double *a,double *d,double *ud,int n) ;
+
+     void housev(double *a,double *d,double *ud,int n) ;
+
+     int qreval(double *eval,double *ud,int n) ;
+
+     int qrevec(double *eval,double *evec,double *dp,int n) ;
+
+   /* utility routines for singular value decomposition */
+
+     int qrbdi(double *d, double *e,int n) ;
+
+     int qrbdv(double *d, double *e,double *u,int m,double *v,int n) ;
+
+     int qrbdu1(double *d, double *e,double *u,int m,double *v,int n) ;
+
+     void ldumat(double *a,double *u,int m,int n) ;
+
+     void ldvmat(double *a,double *v,int n) ;
+
+     void atou1(double *a,int m,int n) ;
+
+     void atovm(double *v,int n) ;
+
+
+ /* Complex Matrix Algebra */
+
+
+     int cminv(Cpx *a,int n) ;
+
+     int csolv(Cpx *a,Cpx *b,int n) ;
+
+     void heigvec(Cpx *a,double *eval,int n) ;
+
+     void heigval(Cpx *a,double *eval,int n) ;
+
+     double hevmax(Cpx *a,Cpx *u,int n) ;
+
+     void cmmul(Cpx *c,Cpx *a,Cpx *b,int n) ;
+
+     void cmmult(Cpx *c,Cpx *a,Cpx *b,int m,int k,int n) ;
+
+     void cvmul(Cpx *vp,Cpx *mat,Cpx *v,int n) ;
+
+     Cpx cvnrm(Cpx *u,Cpx *v,int n) ;
+
+     void cmprt(Cpx *a,int n,int m,char *fmt) ;
+
+     void trncm(Cpx *a,int n) ;
+
+     void hconj(Cpx *u,int n) ;
+
+     void cmattr(Cpx *a,Cpx *b,int m,int n) ;
+
+     void utrncm(Cpx *at,Cpx *u,Cpx *a,int n) ;
+
+     void utrnhm(Cpx *ht,Cpx *u,Cpx *h0,int n) ;
+
+     void cmcpy(Cpx *a,Cpx *b,int n) ;
+
+     void unitary(Cpx *u,int n) ;
+
+     void hmgen(Cpx *h,double *eval,Cpx *u,int n) ;
+
+
+   /* utility routines for hermitian eigen problems */
+
+     void chouse(Cpx *a,double *d,double *ud,int n) ;
+
+     void chousv(Cpx *a,double *d,double *ud,int n) ;
+
+     void qrecvc(double *eval,Cpx *evec,double *ud,int n) ;
+#endif

lib/external/ccmath/chouse.c

@@ -0,0 +1,96 @@
+/*  chouse.c    CCMATH mathematics library source code.
+ *
+ *  Copyright (C)  2000   Daniel A. Atkinson    All rights reserved.
+ *  This code may be redistributed under the terms of the GNU library
+ *  public license (LGPL). ( See the lgpl.license file for details.)
+ * ------------------------------------------------------------------------
+ */
+#include <stdlib.h>
+#include "ccmath.h"
+void chouse(Cpx * a, double *d, double *dp, int n)
+{
+    double sc, x, y;
+
+    Cpx cc, u, *q0;
+
+    int i, j, k, m, e;
+
+    Cpx *qw, *pc, *p;
+
+    q0 = (Cpx *) calloc(2 * n, sizeof(Cpx));
+    for (i = 0, p = q0 + n, pc = a; i < n; ++i, pc += n + 1)
+	*p++ = *pc;
+    for (j = 0, pc = a; j < n - 2; ++j, pc += n + 1) {
+	m = n - j - 1;
+	for (i = 1, sc = 0.; i <= m; ++i)
+	    sc += pc[i].re * pc[i].re + pc[i].im * pc[i].im;
+	if (sc > 0.) {
+	    sc = sqrt(sc);
+	    p = pc + 1;
+	    y = sc + (x = sqrt(p->re * p->re + p->im * p->im));
+	    if (x > 0.) {
+		cc.re = p->re / x;
+		cc.im = p->im / x;
+	    }
+	    else {
+		cc.re = 1.;
+		cc.im = 0.;
+	    }
+	    x = 1. / sqrt(2. * sc * y);
+	    y *= x;
+	    for (i = 0, qw = pc + 1; i < m; ++i) {
+		q0[i].re = q0[i].im = 0.;
+		if (i) {
+		    qw[i].re *= x;
+		    qw[i].im *= -x;
+		}
+		else {
+		    qw[0].re = y * cc.re;
+		    qw[0].im = -y * cc.im;
+		}
+	    }
+	    for (i = 0, e = j + 2, p = pc + n + 1, y = 0.; i < m;
+		 ++i, p += e++) {
+		q0[i].re += (u.re = qw[i].re) * p->re - (u.im =
+							 qw[i].im) * p->im;
+		q0[i].im += u.re * p->im + u.im * p->re;
+		++p;
+		for (k = i + 1; k < m; ++k, ++p) {
+		    q0[i].re += qw[k].re * p->re - qw[k].im * p->im;
+		    q0[i].im += qw[k].im * p->re + qw[k].re * p->im;
+		    q0[k].re += u.re * p->re + u.im * p->im;
+		    q0[k].im += u.im * p->re - u.re * p->im;
+		}
+		y += u.re * q0[i].re + u.im * q0[i].im;
+	    }
+	    for (i = 0; i < m; ++i) {
+		q0[i].re -= y * qw[i].re;
+		q0[i].re += q0[i].re;
+		q0[i].im -= y * qw[i].im;
+		q0[i].im += q0[i].im;
+	    }
+	    for (i = 0, e = j + 2, p = pc + n + 1; i < m; ++i, p += e++) {
+		for (k = i; k < m; ++k, ++p) {
+		    p->re -= qw[i].re * q0[k].re + qw[i].im * q0[k].im
+			+ q0[i].re * qw[k].re + q0[i].im * qw[k].im;
+		    p->im -= qw[i].im * q0[k].re - qw[i].re * q0[k].im
+			+ q0[i].im * qw[k].re - q0[i].re * qw[k].im;
+		}
+	    }
+	}
+	d[j] = pc->re;
+	dp[j] = sc;
+    }
+    d[j] = pc->re;
+    d[j + 1] = (pc + n + 1)->re;
+    u = *(pc + 1);
+    dp[j] = sqrt(u.re * u.re + u.im * u.im);
+    for (j = 0, pc = a, qw = q0 + n; j < n; ++j, pc += n + 1) {
+	*pc = qw[j];
+	for (i = 1, p = pc + n; i < n - j; ++i, p += n) {
+	    pc[i].re = p->re;
+	    pc[i].im = -p->im;
+	}
+    }
+    free(q0);
+}

lib/external/ccmath/chousv.c

@@ -0,0 +1,123 @@
+/*  chousv.c    CCMATH mathematics library source code.
+ *
+ *  Copyright (C)  2000   Daniel A. Atkinson    All rights reserved.
+ *  This code may be redistributed under the terms of the GNU library
+ *  public license (LGPL). ( See the lgpl.license file for details.)
+ * ------------------------------------------------------------------------
+ */
+#include <stdlib.h>
+#include "ccmath.h"
+void chousv(Cpx * a, double *d, double *dp, int n)
+{
+    double sc, x, y;
+
+    Cpx cc, u, *qs;
+
+    int i, j, k, m, e;
+
+    Cpx *qw, *pc, *p, *q;
+
+    qs = (Cpx *) calloc(2 * n, sizeof(Cpx));
+    q = qs + n;
+    for (j = 0, pc = a; j < n - 2; ++j, pc += n + 1, ++q) {
+	m = n - j - 1;
+	for (i = 1, sc = 0.; i <= m; ++i)
+	    sc += pc[i].re * pc[i].re + pc[i].im * pc[i].im;
+	if (sc > 0.) {
+	    sc = sqrt(sc);
+	    p = pc + 1;
+	    y = sc + (x = sqrt(p->re * p->re + p->im * p->im));
+	    if (x > 0.) {
+		cc.re = p->re / x;
+		cc.im = p->im / x;
+	    }
+	    else {
+		cc.re = 1.;
+		cc.im = 0.;
+	    }
+	    q->re = -cc.re;
+	    q->im = -cc.im;
+	    x = 1. / sqrt(2. * sc * y);
+	    y *= x;
+	    for (i = 0, qw = pc + 1; i < m; ++i) {
+		qs[i].re = qs[i].im = 0.;
+		if (i) {
+		    qw[i].re *= x;
+		    qw[i].im *= -x;
+		}
+		else {
+		    qw[0].re = y * cc.re;
+		    qw[0].im = -y * cc.im;
+		}
+	    }
+	    for (i = 0, e = j + 2, p = pc + n + 1, y = 0.; i < m;
+		 ++i, p += e++) {
+		qs[i].re += (u.re = qw[i].re) * p->re - (u.im =
+							 qw[i].im) * p->im;
+		qs[i].im += u.re * p->im + u.im * p->re;
+		++p;
+		for (k = i + 1; k < m; ++k, ++p) {
+		    qs[i].re += qw[k].re * p->re - qw[k].im * p->im;
+		    qs[i].im += qw[k].im * p->re + qw[k].re * p->im;
+		    qs[k].re += u.re * p->re + u.im * p->im;
+		    qs[k].im += u.im * p->re - u.re * p->im;
+		}
+		y += u.re * qs[i].re + u.im * qs[i].im;
+	    }
+	    for (i = 0; i < m; ++i) {
+		qs[i].re -= y * qw[i].re;
+		qs[i].re += qs[i].re;
+		qs[i].im -= y * qw[i].im;
+		qs[i].im += qs[i].im;
+	    }
+	    for (i = 0, e = j + 2, p = pc + n + 1; i < m; ++i, p += e++) {
+		for (k = i; k < m; ++k, ++p) {
+		    p->re -= qw[i].re * qs[k].re + qw[i].im * qs[k].im
+			+ qs[i].re * qw[k].re + qs[i].im * qw[k].im;
+		    p->im -= qw[i].im * qs[k].re - qw[i].re * qs[k].im
+			+ qs[i].im * qw[k].re - qs[i].re * qw[k].im;
+		}
+	    }
+	}
+	d[j] = pc->re;
+	dp[j] = sc;
+    }
+    d[j] = pc->re;
+    cc = *(pc + 1);
+    d[j + 1] = (pc += n + 1)->re;
+    dp[j] = sc = sqrt(cc.re * cc.re + cc.im * cc.im);
+    q->re = cc.re /= sc;
+    q->im = cc.im /= sc;
+    for (i = 0, m = n + n, p = pc; i < m; ++i, --p)
+	p->re = p->im = 0.;
+    pc->re = 1.;
+    (pc -= n + 1)->re = 1.;
+    qw = pc - n;
+    for (m = 2; m < n; ++m, qw -= n + 1) {
+	for (j = 0, p = pc, pc->re = 1.; j < m; ++j, p += n) {
+	    for (i = 0, q = p, u.re = u.im = 0.; i < m; ++i, ++q) {
+		u.re += qw[i].re * q->re - qw[i].im * q->im;
+		u.im += qw[i].re * q->im + qw[i].im * q->re;
+	    }
+	    for (i = 0, q = p, u.re += u.re, u.im += u.im; i < m; ++i, ++q) {
+		q->re -= u.re * qw[i].re + u.im * qw[i].im;
+		q->im -= u.im * qw[i].re - u.re * qw[i].im;
+	    }
+	}
+	for (i = 0, p = qw + m - 1; i < n; ++i, --p)
+	    p->re = p->im = 0.;
+	(pc -= n + 1)->re = 1.;
+    }
+    for (j = 1, p = a + n + 1, q = qs + n, u.re = 1., u.im = 0.; j < n;
+	 ++j, ++p, ++q) {
+	sc = u.re * q->re - u.im * q->im;
+	u.im = u.im * q->re + u.re * q->im;
+	u.re = sc;
+	for (i = 1; i < n; ++i, ++p) {
+	    sc = u.re * p->re - u.im * p->im;
+	    p->im = u.re * p->im + u.im * p->re;
+	    p->re = sc;
+	}
+    }
+    free(qs);
+}

lib/external/ccmath/cmattr.c

@@ -0,0 +1,18 @@
+/*  cmattr.c    CCMATH mathematics library source code.
+ *
+ *  Copyright (C)  2000   Daniel A. Atkinson    All rights reserved.
+ *  This code may be redistributed under the terms of the GNU library
+ *  public license (LGPL). ( See the lgpl.license file for details.)
+ * ------------------------------------------------------------------------
+ */
+#include "ccmath.h"
+void cmattr(Cpx * a, Cpx * b, int m, int n)
+{
+    Cpx *p;
+
+    int i, j;
+
+    for (i = 0; i < n; ++i, ++b)
+	for (j = 0, p = b; j < m; ++j, p += n)
+	    *a++ = *p;
+}

lib/external/ccmath/cmcpy.c

@@ -0,0 +1,15 @@
+/*  cmcpy.c    CCMATH mathematics library source code.
+ *
+ *  Copyright (C)  2000   Daniel A. Atkinson    All rights reserved.
+ *  This code may be redistributed under the terms of the GNU library
+ *  public license (LGPL). ( See the lgpl.license file for details.)
+ * ------------------------------------------------------------------------
+ */
+#include "ccmath.h"
+void cmcpy(Cpx * a, Cpx * b, int n)
+{
+    int i;
+
+    for (i = 0; i < n; ++i)
+	*a++ = *b++;
+}

lib/external/ccmath/cminv.c

@@ -0,0 +1,149 @@
+/*  cminv.c    CCMATH mathematics library source code.
+ *
+ *  Copyright (C)  2000   Daniel A. Atkinson    All rights reserved.
+ *  This code may be redistributed under the terms of the GNU library
+ *  public license (LGPL). ( See the lgpl.license file for details.)
+ * ------------------------------------------------------------------------
+ */
+#include <stdlib.h>
+#include "ccmath.h"
+int cminv(Cpx * a, int n)
+{
+    int i, j, k, m, lc, *le;
+
+    Cpx *ps, *p, *q, *pa, *pd;
+
+    Cpx z, h, *q0;
+
+    double s, t, tq = 0., zr = 1.e-15;
+
+    le = (int *)calloc(n, sizeof(int));
+    q0 = (Cpx *) calloc(n, sizeof(Cpx));
+    pa = pd = a;
+    for (j = 0; j < n; ++j, ++pa, pd += n + 1) {
+	if (j > 0) {
+	    for (i = 0, p = pa, q = q0; i < n; ++i, p += n)
+		*q++ = *p;
+	    for (i = 1; i < n; ++i) {
+		lc = i < j ? i : j;
+		z.re = z.im = 0.;
+		for (k = 0, p = pa + i * n - j, q = q0; k < lc; ++k, ++q, ++p) {
+		    z.re += p->re * q->re - p->im * q->im;
+		    z.im += p->im * q->re + p->re * q->im;
+		}
+		q0[i].re -= z.re;
+		q0[i].im -= z.im;
+	    }
+	    for (i = 0, p = pa, q = q0; i < n; ++i, p += n)
+		*p = *q++;
+	}
+	s = fabs(pd->re) + fabs(pd->im);
+	lc = j;
+	for (k = j + 1, ps = pd; k < n; ++k) {
+	    ps += n;
+	    if ((t = fabs(ps->re) + fabs(ps->im)) > s) {
+		s = t;
+		lc = k;
+	    }
+	}
+	tq = tq > s ? tq : s;
+	if (s < zr * tq) {
+	    free(le - j);
+	    free(q0);
+	    return -1;
+	}
+	*le++ = lc;
+	if (lc != j) {
+	    p = a + n * j;
+	    q = a + n * lc;
+	    for (k = 0; k < n; ++k, ++p, ++q) {
+		h = *p;
+		*p = *q;
+		*q = h;
+	    }
+	}
+	t = pd->re * pd->re + pd->im * pd->im;
+	h.re = pd->re / t;
+	h.im = -(pd->im) / t;
+	for (k = j + 1, ps = pd + n; k < n; ++k, ps += n) {
+	    z.re = ps->re * h.re - ps->im * h.im;
+	    z.im = ps->im * h.re + ps->re * h.im;
+	    *ps = z;
+	}
+	*pd = h;
+    }
+    for (j = 1, pd = ps = a; j < n; ++j) {
+	for (k = 0, pd += n + 1, q = ++ps; k < j; ++k, q += n) {
+	    z.re = q->re * pd->re - q->im * pd->im;
+	    z.im = q->im * pd->re + q->re * pd->im;
+	    *q = z;
+	}
+    }
+    for (j = 1, pa = a; j < n; ++j) {
+	++pa;
+	for (i = 0, q = q0, p = pa; i < j; ++i, p += n)
+	    *q++ = *p;
+	for (k = 0; k < j; ++k) {
+	    h.re = h.im = 0.;
+	    for (i = k, p = pa + k * n + k - j, q = q0 + k; i < j; ++i) {
+		h.re -= p->re * q->re - p->im * q->im;
+		h.im -= p->im * q->re + p->re * q->im;
+		++p;
+		++q;
+	    }
+	    q0[k] = h;
+	}
+	for (i = 0, q = q0, p = pa; i < j; ++i, p += n)
+	    *p = *q++;
+    }
+    for (j = n - 2, pd = pa = a + n * n - 1; j >= 0; --j) {
+	--pa;
+	pd -= n + 1;
+	for (i = 0, m = n - j - 1, q = q0, p = pd + n; i < m; ++i, p += n)
+	    *q++ = *p;
+	for (k = n - 1, ps = pa; k > j; --k, ps -= n) {
+	    z.re = -ps->re;
+	    z.im = -ps->im;
+	    for (i = j + 1, p = ps + 1, q = q0; i < k; ++i, ++p, ++q) {
+		z.re -= p->re * q->re - p->im * q->im;
+		z.im -= p->im * q->re + p->re * q->im;
+	    }
+	    q0[--m] = z;
+	}
+	for (i = 0, m = n - j - 1, q = q0, p = pd + n; i < m; ++i, p += n)
+	    *p = *q++;
+    }
+    for (k = 0, pa = a; k < n - 1; ++k, ++pa) {
+	for (i = 0, q = q0, p = pa; i < n; ++i, p += n)
+	    *q++ = *p;
+	for (j = 0, ps = a; j < n; ++j, ps += n) {
+	    if (j > k) {
+		h.re = h.im = 0.;
+		p = ps + j;
+		i = j;
+	    }
+	    else {
+		h = q0[j];
+		p = ps + k + 1;
+		i = k + 1;
+	    }
+	    for (; i < n; ++i, ++p) {
+		h.re += p->re * q0[i].re - p->im * q0[i].im;
+		h.im += p->im * q0[i].re + p->re * q0[i].im;
+	    }
+	    q0[j] = h;
+	}
+	for (i = 0, q = q0, p = pa; i < n; ++i, p += n)
+	    *p = *q++;
+    }
+    for (j = n - 2, le--; j >= 0; --j) {
+	for (k = 0, p = a + j, q = a + *(--le); k < n; ++k, p += n, q += n) {
+	    h = *p;
+	    *p = *q;
+	    *q = h;
+	}
+    }
+    free(le);
+    free(q0);
+    return 0;
+}

lib/external/ccmath/cmmul.c

@@ -0,0 +1,28 @@
+/*  cmmul.c    CCMATH mathematics library source code.
+ *
+ *  Copyright (C)  2000   Daniel A. Atkinson    All rights reserved.
+ *  This code may be redistributed under the terms of the GNU library
+ *  public license (LGPL). ( See the lgpl.license file for details.)
+ * ------------------------------------------------------------------------
+ */
+#include "ccmath.h"
+void cmmul(Cpx * c, Cpx * a, Cpx * b, int n)
+{
+    Cpx s, *p, *q;
+
+    int i, j, k;
+
+    trncm(b, n);
+    for (i = 0; i < n; ++i, a += n) {
+	for (j = 0, q = b; j < n; ++j) {
+	    for (k = 0, p = a, s.re = s.im = 0.; k < n; ++k) {
+		s.re += p->re * q->re - p->im * q->im;
+		s.im += p->im * q->re + p->re * q->im;
+		++p;
+		++q;
+	    }
+	    *c++ = s;
+	}
+    }
+    trncm(b, n);
+}

lib/external/ccmath/cmmult.c

@@ -0,0 +1,29 @@
+/*  cmmult.c    CCMATH mathematics library source code.
+ *
+ *  Copyright (C)  2000   Daniel A. Atkinson    All rights reserved.
+ *  This code may be redistributed under the terms of the GNU library
+ *  public license (LGPL). ( See the lgpl.license file for details.)
+ * ------------------------------------------------------------------------
+ */
+#include <stdlib.h>
+#include "ccmath.h"
+void cmmult(Cpx * cm, Cpx * a, Cpx * b, int n, int m, int l)
+{
+    Cpx z, *q0, *p, *q;
+
+    int i, j, k;
+
+    q0 = (Cpx *) calloc(m, sizeof(Cpx));
+    for (i = 0; i < l; ++i, ++cm) {
+	for (k = 0, p = b + i; k < m; p += l)
+	    q0[k++] = *p;
+	for (j = 0, p = a, q = cm; j < n; ++j, q += l) {
+	    for (k = 0, z.re = z.im = 0.; k < m; ++k, ++p) {
+		z.re += p->re * q0[k].re - p->im * q0[k].im;
+		z.im += p->im * q0[k].re + p->re * q0[k].im;
+	    }
+	    *q = z;
+	}
+    }
+    free(q0);
+}

lib/external/ccmath/cmprt.c

@@ -0,0 +1,20 @@
+/*  cmprt.c    CCMATH mathematics library source code.
+ *
+ *  Copyright (C)  2000   Daniel A. Atkinson    All rights reserved.
+ *  This code may be redistributed under the terms of the GNU library
+ *  public license (LGPL). ( See the lgpl.license file for details.)
+ * ------------------------------------------------------------------------
+ */
+#include "ccmath.h"
+void cmprt(Cpx * a, int m, int n, char *f)
+{
+    int i, j;
+
+    Cpx *p;
+
+    for (i = 0, p = a; i < m; ++i) {
+	for (j = 0; j < n; ++j, ++p)
+	    printf(f, p->re, p->im);
+	printf("\n");
+    }
+}

lib/external/ccmath/csolv.c

@@ -0,0 +1,102 @@
+/*  csolv.c    CCMATH mathematics library source code.
+ *
+ *  Copyright (C)  2000   Daniel A. Atkinson    All rights reserved.
+ *  This code may be redistributed under the terms of the GNU library
+ *  public license (LGPL). ( See the lgpl.license file for details.)
+ * ------------------------------------------------------------------------
+ */
+#include <stdlib.h>
+#include "ccmath.h"
+int csolv(Cpx * a, Cpx * b, int n)
+{
+    int i, j, k, lc;
+
+    Cpx *ps, *p, *q, *pa, *pd;
+
+    Cpx z, h, *q0;
+
+    double s, t, tq = 0., zr = 1.e-15;
+
+    q0 = (Cpx *) calloc(n, sizeof(Cpx));
+    pa = a;
+    pd = a;
+    for (j = 0; j < n; ++j, ++pa, pd += n + 1) {
+	if (j > 0) {
+	    for (i = 0, p = pa, q = q0; i < n; ++i, p += n)
+		*q++ = *p;
+	    for (i = 1; i < n; ++i) {
+		lc = i < j ? i : j;
+		z.re = z.im = 0.;
+		for (k = 0, p = pa + i * n - j, q = q0; k < lc; ++k, ++q, ++p) {
+		    z.re += p->re * q->re - p->im * q->im;
+		    z.im += p->im * q->re + p->re * q->im;
+		}
+		q0[i].re -= z.re;
+		q0[i].im -= z.im;
+	    }
+	    for (i = 0, p = pa, q = q0; i < n; ++i, p += n)
+		*p = *q++;
+	}
+	s = fabs(pd->re) + fabs(pd->im);
+	lc = j;
+	for (k = j + 1, ps = pd; k < n; ++k) {
+	    ps += n;
+	    if ((t = fabs(ps->re) + fabs(ps->im)) > s) {
+		s = t;
+		lc = k;
+	    }
+	}
+	tq = tq > s ? tq : s;
+	if (s < zr * tq) {
+	    free(q0);
+	    return -1;
+	}
+	if (lc != j) {
+	    h = b[j];
+	    b[j] = b[lc];
+	    b[lc] = h;
+	    p = a + n * j;
+	    q = a + n * lc;
+	    for (k = 0; k < n; ++k) {
+		h = *p;
+		*p++ = *q;
+		*q++ = h;
+	    }
+	}
+	t = pd->re * pd->re + pd->im * pd->im;
+	h.re = pd->re / t;
+	h.im = -(pd->im) / t;
+	for (k = j + 1, ps = pd + n; k < n; ++k, ps += n) {
+	    z.re = ps->re * h.re - ps->im * h.im;
+	    z.im = ps->im * h.re + ps->re * h.im;
+	    *ps = z;
+	}
+    }
+    for (j = 1, ps = b + 1; j < n; ++j, ++ps) {
+	for (k = 0, p = a + n * j, q = b, z.re = z.im = 0.; k < j; ++k) {
+	    z.re += p->re * q->re - p->im * q->im;
+	    z.im += p->im * q->re + p->re * q->im;
+	    ++p;
+	    ++q;
+	}
+	ps->re -= z.re;
+	ps->im -= z.im;
+    }
+    for (j = n - 1, --ps, pd = a + n * n - 1; j >= 0; --j, pd -= n + 1) {
+	for (k = j + 1, p = pd + 1, q = b + j + 1, z.re = z.im = 0.; k < n;
+	     ++k) {
+	    z.re += p->re * q->re - p->im * q->im;
+	    z.im += p->im * q->re + p->re * q->im;
+	    ++p;
+	    ++q;
+	}
+	h.re = ps->re - z.re;
+	h.im = ps->im - z.im;
+	t = pd->re * pd->re + pd->im * pd->im;
+	ps->re = (h.re * pd->re + h.im * pd->im) / t;
+	ps->im = (h.im * pd->re - h.re * pd->im) / t;
+	--ps;
+    }
+    free(q0);
+    return 0;
+}

lib/external/ccmath/cvmul.c

@@ -0,0 +1,36 @@
+/*  cvmul.c    CCMATH mathematics library source code.
+ *
+ *  Copyright (C)  2000   Daniel A. Atkinson    All rights reserved.
+ *  This code may be redistributed under the terms of the GNU library
+ *  public license (LGPL). ( See the lgpl.license file for details.)
+ * ------------------------------------------------------------------------
+ */
+#include "ccmath.h"
+void cvmul(Cpx * u, Cpx * a, Cpx * v, int n)
+{
+    Cpx *q;
+
+    int i, j;
+
+    for (i = 0; i < n; ++i, ++u) {
+	u->re = u->im = 0.;
+	for (j = 0, q = v; j < n; ++j, ++a, ++q) {
+	    u->re += a->re * q->re - a->im * q->im;
+	    u->im += a->im * q->re + a->re * q->im;
+	}
+    }
+}
+
+Cpx cvnrm(Cpx * u, Cpx * v, int n)
+{
+    int k;
+
+    Cpx z;
+
+    z.re = z.im = 0.;
+    for (k = 0; k < n; ++k, ++u, ++v) {
+	z.re += u->re * v->re + u->im * v->im;
+	z.im += u->re * v->im - u->im * v->re;
+    }
+    return z;
+}

lib/external/ccmath/eigen.c

@@ -0,0 +1,19 @@
+/*  eigen.c    CCMATH mathematics library source code.
+ *
+ *  Copyright (C)  2000   Daniel A. Atkinson    All rights reserved.
+ *  This code may be redistributed under the terms of the GNU library
+ *  public license (LGPL). ( See the lgpl.license file for details.)
+ * ------------------------------------------------------------------------
+ */
+#include <stdlib.h>
+#include "ccmath.h"
+void eigen(double *a, double *ev, int n)
+{
+    double *dp;
+
+    dp = (double *)calloc(n, sizeof(double));
+    housev(a, ev, dp, n);
+    qrevec(ev, a, dp, n);
+    trnm(a, n);
+    free(dp);
+}

lib/external/ccmath/eigval.c

@@ -0,0 +1,18 @@
+/*  eigval.c    CCMATH mathematics library source code.
+ *
+ *  Copyright (C)  2000   Daniel A. Atkinson    All rights reserved.
+ *  This code may be redistributed under the terms of the GNU library
+ *  public license (LGPL). ( See the lgpl.license file for details.)
+ * ------------------------------------------------------------------------
+ */
+#include <stdlib.h>
+#include "ccmath.h"
+void eigval(double *a, double *ev, int n)
+{
+    double *dp;
+
+    dp = (double *)calloc(n, sizeof(double));
+    house(a, ev, dp, n);
+    qreval(ev, dp, n);
+    free(dp);
+}

lib/external/ccmath/evmax.c

@@ -0,0 +1,47 @@
+/*  evmax.c    CCMATH mathematics library source code.
+ *
+ *  Copyright (C)  2000   Daniel A. Atkinson    All rights reserved.
+ *  This code may be redistributed under the terms of the GNU library
+ *  public license (LGPL). ( See the lgpl.license file for details.)
+ * ------------------------------------------------------------------------
+ */
+#include <stdlib.h>
+#include "ccmath.h"
+double evmax(double *a, double *u, int n)
+{
+    double *p, *q, *qm, *r, *s, *t;
+
+    double ev, evm, c, h;
+
+    int kc;
+
+    q = (double *)calloc(n, sizeof(double));
+    qm = q + n;
+    *(qm - 1) = 1.;
+    ev = 0.;
+    for (kc = 0; kc < 200; ++kc) {
+	h = c = 0.;
+	evm = ev;
+	for (p = u, r = a, s = q; s < qm;) {
+	    *p = 0.;
+	    for (t = q; t < qm;)
+		*p += *r++ * *t++;
+	    c += *p * *p;
+	    h += *p++ * *s++;
+	}
+	ev = c / h;
+	c = sqrt(c);
+	for (p = u, s = q; s < qm;) {
+	    *p /= c;
+	    *s++ = *p++;
+	}
+	if (((c = ev - evm) < 0. ? -c : c) < 1.e-16 * (ev < 0. ? -ev : ev)) {
+	    free(q);
+	    return ev;
+	}
+    }
+    free(q);
+    for (kc = 0; kc < n;)
+	u[kc++] = 0.;
+    return 0.;
+}

lib/external/ccmath/hconj.c

@@ -0,0 +1,26 @@
+/*  hconj.c    CCMATH mathematics library source code.
+ *
+ *  Copyright (C)  2000   Daniel A. Atkinson    All rights reserved.
+ *  This code may be redistributed under the terms of the GNU library
+ *  public license (LGPL). ( See the lgpl.license file for details.)
+ * ------------------------------------------------------------------------
+ */
+#include "ccmath.h"
+void hconj(Cpx * a, int n)
+{
+    Cpx s, *p, *q;
+
+    int i, j, e;
+
+    for (i = 0, e = n - 1; i < n; ++i, --e, a += n + 1) {
+	for (j = 0, p = a + 1, q = a + n; j < e; ++j) {
+	    s = *p;
+	    s.im = -s.im;
+	    p->re = q->re;
+	    (p++)->im = -q->im;
+	    *q = s;
+	    q += n;
+	}
+	a->im = -a->im;
+    }
+}

lib/external/ccmath/heigval.c

@@ -0,0 +1,18 @@
+/*  heigval.c    CCMATH mathematics library source code.
+ *
+ *  Copyright (C)  2000   Daniel A. Atkinson    All rights reserved.
+ *  This code may be redistributed under the terms of the GNU library
+ *  public license (LGPL). ( See the lgpl.license file for details.)
+ * ------------------------------------------------------------------------
+ */
+#include <stdlib.h>
+#include "ccmath.h"
+void heigval(Cpx * a, double *ev, int n)
+{
+    double *dp;
+
+    dp = (double *)calloc(n, sizeof(double));
+    chouse(a, ev, dp, n);
+    qreval(ev, dp, n);
+    free(dp);
+}

lib/external/ccmath/heigvec.c

@@ -0,0 +1,19 @@
+/*  heigvec.c    CCMATH mathematics library source code.
+ *
+ *  Copyright (C)  2000   Daniel A. Atkinson    All rights reserved.
+ *  This code may be redistributed under the terms of the GNU library
+ *  public license (LGPL). ( See the lgpl.license file for details.)
+ * ------------------------------------------------------------------------
+ */
+#include <stdlib.h>
+#include "ccmath.h"
+void heigvec(Cpx * a, double *ev, int n)
+{
+    double *dp;
+
+    dp = (double *)calloc(n, sizeof(double));
+    chousv(a, ev, dp, n);
+    qrecvc(ev, a, dp, n);
+    hconj(a, n);
+    free(dp);
+}

lib/external/ccmath/hevmax.c

@@ -0,0 +1,42 @@
+/*  hevmax.c    CCMATH mathematics library source code.
+ *
+ *  Copyright (C)  2000   Daniel A. Atkinson    All rights reserved.
+ *  This code may be redistributed under the terms of the GNU library
+ *  public license (LGPL). ( See the lgpl.license file for details.)
+ * ------------------------------------------------------------------------
+ */
+#include <stdlib.h>
+#include "ccmath.h"
+double hevmax(Cpx * a, Cpx * u, int n)
+{
+    Cpx *x, *p, h;
+
+    double e, ep, s, t, te = 1.e-12;
+
+    int k, j;
+
+    x = (Cpx *) calloc(n, sizeof(Cpx));
+    x[0].re = 1.;
+    e = 0.;
+    do {
+	for (k = 0, p = a, s = t = 0.; k < n; ++k) {
+	    for (j = 0, h.re = h.im = 0.; j < n; ++j, ++p) {
+		h.re += p->re * x[j].re - p->im * x[j].im;
+		h.im += p->im * x[j].re + p->re * x[j].im;
+	    }
+	    s += h.re * h.re + h.im * h.im;
+	    t += h.re * x[k].re + h.im * x[k].im;
+	    u[k] = h;
+	}
+	ep = e;
+	e = s / t;
+	s = 1. / sqrt(s);
+	for (k = 0; k < n; ++k) {
+	    u[k].re *= s;
+	    u[k].im *= s;
+	    x[k] = u[k];
+	}
+    } while (fabs(e - ep) > fabs(te * e));
+    free(x);
+    return e;
+}

lib/external/ccmath/hmgen.c

@@ -0,0 +1,29 @@
+/*  hmgen.c    CCMATH mathematics library source code.
+ *
+ *  Copyright (C)  2000   Daniel A. Atkinson    All rights reserved.
+ *  This code may be redistributed under the terms of the GNU library
+ *  public license (LGPL). ( See the lgpl.license file for details.)
+ * ------------------------------------------------------------------------
+ */
+#include <stdlib.h>
+#include "ccmath.h"
+void hmgen(Cpx * h, double *ev, Cpx * u, int n)
+{
+    Cpx *v, *p;
+
+    int i, j;
+
+    double e;
+
+    v = (Cpx *) calloc(n * n, sizeof(Cpx));
+    cmcpy(v, u, n * n);
+    hconj(v, n);
+    for (i = 0, p = v; i < n; ++i) {
+	for (j = 0, e = ev[i]; j < n; ++j, ++p) {
+	    p->re *= e;
+	    p->im *= e;
+	}
+    }
+    cmmul(h, u, v, n);
+    free(v);
+}

lib/external/ccmath/house.c

@@ -0,0 +1,73 @@
+/*  house.c    CCMATH mathematics library source code.
+ *
+ *  Copyright (C)  2000   Daniel A. Atkinson    All rights reserved.
+ *  This code may be redistributed under the terms of the GNU library
+ *  public license (LGPL). ( See the lgpl.license file for details.)
+ * ------------------------------------------------------------------------
+ */
+#include <stdlib.h>
+#include "ccmath.h"
+void house(double *a, double *d, double *dp, int n)
+{
+    double sc, x, y, h;
+
+    int i, j, k, m, e;
+
+    double *qw, *qs, *pc, *p;
+
+    qs = (double *)calloc(2 * n, sizeof(double));
+    for (j = 0, qw = qs + n, pc = a; j < n; pc += n + 1)
+	qw[j++] = *pc;
+    for (j = 0, pc = a; j < n - 2; ++j, pc += n + 1) {
+	m = n - j - 1;
+	for (i = 1, sc = 0.; i <= m; ++i)
+	    sc += pc[i] * pc[i];
+	if (sc > 0.) {
+	    sc = sqrt(sc);
+	    if ((x = *(pc + 1)) < 0.) {
+		y = x - sc;
+		h = 1. / sqrt(-2. * sc * y);
+	    }
+	    else {
+		y = x + sc;
+		h = 1. / sqrt(2. * sc * y);
+		sc = -sc;
+	    }
+	    for (i = 0, qw = pc + 1; i < m; ++i) {
+		qs[i] = 0.;
+		if (i)
+		    qw[i] *= h;
+		else
+		    qw[i] = y * h;
+	    }
+	    for (i = 0, e = j + 2, p = pc + n + 1, h = 0.; i < m;
+		 ++i, p += e++) {
+		qs[i] += (y = qw[i]) * *p++;
+		for (k = i + 1; k < m; ++k) {
+		    qs[i] += qw[k] * *p;
+		    qs[k] += y * *p++;
+		}
+		h += y * qs[i];
+	    }
+	    for (i = 0; i < m; ++i) {
+		qs[i] -= h * qw[i];
+		qs[i] += qs[i];
+	    }
+	    for (i = 0, e = j + 2, p = pc + n + 1; i < m; ++i, p += e++) {
+		for (k = i; k < m; ++k)
+		    *p++ -= qw[i] * qs[k] + qs[i] * qw[k];
+	    }
+	}
+	d[j] = *pc;
+	dp[j] = sc;
+    }
+    d[j] = *pc;
+    dp[j] = *(pc + 1);
+    d[j + 1] = *(pc + n + 1);
+    for (j = 0, pc = a, qw = qs + n; j < n; ++j, pc += n + 1) {
+	*pc = qw[j];
+	for (i = 1, p = pc + n; i < n - j; p += n)
+	    pc[i++] = *p;
+    }
+    free(qs);
+}

lib/external/ccmath/housev.c

@@ -0,0 +1,82 @@
+/*  housev.c    CCMATH mathematics library source code.
+ *
+ *  Copyright (C)  2000   Daniel A. Atkinson    All rights reserved.
+ *  This code may be redistributed under the terms of the GNU library
+ *  public license (LGPL). ( See the lgpl.license file for details.)
+ * ------------------------------------------------------------------------
+ */
+#include <stdlib.h>
+#include "ccmath.h"
+void housev(double *a, double *d, double *dp, int n)
+{
+    double sc, x, y, h;
+
+    int i, j, k, m, e;
+
+    double *qw, *qs, *pc, *p;
+
+    qs = (double *)calloc(n, sizeof(double));
+    for (j = 0, pc = a; j < n - 2; ++j, pc += n + 1) {
+	m = n - j - 1;
+	for (i = 1, sc = 0.; i <= m; ++i)
+	    sc += pc[i] * pc[i];
+	if (sc > 0.) {
+	    sc = sqrt(sc);
+	    if ((x = *(pc + 1)) < 0.) {
+		y = x - sc;
+		h = 1. / sqrt(-2. * sc * y);
+	    }
+	    else {
+		y = x + sc;
+		h = 1. / sqrt(2. * sc * y);
+		sc = -sc;
+	    }
+	    for (i = 0, qw = pc + 1; i < m; ++i) {
+		qs[i] = 0.;
+		if (i)
+		    qw[i] *= h;
+		else
+		    qw[i] = y * h;
+	    }
+	    for (i = 0, e = j + 2, p = pc + n + 1, h = 0.; i < m;
+		 ++i, p += e++) {
+		qs[i] += (y = qw[i]) * *p++;
+		for (k = i + 1; k < m; ++k) {
+		    qs[i] += qw[k] * *p;
+		    qs[k] += y * *p++;
+		}
+		h += y * qs[i];
+	    }
+	    for (i = 0; i < m; ++i) {
+		qs[i] -= h * qw[i];
+		qs[i] += qs[i];
+	    }
+	    for (i = 0, e = j + 2, p = pc + n + 1; i < m; ++i, p += e++) {
+		for (k = i; k < m; ++k)
+		    *p++ -= qw[i] * qs[k] + qs[i] * qw[k];
+	    }
+	}
+	d[j] = *pc;
+	dp[j] = sc;
+    }
+    d[j] = *pc;
+    dp[j] = *(pc + 1);
+    d[j + 1] = *(pc += n + 1);
+    free(qs);
+    for (i = 0, m = n + n, p = pc; i < m; ++i)
+	*p-- = 0.;
+    *pc = 1.;
+    *(pc -= n + 1) = 1.;
+    qw = pc - n;
+    for (m = 2; m < n; ++m, qw -= n + 1) {
+	for (j = 0, p = pc, *pc = 1.; j < m; ++j, p += n) {
+	    for (i = 0, qs = p, h = 0.; i < m;)
+		h += qw[i++] * *qs++;
+	    for (i = 0, qs = p, h += h; i < m;)
+		*qs++ -= h * qw[i++];
+	}
+	for (i = 0, p = qw + m; i < n; ++i)
+	    *(--p) = 0.;
+	*(pc -= n + 1) = 1.;
+    }
+}

lib/external/ccmath/ldumat.c

@@ -0,0 +1,57 @@
+/*  ldumat.c    CCMATH mathematics library source code.
+ *
+ *  Copyright (C)  2000   Daniel A. Atkinson    All rights reserved.
+ *  This code may be redistributed under the terms of the GNU library
+ *  public license (LGPL). ( See the lgpl.license file for details.)
+ * ------------------------------------------------------------------------
+ */
+#include <stdlib.h>
+void ldumat(double *a, double *u, int m, int n)
+{
+    double *p0, *q0, *p, *q, *w;
+
+    int i, j, k, mm;
+
+    double s, h;
+
+    w = (double *)calloc(m, sizeof(double));
+    for (i = 0, mm = m * m, q = u; i < mm; ++i)
+	*q++ = 0.;
+    p0 = a + n * n - 1;
+    q0 = u + m * m - 1;
+    mm = m - n;
+    i = n - 1;
+    for (j = 0; j < mm; ++j, q0 -= m + 1)
+	*q0 = 1.;
+    if (mm == 0) {
+	p0 -= n + 1;
+	*q0 = 1.;
+	q0 -= m + 1;
+	--i;
+	++mm;
+    }
+    for (; i >= 0; --i, ++mm, p0 -= n + 1, q0 -= m + 1) {
+	if (*p0 != 0.) {
+	    for (j = 0, p = p0 + n, h = 1.; j < mm; p += n)
+		w[j++] = *p;
+	    h = *p0;
+	    *q0 = 1. - h;
+	    for (j = 0, q = q0 + m; j < mm; q += m)
+		*q = -h * w[j++];
+	    for (k = i + 1, q = q0 + 1; k < m; ++k) {
+		for (j = 0, p = q + m, s = 0.; j < mm; p += m)
+		    s += w[j++] * *p;
+		s *= h;
+		for (j = 0, p = q + m; j < mm; p += m)
+		    *p -= s * w[j++];
+		*q++ = -s;
+	    }
+	}
+	else {
+	    *q0 = 1.;
+	    for (j = 0, p = q0 + 1, q = q0 + m; j < mm; ++j, q += m)
+		*q = *p++ = 0.;
+	}
+    }
+    free(w);
+}

lib/external/ccmath/ldvmat.c

@@ -0,0 +1,46 @@
+/*  ldvmat.c    CCMATH mathematics library source code.
+ *
+ *  Copyright (C)  2000   Daniel A. Atkinson    All rights reserved.
+ *  This code may be redistributed under the terms of the GNU library
+ *  public license (LGPL). ( See the lgpl.license file for details.)
+ * ------------------------------------------------------------------------
+ */
+void ldvmat(double *a, double *v, int n)
+{
+    double *p0, *q0, *p, *q, *qq;
+
+    double h, s;
+
+    int i, j, k, mm;
+
+    for (i = 0, mm = n * n, q = v; i < mm; ++i)
+	*q++ = 0.;
+    *v = 1.;
+    q0 = v + n * n - 1;
+    *q0 = 1.;
+    q0 -= n + 1;
+    p0 = a + n * n - n - n - 1;
+    for (i = n - 2, mm = 1; i > 0; --i, p0 -= n + 1, q0 -= n + 1, ++mm) {
+	if (*(p0 - 1) != 0.) {
+	    for (j = 0, p = p0, h = 1.; j < mm; ++j, ++p)
+		h += *p * *p;
+	    h = *(p0 - 1);
+	    *q0 = 1. - h;
+	    for (j = 0, q = q0 + n, p = p0; j < mm; ++j, q += n)
+		*q = -h * *p++;
+	    for (k = i + 1, q = q0 + 1; k < n; ++k) {
+		for (j = 0, qq = q + n, p = p0, s = 0.; j < mm; ++j, qq += n)
+		    s += *qq * *p++;
+		s *= h;
+		for (j = 0, qq = q + n, p = p0; j < mm; ++j, qq += n)
+		    *qq -= s * *p++;
+		*q++ = -s;
+	    }
+	}
+	else {
+	    *q0 = 1.;
+	    for (j = 0, p = q0 + 1, q = q0 + n; j < mm; ++j, q += n)
+		*q = *p++ = 0.;
+	}
+    }
+}

lib/external/ccmath/lgpl.license

@@ -0,0 +1,513 @@
+
+                  GNU LESSER GENERAL PUBLIC LICENSE
+                       Version 2.1, February 1999
+
+ Copyright (C) 1991, 1999 Free Software Foundation, Inc.
+     59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+[This is the first released version of the Lesser GPL.  It also counts
+ as the successor of the GNU Library Public License, version 2, hence
+ the version number 2.1.]
+
+                            Preamble
+
+  The licenses for most software are designed to take away your
+freedom to share and change it.  By contrast, the GNU General Public
+Licenses are intended to guarantee your freedom to share and change
+free software--to make sure the software is free for all its users.
+
+  This license, the Lesser General Public License, applies to some
+specially designated software packages--typically libraries--of the
+Free Software Foundation and other authors who decide to use it.  You
+can use it too, but we suggest you first think carefully about whether
+this license or the ordinary General Public License is the better
+strategy to use in any particular case, based on the explanations
+below.
+
+  When we speak of free software, we are referring to freedom of use,
+not price.  Our General Public Licenses are designed to make sure that
+you have the freedom to distribute copies of free software (and charge
+for this service if you wish); that you receive source code or can get
+it if you want it; that you can change the software and use pieces of
+it in new free programs; and that you are informed that you can do
+these things.
+
+  To protect your rights, we need to make restrictions that forbid
+distributors to deny you these rights or to ask you to surrender these
+rights.  These restrictions translate to certain responsibilities for
+you if you distribute copies of the library or if you modify it.
+
+  For example, if you distribute copies of the library, whether gratis
+or for a fee, you must give the recipients all the rights that we gave
+you.  You must make sure that they, too, receive or can get the source
+code.  If you link other code with the library, you must provide
+complete object files to the recipients, so that they can relink them
+with the library after making changes to the library and recompiling
+it.  And you must show them these terms so they know their rights.
+
+  We protect your rights with a two-step method: (1) we copyright the
+library, and (2) we offer you this license, which gives you legal
+permission to copy, distribute and/or modify the library.
+
+  To protect each distributor, we want to make it very clear that
+there is no warranty for the free library.  Also, if the library is
+modified by someone else and passed on, the recipients should know
+that what they have is not the original version, so that the original
+author's reputation will not be affected by problems that might be
+introduced by others.
+^L
+  Finally, software patents pose a constant threat to the existence of
+any free program.  We wish to make sure that a company cannot
+effectively restrict the users of a free program by obtaining a
+restrictive license from a patent holder.  Therefore, we insist that
+any patent license obtained for a version of the library must be
+consistent with the full freedom of use specified in this license.
+
+  Most GNU software, including some libraries, is covered by the
+ordinary GNU General Public License.  This license, the GNU Lesser
+General Public License, applies to certain designated libraries, and
+is quite different from the ordinary General Public License.  We use
+this license for certain libraries in order to permit linking those
+libraries into non-free programs.
+
+  When a program is linked with a library, whether statically or using
+a shared library, the combination of the two is legally speaking a
+combined work, a derivative of the original library.  The ordinary
+General Public License therefore permits such linking only if the
+entire combination fits its criteria of freedom.  The Lesser General
+Public License permits more lax criteria for linking other code with
+the library.
+
+  We call this license the "Lesser" General Public License because it
+does Less to protect the user's freedom than the ordinary General
+Public License.  It also provides other free software developers Less
+of an advantage over competing non-free programs.  These disadvantages
+are the reason we use the ordinary General Public License for many
+libraries.  However, the Lesser license provides advantages in certain
+special circumstances.
+
+  For example, on rare occasions, there may be a special need to
+encourage the widest possible use of a certain library, so that it
+becomes a de-facto standard.  To achieve this, non-free programs must be
+allowed to use the library.  A more frequent case is that a free
+library does the same job as widely used non-free libraries.  In this
+case, there is little to gain by limiting the free library to free
+software only, so we use the Lesser General Public License.
+
+  In other cases, permission to use a particular library in non-free
+programs enables a greater number of people to use a large body of
+free software.  For example, permission to use the GNU C Library in
+non-free programs enables many more people to use the whole GNU
+operating system, as well as its variant, the GNU/Linux operating
+system.
+
+  Although the Lesser General Public License is Less protective of the
+users' freedom, it does ensure that the user of a program that is
+linked with the Library has the freedom and the wherewithal to run
+that program using a modified version of the Library.
+
+  The precise terms and conditions for copying, distribution and
+modification follow.  Pay close attention to the difference between a
+"work based on the library" and a "work that uses the library".  The
+former contains code derived from the library, whereas the latter must
+be combined with the library in order to run.
+^L
+                  GNU LESSER GENERAL PUBLIC LICENSE
+   TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
+
+  0. This License Agreement applies to any software library or other
+program which contains a notice placed by the copyright holder or
+other authorized party saying it may be distributed under the terms of
+this Lesser General Public License (also called "this License").
+Each licensee is addressed as "you".
+
+  A "library" means a collection of software functions and/or data
+prepared so as to be conveniently linked with application programs
+(which use some of those functions and data) to form executables.
+
+  The "Library", below, refers to any such software library or work
+which has been distributed under these terms.  A "work based on the
+Library" means either the Library or any derivative work under
+copyright law: that is to say, a work containing the Library or a
+portion of it, either verbatim or with modifications and/or translated
+straightforwardly into another language.  (Hereinafter, translation is
+included without limitation in the term "modification".)
+
+  "Source code" for a work means the preferred form of the work for
+making modifications to it.  For a library, complete source code means
+all the source code for all modules it contains, plus any associated
+interface definition files, plus the scripts used to control
+compilation and installation of the library.
+
+  Activities other than copying, distribution and modification are not
+covered by this License; they are outside its scope.  The act of
+running a program using the Library is not restricted, and output from
+such a program is covered only if its contents constitute a work based
+on the Library (independent of the use of the Library in a tool for
+writing it).  Whether that is true depends on what the Library does
+and what the program that uses the Library does.
+
+  1. You may copy and distribute verbatim copies of the Library's
+complete source code as you receive it, in any medium, provided that
+you conspicuously and appropriately publish on each copy an
+appropriate copyright notice and disclaimer of warranty; keep intact
+all the notices that refer to this License and to the absence of any
+warranty; and distribute a copy of this License along with the
+Library.
+
+  You may charge a fee for the physical act of transferring a copy,
+and you may at your option offer warranty protection in exchange for a
+fee.
+
+  2. You may modify your copy or copies of the Library or any portion
+of it, thus forming a work based on the Library, and copy and
+distribute such modifications or work under the terms of Section 1
+above, provided that you also meet all of these conditions:
+
+    a) The modified work must itself be a software library.
+
+    b) You must cause the files modified to carry prominent notices
+    stating that you changed the files and the date of any change.
+
+    c) You must cause the whole of the work to be licensed at no
+    charge to all third parties under the terms of this License.
+
+    d) If a facility in the modified Library refers to a function or a
+    table of data to be supplied by an application program that uses
+    the facility, other than as an argument passed when the facility
+    is invoked, then you must make a good faith effort to ensure that,
+    in the event an application does not supply such function or
+    table, the facility still operates, and performs whatever part of
+    its purpose remains meaningful.
+
+    (For example, a function in a library to compute square roots has
+    a purpose that is entirely well-defined independent of the
+    application.  Therefore, Subsection 2d requires that any
+    application-supplied function or table used by this function must
+    be optional: if the application does not supply it, the square
+    root function must still compute square roots.)
+
+These requirements apply to the modified work as a whole.  If
+identifiable sections of that work are not derived from the Library,
+and can be reasonably considered independent and separate works in
+themselves, then this License, and its terms, do not apply to those
+sections when you distribute them as separate works.  But when you
+distribute the same sections as part of a whole which is a work based
+on the Library, the distribution of the whole must be on the terms of
+this License, whose permissions for other licensees extend to the
+entire whole, and thus to each and every part regardless of who wrote
+it.
+
+Thus, it is not the intent of this section to claim rights or contest
+your rights to work written entirely by you; rather, the intent is to
+exercise the right to control the distribution of derivative or
+collective works based on the Library.
+
+In addition, mere aggregation of another work not based on the Library
+with the Library (or with a work based on the Library) on a volume of
+a storage or distribution medium does not bring the other work under
+the scope of this License.
+
+  3. You may opt to apply the terms of the ordinary GNU General Public
+License instead of this License to a given copy of the Library.  To do
+this, you must alter all the notices that refer to this License, so
+that they refer to the ordinary GNU General Public License, version 2,
+instead of to this License.  (If a newer version than version 2 of the
+ordinary GNU General Public License has appeared, then you can specify
+that version instead if you wish.)  Do not make any other change in
+these notices.
+^L
+  Once this change is made in a given copy, it is irreversible for
+that copy, so the ordinary GNU General Public License applies to all
+subsequent copies and derivative works made from that copy.
+
+  This option is useful when you wish to copy part of the code of
+the Library into a program that is not a library.
+
+  4. You may copy and distribute the Library (or a portion or
+derivative of it, under Section 2) in object code or executable form
+under the terms of Sections 1 and 2 above provided that you accompany
+it with the complete corresponding machine-readable source code, which
+must be distributed under the terms of Sections 1 and 2 above on a
+medium customarily used for software interchange.
+
+  If distribution of object code is made by offering access to copy
+from a designated place, then offering equivalent access to copy the
+source code from the same place satisfies the requirement to
+distribute the source code, even though third parties are not
+compelled to copy the source along with the object code.
+
+  5. A program that contains no derivative of any portion of the
+Library, but is designed to work with the Library by being compiled or
+linked with it, is called a "work that uses the Library".  Such a
+work, in isolation, is not a derivative work of the Library, and
+therefore falls outside the scope of this License.
+
+  However, linking a "work that uses the Library" with the Library
+creates an executable that is a derivative of the Library (because it
+contains portions of the Library), rather than a "work that uses the
+library".  The executable is therefore covered by this License.
+Section 6 states terms for distribution of such executables.
+
+  When a "work that uses the Library" uses material from a header file
+that is part of the Library, the object code for the work may be a
+derivative work of the Library even though the source code is not.
+Whether this is true is especially significant if the work can be
+linked without the Library, or if the work is itself a library.  The
+threshold for this to be true is not precisely defined by law.
+
+  If such an object file uses only numerical parameters, data
+structure layouts and accessors, and small macros and small inline
+functions (ten lines or less in length), then the use of the object
+file is unrestricted, regardless of whether it is legally a derivative
+work.  (Executables containing this object code plus portions of the
+Library will still fall under Section 6.)
+
+  Otherwise, if the work is a derivative of the Library, you may
+distribute the object code for the work under the terms of Section 6.
+Any executables containing that work also fall under Section 6,
+whether or not they are linked directly with the Library itself.
+^L
+  6. As an exception to the Sections above, you may also combine or
+link a "work that uses the Library" with the Library to produce a
+work containing portions of the Library, and distribute that work
+under terms of your choice, provided that the terms permit
+modification of the work for the customer's own use and reverse
+engineering for debugging such modifications.
+
+  You must give prominent notice with each copy of the work that the
+Library is used in it and that the Library and its use are covered by
+this License.  You must supply a copy of this License.  If the work
+during execution displays copyright notices, you must include the
+copyright notice for the Library among them, as well as a reference
+directing the user to the copy of this License.  Also, you must do one
+of these things:
+
+    a) Accompany the work with the complete corresponding
+    machine-readable source code for the Library including whatever
+    changes were used in the work (which must be distributed under
+    Sections 1 and 2 above); and, if the work is an executable linked
+    with the Library, with the complete machine-readable "work that
+    uses the Library", as object code and/or source code, so that the
+    user can modify the Library and then relink to produce a modified
+    executable containing the modified Library.  (It is understood
+    that the user who changes the contents of definitions files in the
+    Library will not necessarily be able to recompile the application
+    to use the modified definitions.)
+
+    b) Use a suitable shared library mechanism for linking with the
+    Library.  A suitable mechanism is one that (1) uses at run time a
+    copy of the library already present on the user's computer system,
+    rather than copying library functions into the executable, and (2)
+    will operate properly with a modified version of the library, if
+    the user installs one, as long as the modified version is
+    interface-compatible with the version that the work was made with.
+
+    c) Accompany the work with a written offer, valid for at
+    least three years, to give the same user the materials
+    specified in Subsection 6a, above, for a charge no more
+    than the cost of performing this distribution.
+
+    d) If distribution of the work is made by offering access to copy
+    from a designated place, offer equivalent access to copy the above
+    specified materials from the same place.
+
+    e) Verify that the user has already received a copy of these
+    materials or that you have already sent this user a copy.
+
+  For an executable, the required form of the "work that uses the
+Library" must include any data and utility programs needed for
+reproducing the executable from it.  However, as a special exception,
+the materials to be distributed need not include anything that is
+normally distributed (in either source or binary form) with the major
+components (compiler, kernel, and so on) of the operating system on
+which the executable runs, unless that component itself accompanies
+the executable.
+
+  It may happen that this requirement contradicts the license
+restrictions of other proprietary libraries that do not normally
+accompany the operating system.  Such a contradiction means you cannot
+use both them and the Library together in an executable that you
+distribute.
+^L
+  7. You may place library facilities that are a work based on the
+Library side-by-side in a single library together with other library
+facilities not covered by this License, and distribute such a combined
+library, provided that the separate distribution of the work based on
+the Library and of the other library facilities is otherwise
+permitted, and provided that you do these two things:
+
+    a) Accompany the combined library with a copy of the same work
+    based on the Library, uncombined with any other library
+    facilities.  This must be distributed under the terms of the
+    Sections above.
+
+    b) Give prominent notice with the combined library of the fact
+    that part of it is a work based on the Library, and explaining
+    where to find the accompanying uncombined form of the same work.
+
+  8. You may not copy, modify, sublicense, link with, or distribute
+the Library except as expressly provided under this License.  Any
+attempt otherwise to copy, modify, sublicense, link with, or
+distribute the Library is void, and will automatically terminate your
+rights under this License.  However, parties who have received copies,
+or rights, from you under this License will not have their licenses
+terminated so long as such parties remain in full compliance.
+
+  9. You are not required to accept this License, since you have not
+signed it.  However, nothing else grants you permission to modify or
+distribute the Library or its derivative works.  These actions are
+prohibited by law if you do not accept this License.  Therefore, by
+modifying or distributing the Library (or any work based on the
+Library), you indicate your acceptance of this License to do so, and
+all its terms and conditions for copying, distributing or modifying
+the Library or works based on it.
+
+  10. Each time you redistribute the Library (or any work based on the
+Library), the recipient automatically receives a license from the
+original licensor to copy, distribute, link with or modify the Library
+subject to these terms and conditions.  You may not impose any further
+restrictions on the recipients' exercise of the rights granted herein.
+You are not responsible for enforcing compliance by third parties with
+this License.
+^L
+  11. If, as a consequence of a court judgment or allegation of patent
+infringement or for any other reason (not limited to patent issues),
+conditions are imposed on you (whether by court order, agreement or
+otherwise) that contradict the conditions of this License, they do not
+excuse you from the conditions of this License.  If you cannot
+distribute so as to satisfy simultaneously your obligations under this
+License and any other pertinent obligations, then as a consequence you
+may not distribute the Library at all.  For example, if a patent
+license would not permit royalty-free redistribution of the Library by
+all those who receive copies directly or indirectly through you, then
+the only way you could satisfy both it and this License would be to
+refrain entirely from distribution of the Library.
+
+If any portion of this section is held invalid or unenforceable under
+any particular circumstance, the balance of the section is intended to
+apply, and the section as a whole is intended to apply in other
+circumstances.
+
+It is not the purpose of this section to induce you to infringe any
+patents or other property right claims or to contest validity of any
+such claims; this section has the sole purpose of protecting the
+integrity of the free software distribution system which is
+implemented by public license practices.  Many people have made
+generous contributions to the wide range of software distributed
+through that system in reliance on consistent application of that
+system; it is up to the author/donor to decide if he or she is willing
+to distribute software through any other system and a licensee cannot
+impose that choice.
+
+This section is intended to make thoroughly clear what is believed to
+be a consequence of the rest of this License.
+
+  12. If the distribution and/or use of the Library is restricted in
+certain countries either by patents or by copyrighted interfaces, the
+original copyright holder who places the Library under this License
+may add an explicit geographical distribution limitation excluding those
+countries, so that distribution is permitted only in or among
+countries not thus excluded.  In such case, this License incorporates
+the limitation as if written in the body of this License.
+
+  13. The Free Software Foundation may publish revised and/or new
+versions of the Lesser General Public License from time to time.
+Such new versions will be similar in spirit to the present version,
+but may differ in detail to address new problems or concerns.
+
+Each version is given a distinguishing version number.  If the Library
+specifies a version number of this License which applies to it and
+"any later version", you have the option of following the terms and
+conditions either of that version or of any later version published by
+the Free Software Foundation.  If the Library does not specify a
+license version number, you may choose any version ever published by
+the Free Software Foundation.
+^L
+  14. If you wish to incorporate parts of the Library into other free
+programs whose distribution conditions are incompatible with these,
+write to the author to ask for permission.  For software which is
+copyrighted by the Free Software Foundation, write to the Free
+Software Foundation; we sometimes make exceptions for this.  Our
+decision will be guided by the two goals of preserving the free status
+of all derivatives of our free software and of promoting the sharing
+and reuse of software generally.
+
+                            NO WARRANTY
+
+  15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO
+WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW.
+EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR
+OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY
+KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE
+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+PURPOSE.  THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE
+LIBRARY IS WITH YOU.  SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME
+THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
+
+  16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN
+WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY
+AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU
+FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR
+CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE
+LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
+RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
+FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
+SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH
+DAMAGES.
+
+                     END OF TERMS AND CONDITIONS
+^L
+           How to Apply These Terms to Your New Libraries
+
+  If you develop a new library, and you want it to be of the greatest
+possible use to the public, we recommend making it free software that
+everyone can redistribute and change.  You can do so by permitting
+redistribution under these terms (or, alternatively, under the terms
+of the ordinary General Public License).
+
+  To apply these terms, attach the following notices to the library.
+It is safest to attach them to the start of each source file to most
+effectively convey the exclusion of warranty; and each file should
+have at least the "copyright" line and a pointer to where the full
+notice is found.
+
+
+    <one line to give the library's name and a brief idea of what it
+does.>
+    Copyright (C) <year>  <name of author>
+
+    This library is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Lesser General Public
+    License as published by the Free Software Foundation; either
+    version 2 of the License, or (at your option) any later version.
+
+    This library is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+    Lesser General Public License for more details.
+
+    You should have received a copy of the GNU Lesser General Public
+    License along with this library; if not, write to the Free Software
+    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307  USA
+
+Also add information on how to contact you by electronic and paper
+mail.
+
+You should also get your employer (if you work as a programmer) or
+your
+school, if any, to sign a "copyright disclaimer" for the library, if
+necessary.  Here is a sample; alter the names:
+
+  Yoyodyne, Inc., hereby disclaims all copyright interest in the
+  library `Frob' (a library for tweaking knobs) written by James
+Random Hacker.
+
+  <signature of Ty Coon>, 1 April 1990
+  Ty Coon, President of Vice
+
+That's all there is to it!
+
+

lib/external/ccmath/matprt.c

@@ -0,0 +1,33 @@
+/*  matprt.c    CCMATH mathematics library source code.
+ *
+ *  Copyright (C)  2000   Daniel A. Atkinson    All rights reserved.
+ *  This code may be redistributed under the terms of the GNU library
+ *  public license (LGPL). ( See the lgpl.license file for details.)
+ * ------------------------------------------------------------------------
+ */
+#include <stdio.h>
+void matprt(double *a, int n, int m, char *fmt)
+{
+    int i, j;
+
+    double *p;
+
+    for (i = 0, p = a; i < n; ++i) {
+	for (j = 0; j < m; ++j)
+	    printf(fmt, *p++);
+	printf("\n");
+    }
+}
+
+void fmatprt(FILE * fp, double *a, int n, int m, char *fmt)
+{
+    int i, j;
+
+    double *p;
+
+    for (i = 0, p = a; i < n; ++i) {
+	for (j = 0; j < m; ++j)
+	    fprintf(fp, fmt, *p++);
+	fprintf(fp, "\n");
+    }
+}

lib/external/ccmath/mattr.c

@@ -0,0 +1,17 @@
+/*  mattr.c    CCMATH mathematics library source code.
+ *
+ *  Copyright (C)  2000   Daniel A. Atkinson    All rights reserved.
+ *  This code may be redistributed under the terms of the GNU library
+ *  public license (LGPL). ( See the lgpl.license file for details.)
+ * ------------------------------------------------------------------------
+ */
+void mattr(double *a, double *b, int m, int n)
+{
+    double *p;
+
+    int i, j;
+
+    for (i = 0; i < n; ++i, ++b)
+	for (j = 0, p = b; j < m; ++j, p += n)
+	    *a++ = *p;
+}

lib/external/ccmath/mcopy.c

@@ -0,0 +1,16 @@
+/*  mcopy.c    CCMATH mathematics library source code.
+ *
+ *  Copyright (C)  2000   Daniel A. Atkinson    All rights reserved.
+ *  This code may be redistributed under the terms of the GNU library
+ *  public license (LGPL). ( See the lgpl.license file for details.)
+ * ------------------------------------------------------------------------
+ */
+void mcopy(double *a, double *b, int m)
+{
+    double *p, *q;
+
+    int k;
+
+    for (p = a, q = b, k = 0; k < m; ++k)
+	*p++ = *q++;
+}

lib/external/ccmath/minv.c

@@ -0,0 +1,123 @@
+/*  minv.c    CCMATH mathematics library source code.
+ *
+ *  Copyright (C)  2000   Daniel A. Atkinson    All rights reserved.
+ *  This code may be redistributed under the terms of the GNU library
+ *  public license (LGPL). ( See the lgpl.license file for details.)
+ * ------------------------------------------------------------------------
+ */
+#include <stdlib.h>
+#include "ccmath.h"
+int minv(double *a, int n)
+{
+    int lc, *le;
+
+    double s, t, tq = 0., zr = 1.e-15;
+
+    double *pa, *pd, *ps, *p, *q, *q0;
+
+    int i, j, k, m;
+
+    le = (int *)malloc(n * sizeof(int));
+    q0 = (double *)malloc(n * sizeof(double));
+    for (j = 0, pa = pd = a; j < n; ++j, ++pa, pd += n + 1) {
+	if (j > 0) {
+	    for (i = 0, q = q0, p = pa; i < n; ++i, p += n)
+		*q++ = *p;
+	    for (i = 1; i < n; ++i) {
+		lc = i < j ? i : j;
+		for (k = 0, p = pa + i * n - j, q = q0, t = 0.; k < lc; ++k)
+		    t += *p++ * *q++;
+		q0[i] -= t;
+	    }
+	    for (i = 0, q = q0, p = pa; i < n; ++i, p += n)
+		*p = *q++;
+	}
+	s = fabs(*pd);
+	lc = j;
+	for (k = j + 1, ps = pd; k < n; ++k) {
+	    if ((t = fabs(*(ps += n))) > s) {
+		s = t;
+		lc = k;
+	    }
+	}
+	tq = tq > s ? tq : s;
+	if (s < zr * tq) {
+	    free(le - j);
+	    free(q0);
+	    return -1;
+	}
+	*le++ = lc;
+	if (lc != j) {
+	    for (k = 0, p = a + n * j, q = a + n * lc; k < n; ++k) {
+		t = *p;
+		*p++ = *q;
+		*q++ = t;
+	    }
+	}
+	for (k = j + 1, ps = pd, t = 1. / *pd; k < n; ++k)
+	    *(ps += n) *= t;
+	*pd = t;
+    }
+    for (j = 1, pd = ps = a; j < n; ++j) {
+	for (k = 0, pd += n + 1, q = ++ps; k < j; ++k, q += n)
+	    *q *= *pd;
+    }
+    for (j = 1, pa = a; j < n; ++j) {
+	++pa;
+	for (i = 0, q = q0, p = pa; i < j; ++i, p += n)
+	    *q++ = *p;
+	for (k = 0; k < j; ++k) {
+	    t = 0.;
+	    for (i = k, p = pa + k * n + k - j, q = q0 + k; i < j; ++i)
+		t -= *p++ * *q++;
+	    q0[k] = t;
+	}
+	for (i = 0, q = q0, p = pa; i < j; ++i, p += n)
+	    *p = *q++;
+    }
+    for (j = n - 2, pd = pa = a + n * n - 1; j >= 0; --j) {
+	--pa;
+	pd -= n + 1;
+	for (i = 0, m = n - j - 1, q = q0, p = pd + n; i < m; ++i, p += n)
+	    *q++ = *p;
+	for (k = n - 1, ps = pa; k > j; --k, ps -= n) {
+	    t = -(*ps);
+	    for (i = j + 1, p = ps, q = q0; i < k; ++i)
+		t -= *++p * *q++;
+	    q0[--m] = t;
+	}
+	for (i = 0, m = n - j - 1, q = q0, p = pd + n; i < m; ++i, p += n)
+	    *p = *q++;
+    }
+    for (k = 0, pa = a; k < n - 1; ++k, ++pa) {
+	for (i = 0, q = q0, p = pa; i < n; ++i, p += n)
+	    *q++ = *p;
+	for (j = 0, ps = a; j < n; ++j, ps += n) {
+	    if (j > k) {
+		t = 0.;
+		p = ps + j;
+		i = j;
+	    }
+	    else {
+		t = q0[j];
+		p = ps + k + 1;
+		i = k + 1;
+	    }
+	    for (; i < n;)
+		t += *p++ * q0[i++];
+	    q0[j] = t;
+	}
+	for (i = 0, q = q0, p = pa; i < n; ++i, p += n)
+	    *p = *q++;
+    }
+    for (j = n - 2, le--; j >= 0; --j) {
+	for (k = 0, p = a + j, q = a + *(--le); k < n; ++k, p += n, q += n) {
+	    t = *p;
+	    *p = *q;
+	    *q = t;
+	}
+    }
+    free(le);
+    free(q0);
+    return 0;
+}

lib/external/ccmath/mmul.c

@@ -0,0 +1,24 @@
+/*  mmul.c    CCMATH mathematics library source code.
+ *
+ *  Copyright (C)  2000   Daniel A. Atkinson    All rights reserved.
+ *  This code may be redistributed under the terms of the GNU library
+ *  public license (LGPL). ( See the lgpl.license file for details.)
+ * ------------------------------------------------------------------------
+ */
+#include "ccmath.h"
+void mmul(double *c, double *a, double *b, int n)
+{
+    double *p, *q, s;
+
+    int i, j, k;
+
+    trnm(b, n);
+    for (i = 0; i < n; ++i, a += n) {
+	for (j = 0, q = b; j < n; ++j) {
+	    for (k = 0, p = a, s = 0.; k < n; ++k)
+		s += *p++ * *q++;
+	    *c++ = s;
+	}
+    }
+    trnm(b, n);
+}

lib/external/ccmath/ortho.c

@@ -0,0 +1,40 @@
+/*  ortho.c    CCMATH mathematics library source code.
+ *
+ *  Copyright (C)  2000   Daniel A. Atkinson    All rights reserved.
+ *  This code may be redistributed under the terms of the GNU library
+ *  public license (LGPL). ( See the lgpl.license file for details.)
+ * ------------------------------------------------------------------------
+ */
+#include "ccmath.h"
+static double tpi = 6.28318530717958647;
+
+void ortho(double *e, int n)
+{
+    int i, j, k, m;
+
+    double *p, *q, c, s, a, unfl();
+
+    for (i = 0, p = e; i < n; ++i) {
+	for (j = 0; j < n; ++j) {
+	    if (i == j)
+		*p++ = 1.;
+	    else
+		*p++ = 0.;
+	}
+    }
+    for (i = 0, m = n - 1; i < m; ++i) {
+	for (j = i + 1; j < n; ++j) {
+	    a = tpi * unfl();
+	    c = cos(a);
+	    s = sin(a);
+	    p = e + n * i;
+	    q = e + n * j;
+	    for (k = 0; k < n; ++k) {
+		a = *p * c + *q * s;
+		*q = *q * c - *p * s;
+		*p++ = a;
+		++q;
+	    }
+	}
+    }
+}

lib/external/ccmath/otrma.c

@@ -0,0 +1,29 @@
+/*  otrma.c    CCMATH mathematics library source code.
+ *
+ *  Copyright (C)  2000   Daniel A. Atkinson    All rights reserved.
+ *  This code may be redistributed under the terms of the GNU library
+ *  public license (LGPL). ( See the lgpl.license file for details.)
+ * ------------------------------------------------------------------------
+ */
+#include <stdlib.h>
+void otrma(double *c, double *a, double *b, int n)
+{
+    double z, *q0, *p, *s, *t;
+
+    int i, j, k;
+
+    q0 = (double *)calloc(n, sizeof(double));
+    for (i = 0; i < n; ++i, ++c) {
+	for (j = 0, t = b; j < n; ++j) {
+	    for (k = 0, s = a + i * n, z = 0.; k < n; ++k)
+		z += *t++ * *s++;
+	    q0[j] = z;
+	}
+	for (j = 0, p = c, t = a; j < n; ++j, p += n) {
+	    for (k = 0, s = q0, z = 0.; k < n; ++k)
+		z += *t++ * *s++;
+	    *p = z;
+	}
+    }
+    free(q0);
+}

lib/external/ccmath/otrsm.c

@@ -0,0 +1,31 @@
+/*  otrsm.c    CCMATH mathematics library source code.
+ *
+ *  Copyright (C)  2000   Daniel A. Atkinson    All rights reserved.
+ *  This code may be redistributed under the terms of the GNU library
+ *  public license (LGPL). ( See the lgpl.license file for details.)
+ * ------------------------------------------------------------------------
+ */
+#include <stdlib.h>
+void otrsm(double *sm, double *a, double *b, int n)
+{
+    double z, *q0, *p, *s, *t;
+
+    int i, j, k;
+
+    q0 = (double *)calloc(n, sizeof(double));
+    for (i = 0; i < n; ++i) {
+	for (j = 0, t = b; j < n; ++j) {
+	    for (k = 0, s = a + i * n, z = 0.; k < n; ++k)
+		z += *t++ * *s++;
+	    q0[j] = z;
+	}
+	for (j = 0, p = sm + i, t = a; j <= i; ++j, p += n) {
+	    for (k = 0, s = q0, z = 0.; k < n; ++k)
+		z += *t++ * *s++;
+	    *p = z;
+	    if (j < i)
+		sm[i * n + j] = z;
+	}
+    }
+    free(q0);
+}

lib/external/ccmath/psinv.c

@@ -0,0 +1,45 @@
+/*  psinv.c    CCMATH mathematics library source code.
+ *
+ *  Copyright (C)  2000   Daniel A. Atkinson    All rights reserved.
+ *  This code may be redistributed under the terms of the GNU library
+ *  public license (LGPL). ( See the lgpl.license file for details.)
+ * ------------------------------------------------------------------------
+ */
+#include "ccmath.h"
+int psinv(double *v, int n)
+{
+    double z, *p, *q, *r, *s, *t;
+
+    int j, k;
+
+    for (j = 0, p = v; j < n; ++j, p += n + 1) {
+	for (q = v + j * n; q < p; ++q)
+	    *p -= *q * *q;
+	if (*p <= 0.)
+	    return -1;
+	*p = sqrt(*p);
+	for (k = j + 1, q = p + n; k < n; ++k, q += n) {
+	    for (r = v + j * n, s = v + k * n, z = 0.; r < p;)
+		z += *r++ * *s++;
+	    *q -= z;
+	    *q /= *p;
+	}
+    }
+    trnm(v, n);
+    for (j = 0, p = v; j < n; ++j, p += n + 1) {
+	*p = 1. / *p;
+	for (q = v + j, t = v; q < p; t += n + 1, q += n) {
+	    for (s = q, r = t, z = 0.; s < p; s += n)
+		z -= *s * *r++;
+	    *q = z * *p;
+	}
+    }
+    for (j = 0, p = v; j < n; ++j, p += n + 1) {
+	for (q = v + j, t = p - j; q <= p; q += n) {
+	    for (k = j, r = p, s = q, z = 0.; k < n; ++k)
+		z += *r++ * *s++;
+	    *t++ = (*q = z);
+	}
+    }
+    return 0;
+}

lib/external/ccmath/qrbdi.c

@@ -0,0 +1,77 @@
+/*  qrbdi.c    CCMATH mathematics library source code.
+ *
+ *  Copyright (C)  2000   Daniel A. Atkinson    All rights reserved.
+ *  This code may be redistributed under the terms of the GNU library
+ *  public license (LGPL). ( See the lgpl.license file for details.)
+ * ------------------------------------------------------------------------
+ */
+#include "ccmath.h"
+int qrbdi(double *dm, double *em, int m)
+{
+    int i, j, k, n;
+
+    double u, x, y, a, b, c, s, t;
+
+    for (j = 1, t = fabs(dm[0]); j < m; ++j)
+	if ((s = fabs(dm[j]) + fabs(em[j - 1])) > t)
+	    t = s;
+    t *= 1.e-15;
+    n = 100 * m;
+    for (j = 0; m > 1 && j < n; ++j) {
+	for (k = m - 1; k > 0; --k) {
+	    if (fabs(em[k - 1]) < t)
+		break;
+	    if (fabs(dm[k - 1]) < t) {
+		for (i = k, s = 1., c = 0.; i < m; ++i) {
+		    a = s * em[i - 1];
+		    b = dm[i];
+		    em[i - 1] *= c;
+		    dm[i] = u = sqrt(a * a + b * b);
+		    s = -a / u;
+		    c = b / u;
+		}
+		break;
+	    }
+	}
+	y = dm[k];
+	x = dm[m - 1];
+	u = em[m - 2];
+	a = (y + x) * (y - x) - u * u;
+	s = y * em[k];
+	b = s + s;
+	u = sqrt(a * a + b * b);
+	if (u > 0.) {
+	    c = sqrt((u + a) / (u + u));
+	    if (c != 0.)
+		s /= (c * u);
+	    else
+		s = 1.;
+	    for (i = k; i < m - 1; ++i) {
+		b = em[i];
+		if (i > k) {
+		    a = s * em[i];
+		    b *= c;
+		    em[i - 1] = u = sqrt(x * x + a * a);
+		    c = x / u;
+		    s = a / u;
+		}
+		a = c * y + s * b;
+		b = c * b - s * y;
+		s *= dm[i + 1];
+		dm[i] = u = sqrt(a * a + s * s);
+		y = c * dm[i + 1];
+		c = a / u;
+		s /= u;
+		x = c * b + s * y;
+		y = c * y - s * b;
+	    }
+	}
+	em[m - 2] = x;
+	dm[m - 1] = y;
+	if (fabs(x) < t)
+	    --m;
+	if (m == k + 1)
+	    --m;
+    }
+    return j;
+}

lib/external/ccmath/qrbdu1.c

@@ -0,0 +1,94 @@
+/*  qrbdu1.c    CCMATH mathematics library source code.
+ *
+ *  Copyright (C)  2000   Daniel A. Atkinson    All rights reserved.
+ *  This code may be redistributed under the terms of the GNU library
+ *  public license (LGPL). ( See the lgpl.license file for details.)
+ * ------------------------------------------------------------------------
+ */
+#include "ccmath.h"
+int qrbdu1(double *dm, double *em, double *um, int mm, double *vm, int m)
+{
+    int i, j, k, n, jj, nm;
+
+    double u, x, y, a, b, c, s, t, w, *p, *q;
+
+    for (j = 1, t = fabs(dm[0]); j < m; ++j)
+	if ((s = fabs(dm[j]) + fabs(em[j - 1])) > t)
+	    t = s;
+    t *= 1.e-15;
+    n = 100 * m;
+    nm = m;
+    for (j = 0; m > 1 && j < n; ++j) {
+	for (k = m - 1; k > 0; --k) {
+	    if (fabs(em[k - 1]) < t)
+		break;
+	    if (fabs(dm[k - 1]) < t) {
+		for (i = k, s = 1., c = 0.; i < m; ++i) {
+		    a = s * em[i - 1];
+		    b = dm[i];
+		    em[i - 1] *= c;
+		    dm[i] = u = sqrt(a * a + b * b);
+		    s = -a / u;
+		    c = b / u;
+		    for (jj = 0, p = um + k - 1; jj < mm; ++jj, p += nm) {
+			q = p + i - k + 1;
+			w = c * *p + s * *q;
+			*q = c * *q - s * *p;
+			*p = w;
+		    }
+		}
+		break;
+	    }
+	}
+	y = dm[k];
+	x = dm[m - 1];
+	u = em[m - 2];
+	a = (y + x) * (y - x) - u * u;
+	s = y * em[k];
+	b = s + s;
+	u = sqrt(a * a + b * b);
+	if (u > 0.) {
+	    c = sqrt((u + a) / (u + u));
+	    if (c != 0.)
+		s /= (c * u);
+	    else
+		s = 1.;
+	    for (i = k; i < m - 1; ++i) {
+		b = em[i];
+		if (i > k) {
+		    a = s * em[i];
+		    b *= c;
+		    em[i - 1] = u = sqrt(x * x + a * a);
+		    c = x / u;
+		    s = a / u;
+		}
+		a = c * y + s * b;
+		b = c * b - s * y;
+		for (jj = 0, p = vm + i; jj < nm; ++jj, p += nm) {
+		    w = c * *p + s * *(p + 1);
+		    *(p + 1) = c * *(p + 1) - s * *p;
+		    *p = w;
+		}
+		s *= dm[i + 1];
+		dm[i] = u = sqrt(a * a + s * s);
+		y = c * dm[i + 1];
+		c = a / u;
+		s /= u;
+		x = c * b + s * y;
+		y = c * y - s * b;
+		for (jj = 0, p = um + i; jj < mm; ++jj, p += nm) {
+		    w = c * *p + s * *(p + 1);
+		    *(p + 1) = c * *(p + 1) - s * *p;
+		    *p = w;
+		}
+	    }
+	}
+	em[m - 2] = x;
+	dm[m - 1] = y;
+	if (fabs(x) < t)
+	    --m;
+	if (m == k + 1)
+	    --m;
+    }
+    return j;
+}

lib/external/ccmath/qrbdv.c

@@ -0,0 +1,94 @@
+/*  qrbdv.c    CCMATH mathematics library source code.
+ *
+ *  Copyright (C)  2000   Daniel A. Atkinson    All rights reserved.
+ *  This code may be redistributed under the terms of the GNU library
+ *  public license (LGPL). ( See the lgpl.license file for details.)
+ * ------------------------------------------------------------------------
+ */
+#include "ccmath.h"
+int qrbdv(double *dm, double *em, double *um, int mm, double *vm, int m)
+{
+    int i, j, k, n, jj, nm;
+
+    double u, x, y, a, b, c, s, t, w, *p, *q;
+
+    for (j = 1, t = fabs(dm[0]); j < m; ++j)
+	if ((s = fabs(dm[j]) + fabs(em[j - 1])) > t)
+	    t = s;
+    t *= 1.e-15;
+    n = 100 * m;
+    nm = m;
+    for (j = 0; m > 1 && j < n; ++j) {
+	for (k = m - 1; k > 0; --k) {
+	    if (fabs(em[k - 1]) < t)
+		break;
+	    if (fabs(dm[k - 1]) < t) {
+		for (i = k, s = 1., c = 0.; i < m; ++i) {
+		    a = s * em[i - 1];
+		    b = dm[i];
+		    em[i - 1] *= c;
+		    dm[i] = u = sqrt(a * a + b * b);
+		    s = -a / u;
+		    c = b / u;
+		    for (jj = 0, p = um + k - 1; jj < mm; ++jj, p += mm) {
+			q = p + i - k + 1;
+			w = c * *p + s * *q;
+			*q = c * *q - s * *p;
+			*p = w;
+		    }
+		}
+		break;
+	    }
+	}
+	y = dm[k];
+	x = dm[m - 1];
+	u = em[m - 2];
+	a = (y + x) * (y - x) - u * u;
+	s = y * em[k];
+	b = s + s;
+	u = sqrt(a * a + b * b);
+	if (u != 0.) {
+	    c = sqrt((u + a) / (u + u));
+	    if (c != 0.)
+		s /= (c * u);
+	    else
+		s = 1.;
+	    for (i = k; i < m - 1; ++i) {
+		b = em[i];
+		if (i > k) {
+		    a = s * em[i];
+		    b *= c;
+		    em[i - 1] = u = sqrt(x * x + a * a);
+		    c = x / u;
+		    s = a / u;
+		}
+		a = c * y + s * b;
+		b = c * b - s * y;
+		for (jj = 0, p = vm + i; jj < nm; ++jj, p += nm) {
+		    w = c * *p + s * *(p + 1);
+		    *(p + 1) = c * *(p + 1) - s * *p;
+		    *p = w;
+		}
+		s *= dm[i + 1];
+		dm[i] = u = sqrt(a * a + s * s);
+		y = c * dm[i + 1];
+		c = a / u;
+		s /= u;
+		x = c * b + s * y;
+		y = c * y - s * b;
+		for (jj = 0, p = um + i; jj < mm; ++jj, p += mm) {
+		    w = c * *p + s * *(p + 1);
+		    *(p + 1) = c * *(p + 1) - s * *p;
+		    *p = w;
+		}
+	    }
+	}
+	em[m - 2] = x;
+	dm[m - 1] = y;
+	if (fabs(x) < t)
+	    --m;
+	if (m == k + 1)
+	    --m;
+    }
+    return j;
+}

lib/external/ccmath/qrecvc.c

@@ -0,0 +1,78 @@
+/*  qrecvc.c    CCMATH mathematics library source code.
+ *
+ *  Copyright (C)  2000   Daniel A. Atkinson    All rights reserved.
+ *  This code may be redistributed under the terms of the GNU library
+ *  public license (LGPL). ( See the lgpl.license file for details.)
+ * ------------------------------------------------------------------------
+ */
+#include "ccmath.h"
+void qrecvc(double *ev, Cpx * evec, double *dp, int n)
+{
+    double cc, sc = 0.0, d, x = 0.0, y, h = 0.0, tzr = 1.e-15;
+
+    int i, j, k, m, nqr = 50 * n;
+
+    Cpx *p;
+
+    for (j = 0, m = n - 1; j < nqr; ++j) {
+	while (1) {
+	    if (m < 1)
+		break;
+	    k = m - 1;
+	    if (fabs(dp[k]) <= fabs(ev[m]) * tzr)
+		--m;
+	    else {
+		x = (ev[k] - ev[m]) / 2.;
+		h = sqrt(x * x + dp[k] * dp[k]);
+		if (m > 1 && fabs(dp[m - 2]) > fabs(ev[k]) * tzr)
+		    break;
+		if ((cc = sqrt((1. + x / h) / 2.)) != 0.)
+		    sc = dp[k] / (2. * cc * h);
+		else
+		    sc = 1.;
+		x += ev[m];
+		ev[m--] = x - h;
+		ev[m--] = x + h;
+		for (i = 0, p = evec + n * (m + 1); i < n; ++i, ++p) {
+		    h = p[0].re;
+		    p[0].re = cc * h + sc * p[n].re;
+		    p[n].re = cc * p[n].re - sc * h;
+		    h = p[0].im;
+		    p[0].im = cc * h + sc * p[n].im;
+		    p[n].im = cc * p[n].im - sc * h;
+		}
+	    }
+	}
+	if (x > 0.)
+	    d = ev[m] + x - h;
+	else
+	    d = ev[m] + x + h;
+	cc = 1.;
+	y = 0.;
+	ev[0] -= d;
+	for (k = 0; k < m; ++k) {
+	    x = ev[k] * cc - y;
+	    y = dp[k] * cc;
+	    h = sqrt(x * x + dp[k] * dp[k]);
+	    if (k > 0)
+		dp[k - 1] = sc * h;
+	    ev[k] = cc * h;
+	    cc = x / h;
+	    sc = dp[k] / h;
+	    ev[k + 1] -= d;
+	    y *= sc;
+	    ev[k] = cc * (ev[k] + y) + ev[k + 1] * sc * sc + d;
+	    for (i = 0, p = evec + n * k; i < n; ++i, ++p) {
+		h = p[0].re;
+		p[0].re = cc * h + sc * p[n].re;
+		p[n].re = cc * p[n].re - sc * h;
+		h = p[0].im;
+		p[0].im = cc * h + sc * p[n].im;
+		p[n].im = cc * p[n].im - sc * h;
+	    }
+	}
+	ev[k] = ev[k] * cc - y;
+	dp[k - 1] = ev[k] * sc;
+	ev[k] = ev[k] * cc + d;
+    }
+}

lib/external/ccmath/qreval.c

@@ -0,0 +1,59 @@
+/*  qreval.c    CCMATH mathematics library source code.
+ *
+ *  Copyright (C)  2000   Daniel A. Atkinson    All rights reserved.
+ *  This code may be redistributed under the terms of the GNU library
+ *  public license (LGPL). ( See the lgpl.license file for details.)
+ * ------------------------------------------------------------------------
+ */
+#include "ccmath.h"
+int qreval(double *ev, double *dp, int n)
+{
+    double cc, sc = 0.0, d, x, y, h, tzr = 1.e-15;
+
+    int j, k, m, mqr = 8 * n;
+
+    for (j = 0, m = n - 1;; ++j) {
+	while (1) {
+	    if (m < 1)
+		return 0;
+	    k = m - 1;
+	    if (fabs(dp[k]) <= fabs(ev[m]) * tzr)
+		--m;
+	    else {
+		x = (ev[k] - ev[m]) / 2.;
+		h = sqrt(x * x + dp[k] * dp[k]);
+		if (m > 1 && fabs(dp[m - 2]) > fabs(ev[k]) * tzr)
+		    break;
+		x += ev[m];
+		ev[m--] = x - h;
+		ev[m--] = x + h;
+	    }
+	}
+	if (j > mqr)
+	    return -1;
+	if (x > 0.)
+	    d = ev[m] + x - h;
+	else
+	    d = ev[m] + x + h;
+	cc = 1.;
+	y = 0.;
+	ev[0] -= d;
+	for (k = 0; k < m; ++k) {
+	    x = ev[k] * cc - y;
+	    y = dp[k] * cc;
+	    h = sqrt(x * x + dp[k] * dp[k]);
+	    if (k > 0)
+		dp[k - 1] = sc * h;
+	    ev[k] = cc * h;
+	    cc = x / h;
+	    sc = dp[k] / h;
+	    ev[k + 1] -= d;
+	    y *= sc;
+	    ev[k] = cc * (ev[k] + y) + ev[k + 1] * sc * sc + d;
+	}
+	ev[k] = ev[k] * cc - y;
+	dp[k - 1] = ev[k] * sc;
+	ev[k] = ev[k] * cc + d;
+    }
+    return 0;
+}

lib/external/ccmath/qrevec.c

@@ -0,0 +1,75 @@
+/*  qrevec.c    CCMATH mathematics library source code.
+ *
+ *  Copyright (C)  2000   Daniel A. Atkinson    All rights reserved.
+ *  This code may be redistributed under the terms of the GNU library
+ *  public license (LGPL). ( See the lgpl.license file for details.)
+ * ------------------------------------------------------------------------
+ */
+#include <math.h>
+int qrevec(double *ev, double *evec, double *dp, int n)
+{
+    double cc, sc = 0.0, d, x, y, h, tzr = 1.e-15;
+
+    int i, j, k, m, mqr = 8 * n;
+
+    double *p;
+
+    for (j = 0, m = n - 1;; ++j) {
+	while (1) {
+	    if (m < 1)
+		return 0;
+	    k = m - 1;
+	    if (fabs(dp[k]) <= fabs(ev[m]) * tzr)
+		--m;
+	    else {
+		x = (ev[k] - ev[m]) / 2.;
+		h = sqrt(x * x + dp[k] * dp[k]);
+		if (m > 1 && fabs(dp[m - 2]) > fabs(ev[k]) * tzr)
+		    break;
+		if ((cc = sqrt((1. + x / h) / 2.)) != 0.)
+		    sc = dp[k] / (2. * cc * h);
+		else
+		    sc = 1.;
+		x += ev[m];
+		ev[m--] = x - h;
+		ev[m--] = x + h;
+		for (i = 0, p = evec + n * (m + 1); i < n; ++i, ++p) {
+		    h = p[0];
+		    p[0] = cc * h + sc * p[n];
+		    p[n] = cc * p[n] - sc * h;
+		}
+	    }
+	}
+	if (j > mqr)
+	    return -1;
+	if (x > 0.)
+	    d = ev[m] + x - h;
+	else
+	    d = ev[m] + x + h;
+	cc = 1.;
+	y = 0.;
+	ev[0] -= d;
+	for (k = 0; k < m; ++k) {
+	    x = ev[k] * cc - y;
+	    y = dp[k] * cc;
+	    h = sqrt(x * x + dp[k] * dp[k]);
+	    if (k > 0)
+		dp[k - 1] = sc * h;
+	    ev[k] = cc * h;
+	    cc = x / h;
+	    sc = dp[k] / h;
+	    ev[k + 1] -= d;
+	    y *= sc;
+	    ev[k] = cc * (ev[k] + y) + ev[k + 1] * sc * sc + d;
+	    for (i = 0, p = evec + n * k; i < n; ++i, ++p) {
+		h = p[0];
+		p[0] = cc * h + sc * p[n];
+		p[n] = cc * p[n] - sc * h;
+	    }
+	}
+	ev[k] = ev[k] * cc - y;
+	dp[k - 1] = ev[k] * sc;
+	ev[k] = ev[k] * cc + d;
+    }
+    return 0;
+}

lib/external/ccmath/rmmult.c

@@ -0,0 +1,26 @@
+/*  rmmult.c    CCMATH mathematics library source code.
+ *
+ *  Copyright (C)  2000   Daniel A. Atkinson    All rights reserved.
+ *  This code may be redistributed under the terms of the GNU library
+ *  public license (LGPL). ( See the lgpl.license file for details.)
+ * ------------------------------------------------------------------------
+ */
+#include <stdlib.h>
+void rmmult(double *rm, double *a, double *b, int n, int m, int l)
+{
+    double z, *q0, *p, *q;
+
+    int i, j, k;
+
+    q0 = (double *)calloc(m, sizeof(double));
+    for (i = 0; i < l; ++i, ++rm) {
+	for (k = 0, p = b + i; k < m; p += l)
+	    q0[k++] = *p;
+	for (j = 0, p = a, q = rm; j < n; ++j, q += l) {
+	    for (k = 0, z = 0.; k < m;)
+		z += *p++ * q0[k++];
+	    *q = z;
+	}
+    }
+    free(q0);
+}

lib/external/ccmath/ruinv.c

@@ -0,0 +1,31 @@
+/*  ruinv.c    CCMATH mathematics library source code.
+ *
+ *  Copyright (C)  2000   Daniel A. Atkinson    All rights reserved.
+ *  This code may be redistributed under the terms of the GNU library
+ *  public license (LGPL). ( See the lgpl.license file for details.)
+ * ------------------------------------------------------------------------
+ */
+int ruinv(double *a, int n)
+{
+    int j;
+
+    double fabs();
+
+    double tt, z, *p, *q, *r, *s, *t;
+
+    for (j = 0, tt = 0., p = a; j < n; ++j, p += n + 1)
+	if ((z = fabs(*p)) > tt)
+	    tt = z;
+    tt *= 1.e-16;
+    for (j = 0, p = a; j < n; ++j, p += n + 1) {
+	if (fabs(*p) < tt)
+	    return -1;
+	*p = 1. / *p;
+	for (q = a + j, t = a; q < p; t += n + 1, q += n) {
+	    for (s = q, r = t, z = 0.; s < p; s += n)
+		z -= *s * *r++;
+	    *q = z * *p;
+	}
+    }
+    return 0;
+}

lib/external/ccmath/smgen.c

@@ -0,0 +1,19 @@
+/*  smgen.c    CCMATH mathematics library source code.
+ *
+ *  Copyright (C)  2000   Daniel A. Atkinson    All rights reserved.
+ *  This code may be redistributed under the terms of the GNU library
+ *  public license (LGPL). ( See the lgpl.license file for details.)
+ * ------------------------------------------------------------------------
+ */
+void smgen(double *a, double *eval, double *evec, int n)
+{
+    double *p, *q, *ps, *r, *s, *t, *v = evec + n * n;
+
+    for (ps = a, p = evec; p < v; p += n) {
+	for (q = evec; q < v; q += n, ++ps) {
+	    *ps = 0.;
+	    for (r = eval, s = p, t = q; r < eval + n;)
+		*ps += *r++ * *s++ * *t++;
+	}
+    }
+}

lib/external/ccmath/solv.c

@@ -0,0 +1,71 @@
+/*  solv.c    CCMATH mathematics library source code.
+ *
+ *  Copyright (C)  2000   Daniel A. Atkinson    All rights reserved.
+ *  This code may be redistributed under the terms of the GNU general
+ *  public license. ( See the gpl.license file for details.)
+ * ------------------------------------------------------------------------
+ */
+#include <stdlib.h>
+#include "ccmath.h"
+int solv(double *a, double *b, int n)
+{
+    int i, j, k, lc;
+
+    double *ps, *p, *q, *pa, *pd;
+
+    double *q0, s, t, tq = 0., zr = 1.e-15;
+
+    q0 = (double *)calloc(n, sizeof(double));
+    for (j = 0, pa = a, pd = a; j < n; ++j, ++pa, pd += n + 1) {
+	if (j) {
+	    for (i = 0, q = q0, p = pa; i < n; ++i, p += n)
+		*q++ = *p;
+	    for (i = 1; i < n; ++i) {
+		lc = i < j ? i : j;
+		for (k = 0, p = pa + i * n - j, q = q0, t = 0.; k < lc; ++k)
+		    t += *p++ * *q++;
+		q0[i] -= t;
+	    }
+	    for (i = 0, q = q0, p = pa; i < n; ++i, p += n)
+		*p = *q++;
+	}
+	s = fabs(*pd);
+	lc = j;
+	for (k = j + 1, ps = pd; k < n; ++k) {
+	    if ((t = fabs(*(ps += n))) > s) {
+		s = t;
+		lc = k;
+	    }
+	}
+	tq = tq > s ? tq : s;
+	if (s < zr * tq) {
+	    free(q0);
+	    return -1;
+	}
+	if (lc != j) {
+	    t = b[j];
+	    b[j] = b[lc];
+	    b[lc] = t;
+	    for (k = 0, p = a + n * j, q = a + n * lc; k < n; ++k) {
+		t = *p;
+		*p++ = *q;
+		*q++ = t;
+	    }
+	}
+	for (k = j + 1, ps = pd, t = 1. / *pd; k < n; ++k)
+	    *(ps += n) *= t;
+    }
+    for (j = 1, ps = b + 1; j < n; ++j) {
+	for (k = 0, p = a + n * j, q = b, t = 0.; k < j; ++k)
+	    t += *p++ * *q++;
+	*ps++ -= t;
+    }
+    for (j = n - 1, --ps, pd = a + n * n - 1; j >= 0; --j, pd -= n + 1) {
+	for (k = j + 1, p = pd, q = b + j, t = 0.; k < n; ++k)
+	    t += *++p * *++q;
+	*ps -= t;
+	*ps-- /= *pd;
+    }
+    free(q0);
+    return 0;
+}

lib/external/ccmath/solv.s

@@ -0,0 +1,387 @@
+	.file	"solv2.c"
+	.version	"01.01"
+gcc2_compiled.:
+.section	.rodata
+	.align 4
+.LC0:
+	.long 0x9ee75616,0x3cd203af
+.text
+	.align 4
+.globl solv
+	.type	 solv,@function
+solv:
+	pushl %ebp
+	movl %esp,%ebp
+	subl $72,%esp
+	pushl %edi
+	pushl %esi
+	pushl %ebx
+	fldz
+	pushl $8
+	movl 16(%ebp),%edx
+	pushl %edx
+	fstpt -60(%ebp)
+	call calloc
+	movl %eax,-20(%ebp)
+	movl $0,-4(%ebp)
+	movl 8(%ebp),%ecx
+	movl %ecx,-12(%ebp)
+	movl %ecx,-16(%ebp)
+	addl $8,%esp
+	fldt -60(%ebp)
+	movl 16(%ebp),%edi
+	cmpl %edi,-4(%ebp)
+	jge .L72
+	leal 0(,%edi,8),%edx
+	movl %edx,-24(%ebp)
+	addl $8,%edx
+	movl %edx,-32(%ebp)
+	movl $0,-40(%ebp)
+	movl 12(%ebp),%ecx
+	movl %ecx,-44(%ebp)
+	movl $0,-48(%ebp)
+	.align 4
+.L7:
+	cmpl $0,-4(%ebp)
+	je .L8
+	movl $0,-64(%ebp)
+	movl -20(%ebp),%edi
+	movl %edi,-72(%ebp)
+	movl -12(%ebp),%ebx
+	movl 16(%ebp),%edx
+	cmpl %edx,-64(%ebp)
+	jge .L10
+	.align 4
+.L12:
+	movl -72(%ebp),%ecx
+	movl (%ebx),%eax
+	movl %eax,(%ecx)
+	movl 4(%ebx),%eax
+	movl %eax,4(%ecx)
+	addl $8,%ecx
+	movl %ecx,-72(%ebp)
+	incl -64(%ebp)
+	addl -24(%ebp),%ebx
+	movl 16(%ebp),%edi
+	cmpl %edi,-64(%ebp)
+	jl .L12
+.L10:
+	movl $1,-64(%ebp)
+	movl 16(%ebp),%edx
+	cmpl %edx,-64(%ebp)
+	jge .L15
+	movl -48(%ebp),%ecx
+	movl %ecx,-28(%ebp)
+	movl -20(%ebp),%edi
+	addl $8,%edi
+	movl %edi,-68(%ebp)
+	movl %edx,-36(%ebp)
+	.align 4
+.L17:
+	movl -64(%ebp),%edx
+	movl %edx,-8(%ebp)
+	movl -4(%ebp),%ecx
+	cmpl %ecx,%edx
+	jle .L18
+	movl %ecx,-8(%ebp)
+.L18:
+	xorl %esi,%esi
+	movl -36(%ebp),%edi
+	movl -12(%ebp),%edx
+	leal (%edx,%edi,8),%eax
+	movl %eax,%ebx
+	subl -28(%ebp),%ebx
+	movl -20(%ebp),%ecx
+        movl %ecx,%edi
+	movl %ecx,-72(%ebp)
+	movl -8(%ebp),%ecx
+	fldz
+	cmpl %esi,%ecx
+	jle .L20
+	.align 4
+.L22:
+	fldl (%ebx)
+	fmull (%edi)
+	faddp %st,%st(1)
+	addl $8,%edi
+	addl $8,%ebx
+	incl %esi
+	cmpl %esi,%ecx
+	jg .L22
+.L20:
+	movl -72(%ebp),%ecx
+	movl -68(%ebp),%edx
+	fldl (%edx)
+	fsubp %st,%st(1)
+	fstpl (%edx)
+	addl $8,%edx
+	movl %edx,-68(%ebp)
+	movl 16(%ebp),%ecx
+	addl %ecx,-36(%ebp)
+	incl -64(%ebp)
+	cmpl %ecx,-64(%ebp)
+	jl .L17
+.L15:
+	movl $0,-64(%ebp)
+	movl -20(%ebp),%edi
+	movl %edi,-72(%ebp)
+	movl -12(%ebp),%ebx
+	movl 16(%ebp),%edx
+	cmpl %edx,-64(%ebp)
+	jge .L8
+	.align 4
+.L28:
+	movl -72(%ebp),%ecx
+	movl (%ecx),%eax
+	movl %eax,(%ebx)
+	movl 4(%ecx),%eax
+	movl %eax,4(%ebx)
+	addl $8,%ecx
+	movl %ecx,-72(%ebp)
+	incl -64(%ebp)
+	addl -24(%ebp),%ebx
+	movl 16(%ebp),%edi
+	cmpl %edi,-64(%ebp)
+	jl .L28
+.L8:
+	movl -16(%ebp),%edx
+	fldl (%edx)
+	fabs
+	movl -4(%ebp),%ecx
+	movl %ecx,-8(%ebp)
+	movl %ecx,%esi
+	incl %esi
+	movl %edx,-68(%ebp)
+	cmpl %esi,16(%ebp)
+	jle .L31
+	.align 4
+.L33:
+	movl -24(%ebp),%edi
+	addl %edi,-68(%ebp)
+	movl -68(%ebp),%edx
+	fldl (%edx)
+	fabs
+	fcom %st(1)
+	fnstsw %ax
+	andb $69,%ah
+	jne .L73
+	fstp %st(1)
+	movl %esi,-8(%ebp)
+	jmp .L32
+	.align 4
+.L73:
+	fstp %st(0)
+.L32:
+	incl %esi
+	cmpl %esi,16(%ebp)
+	jg .L33
+.L31:
+	fld %st(0)
+	fxch %st(2)
+	fcom %st(1)
+	fnstsw %ax
+	andb $69,%ah
+	jne .L74
+	fstp %st(2)
+	jmp .L36
+	.align 4
+.L74:
+	fstp %st(0)
+.L36:
+	fldl .LC0
+	fmul %st(2),%st
+	fcompp
+	fnstsw %ax
+	andb $69,%ah
+	jne .L38
+	fstp %st(0)
+	movl -20(%ebp),%ecx
+	pushl %ecx
+	call free
+	movl $-1,%eax
+	jmp .L71
+	.align 4
+.L38:
+	movl -4(%ebp),%edi
+	cmpl %edi,-8(%ebp)
+	je .L39
+	movl -44(%ebp),%edx
+	fldl (%edx)
+	movl -8(%ebp),%ecx
+	movl 12(%ebp),%edi
+	movl (%edi,%ecx,8),%eax
+	movl %eax,(%edx)
+	movl 4(%edi,%ecx,8),%eax
+	movl %eax,4(%edx)
+	fstpl (%edi,%ecx,8)
+	xorl %esi,%esi
+	movl -40(%ebp),%edx
+	movl 8(%ebp),%ecx
+	leal (%ecx,%edx,8),%ebx
+	movl 16(%ebp),%eax
+	imull -8(%ebp),%eax
+	leal (%ecx,%eax,8),%eax
+	movl %eax,-72(%ebp)
+	cmpl %esi,16(%ebp)
+	jle .L39
+	.align 4
+.L43:
+	fldl (%ebx)
+	movl -72(%ebp),%edi
+	movl (%edi),%eax
+	movl %eax,(%ebx)
+	movl 4(%edi),%eax
+	movl %eax,4(%ebx)
+	addl $8,%ebx
+	fstpl (%edi)
+	addl $8,%edi
+	movl %edi,-72(%ebp)
+	incl %esi
+	cmpl %esi,16(%ebp)
+	jg .L43
+.L39:
+	movl -4(%ebp),%esi
+	incl %esi
+	movl -16(%ebp),%edx
+	movl %edx,-68(%ebp)
+	fld1
+	fdivl (%edx)
+	cmpl %esi,16(%ebp)
+	jle .L75
+	.align 4
+.L48:
+	movl -24(%ebp),%ecx
+	addl %ecx,-68(%ebp)
+	movl -68(%ebp),%edi
+	fldl (%edi)
+	fmul %st(1),%st
+	fstpl (%edi)
+	incl %esi
+	cmpl %esi,16(%ebp)
+	jg .L48
+.L75:
+	fstp %st(0)
+	movl 16(%ebp),%edx
+	addl %edx,-40(%ebp)
+	addl $8,-44(%ebp)
+	addl $8,-48(%ebp)
+	incl -4(%ebp)
+	addl $8,-12(%ebp)
+	movl -32(%ebp),%ecx
+	addl %ecx,-16(%ebp)
+	cmpl %edx,-4(%ebp)
+	jl .L7
+.L72:
+	fstp %st(0)
+	movl $1,-4(%ebp)
+	movl 12(%ebp),%edi
+	addl $8,%edi
+	movl %edi,-68(%ebp)
+	movl 16(%ebp),%edx
+	cmpl %edx,-4(%ebp)
+	jge .L52
+	movl 16(%ebp),%eax
+	.align 4
+.L54:
+	xorl %esi,%esi
+	movl 8(%ebp),%ecx
+	leal (%ecx,%eax,8),%ebx
+	movl 12(%ebp),%edi
+	movl %edi,-72(%ebp)
+	fldz
+	cmpl %esi,-4(%ebp)
+	jle .L56
+	.align 4
+.L58:
+	fldl (%ebx)
+	movl -72(%ebp),%edx
+	fmull (%edx)
+	faddp %st,%st(1)
+	addl $8,%edx
+	movl %edx,-72(%ebp)
+	addl $8,%ebx
+	incl %esi
+	cmpl %esi,-4(%ebp)
+	jg .L58
+.L56:
+	movl -68(%ebp),%ecx
+	fldl (%ecx)
+	fsubp %st,%st(1)
+	fstpl (%ecx)
+	addl $8,%ecx
+	movl %ecx,-68(%ebp)
+	addl 16(%ebp),%eax
+	incl -4(%ebp)
+	movl 16(%ebp),%edi
+	cmpl %edi,-4(%ebp)
+	jl .L54
+.L52:
+	movl 16(%ebp),%edx
+	decl %edx
+	movl %edx,-4(%ebp)
+	addl $-8,-68(%ebp)
+	movl 16(%ebp),%eax
+	imull %eax,%eax
+	movl 8(%ebp),%ecx
+	leal -8(%ecx,%eax,8),%eax
+	movl %eax,-16(%ebp)
+	testl %edx,%edx
+	jl .L62
+	movl 16(%ebp),%edi
+	leal 8(,%edi,8),%edi
+	movl %edi,-64(%ebp)
+	leal 0(,%edx,8),%eax
+	.align 4
+.L64:
+	movl -4(%ebp),%esi
+	incl %esi
+	movl -16(%ebp),%ebx
+	movl 12(%ebp),%edx
+	addl %eax,%edx
+	movl %edx,-72(%ebp)
+	fldz
+	cmpl %esi,16(%ebp)
+	jle .L66
+	.align 4
+.L68:
+	addl $8,%ebx
+	addl $8,-72(%ebp)
+	fldl (%ebx)
+	movl -72(%ebp),%ecx
+	fmull (%ecx)
+	faddp %st,%st(1)
+	incl %esi
+	cmpl %esi,16(%ebp)
+	jg .L68
+.L66:
+	movl -68(%ebp),%edi
+	fldl (%edi)
+	fsubp %st,%st(1)
+	fstl (%edi)
+	movl -16(%ebp),%edx
+	fdivl (%edx)
+	fstpl (%edi)
+	addl $-8,%edi
+	movl %edi,-68(%ebp)
+	addl $-8,%eax
+	movl -64(%ebp),%ecx
+	subl %ecx,%edx
+	movl %edx,-16(%ebp)
+	decl -4(%ebp)
+	jns .L64
+.L62:
+	movl -20(%ebp),%edi
+	pushl %edi
+	call free
+	xorl %eax,%eax
+.L71:
+	leal -84(%ebp),%esp
+	popl %ebx
+	popl %esi
+	popl %edi
+	movl %ebp,%esp
+	popl %ebp
+	ret
+.Lfe1:
+	.size	 solv,.Lfe1-solv
+	.ident	"GCC: (GNU) 2.7.2"

lib/external/ccmath/solvps.c

@@ -0,0 +1,39 @@
+/*  solvps.c    CCMATH mathematics library source code.
+ *
+ *  Copyright (C)  2000   Daniel A. Atkinson    All rights reserved.
+ *  This code may be redistributed under the terms of the GNU library
+ *  public license (LGPL). ( See the lgpl.license file for details.)
+ * ------------------------------------------------------------------------
+ */
+#include "ccmath.h"
+int solvps(double *a, double *b, int n)
+{
+    double *p, *q, *r, *s, t;
+
+    int j, k;
+
+    for (j = 0, p = a; j < n; ++j, p += n + 1) {
+	for (q = a + j * n; q < p; ++q)
+	    *p -= *q * *q;
+	if (*p <= 0.)
+	    return -1;
+	*p = sqrt(*p);
+	for (k = j + 1, q = p + n; k < n; ++k, q += n) {
+	    for (r = a + j * n, s = a + k * n, t = 0.; r < p;)
+		t += *r++ * *s++;
+	    *q -= t;
+	    *q /= *p;
+	}
+    }
+    for (j = 0, p = a; j < n; ++j, p += n + 1) {
+	for (k = 0, q = a + j * n; k < j;)
+	    b[j] -= b[k++] * *q++;
+	b[j] /= *p;
+    }
+    for (j = n - 1, p = a + n * n - 1; j >= 0; --j, p -= n + 1) {
+	for (k = j + 1, q = p + n; k < n; q += n)
+	    b[j] -= b[k++] * *q;
+	b[j] /= *p;
+    }
+    return 0;
+}

lib/external/ccmath/solvru.c

@@ -0,0 +1,28 @@
+/*  solvru.c    CCMATH mathematics library source code.
+ *
+ *  Copyright (C)  2000   Daniel A. Atkinson    All rights reserved.
+ *  This code may be redistributed under the terms of the GNU library
+ *  public license (LGPL). ( See the lgpl.license file for details.)
+ * ------------------------------------------------------------------------
+ */
+int solvru(double *a, double *b, int n)
+{
+    int j, k;
+
+    double fabs();
+
+    double s, t, *p, *q;
+
+    for (j = 0, s = 0., p = a; j < n; ++j, p += n + 1)
+	if ((t = fabs(*p)) > s)
+	    s = t;
+    s *= 1.e-16;
+    for (j = n - 1, p = a + n * n - 1; j >= 0; --j, p -= n + 1) {
+	for (k = j + 1, q = p + 1; k < n;)
+	    b[j] -= b[k++] * *q++;
+	if (fabs(*p) < s)
+	    return -1;
+	b[j] /= *p;
+    }
+    return 0;
+}

lib/external/ccmath/solvtd.c

@@ -0,0 +1,23 @@
+/*  solvtd.c    CCMATH mathematics library source code.
+ *
+ *  Copyright (C)  2000   Daniel A. Atkinson    All rights reserved.
+ *  This code may be redistributed under the terms of the GNU library
+ *  public license (LGPL). ( See the lgpl.license file for details.)
+ * ------------------------------------------------------------------------
+ */
+void solvtd(double *a, double *b, double *c, double *x, int m)
+{
+    double s;
+
+    int j;
+
+    for (j = 0; j < m; ++j) {
+	s = b[j] / a[j];
+	a[j + 1] -= s * c[j];
+	x[j + 1] -= s * x[j];
+    }
+    for (j = m, s = 0.; j >= 0; --j) {
+	x[j] -= s * c[j];
+	s = (x[j] /= a[j]);
+    }
+}

lib/external/ccmath/sv2u1v.c

@@ -0,0 +1,136 @@
+/*  sv2u1v.c    CCMATH mathematics library source code.
+ *
+ *  Copyright (C)  2000   Daniel A. Atkinson    All rights reserved.
+ *  This code may be redistributed under the terms of the GNU library
+ *  public license (LGPL). ( See the lgpl.license file for details.)
+ * ------------------------------------------------------------------------
+ */
+#include <stdlib.h>
+#include "ccmath.h"
+int sv2u1v(double *d, double *a, int m, double *v, int n)
+{
+    double *p, *p1, *q, *pp, *w, *e;
+
+    double s, t, h, r, sv;
+
+    int i, j, k, mm, nm, ms;
+
+    if (m < n)
+	return -1;
+    w = (double *)calloc(m + n, sizeof(double));
+    e = w + m;
+    for (i = 0, mm = m, p = a; i < n; ++i, --mm, p += n + 1) {
+	if (mm > 1) {
+	    sv = h = 0.;
+	    for (j = 0, q = p, s = 0.; j < mm; ++j, q += n) {
+		w[j] = *q;
+		s += *q * *q;
+	    }
+	    if (s > 0.) {
+		h = sqrt(s);
+		if (*p < 0.)
+		    h = -h;
+		s += *p * h;
+		s = 1. / s;
+		t = 1. / (w[0] += h);
+		sv = 1. + fabs(*p / h);
+		for (k = 1, ms = n - i; k < ms; ++k) {
+		    for (j = 0, q = p + k, r = 0.; j < mm; q += n)
+			r += w[j++] * *q;
+		    r = r * s;
+		    for (j = 0, q = p + k; j < mm; q += n)
+			*q -= r * w[j++];
+		}
+		for (j = 1, q = p; j < mm;)
+		    *(q += n) = w[j++] * t;
+	    }
+	    *p = sv;
+	    d[i] = -h;
+	}
+	if (mm == 1)
+	    d[i] = *p;
+    }
+    for (i = 0, q = v, p = a; i < n; ++i) {
+	for (j = 0; j < n; ++j, ++q, ++p) {
+	    if (j < i)
+		*q = 0.;
+	    else if (j == i)
+		*q = d[i];
+	    else
+		*q = *p;
+	}
+    }
+    atou1(a, m, n);
+    for (i = 0, mm = n, nm = n - 1, p = v; i < n; ++i, --mm, --nm, p += n + 1) {
+	if (i && mm > 1) {
+	    sv = h = 0.;
+	    for (j = 0, q = p, s = 0.; j < mm; ++j, q += n) {
+		w[j] = *q;
+		s += *q * *q;
+	    }
+	    if (s > 0.) {
+		h = sqrt(s);
+		if (*p < 0.)
+		    h = -h;
+		s += *p * h;
+		s = 1. / s;
+		t = 1. / (w[0] += h);
+		sv = 1. + fabs(*p / h);
+		for (k = 1, ms = n - i; k < ms; ++k) {
+		    for (j = 0, q = p + k, r = 0.; j < mm; q += n)
+			r += w[j++] * *q;
+		    for (j = 0, q = p + k, r *= s; j < mm; q += n)
+			*q -= r * w[j++];
+		}
+		for (k = 0, p1 = a + i; k < m; ++k, p1 += n) {
+		    for (j = 0, q = p1, r = 0.; j < mm;)
+			r += w[j++] * *q++;
+		    for (j = 0, q = p1, r *= s; j < mm;)
+			*q++ -= r * w[j++];
+		}
+	    }
+	    *p = sv;
+	    d[i] = -h;
+	}
+	if (mm == 1)
+	    d[i] = *p;
+	p1 = p + 1;
+	if (nm > 1) {
+	    sv = h = 0.;
+	    for (j = 0, q = p1, s = 0.; j < nm; ++j, ++q)
+		s += *q * *q;
+	    if (s > 0.) {
+		h = sqrt(s);
+		if (*p1 < 0.)
+		    h = -h;
+		sv = 1. + fabs(*p1 / h);
+		s += *p1 * h;
+		s = 1. / s;
+		t = 1. / (*p1 += h);
+		for (k = n, ms = n * (n - i); k < ms; k += n) {
+		    for (j = 0, q = p1, pp = p1 + k, r = 0.; j < nm; ++j)
+			r += *q++ * *pp++;
+		    for (j = 0, q = p1, pp = p1 + k, r *= s; j < nm; ++j)
+			*pp++ -= r * *q++;
+		}
+		for (j = 1, q = p1 + 1; j < nm; ++j)
+		    *q++ *= t;
+	    }
+	    *p1 = sv;
+	    e[i] = -h;
+	}
+	if (nm == 1)
+	    e[i] = *p1;
+    }
+    atovm(v, n);
+    qrbdu1(d, e, a, m, v, n);
+    for (i = 0; i < n; ++i) {
+	if (d[i] < 0.) {
+	    d[i] = -d[i];
+	    for (j = 0, p = v + i; j < n; ++j, p += n)
+		*p = -*p;
+	}
+    }
+    free(w);
+    return 0;
+}

lib/external/ccmath/sv2uv.c

@@ -0,0 +1,134 @@
+/*  sv2uv.c    CCMATH mathematics library source code.
+ *
+ *  Copyright (C)  2000   Daniel A. Atkinson    All rights reserved.
+ *  This code may be redistributed under the terms of the GNU library
+ *  public license (LGPL). ( See the lgpl.license file for details.)
+ * ------------------------------------------------------------------------
+ */
+#include <stdlib.h>
+#include "ccmath.h"
+int sv2uv(double *d, double *a, double *u, int m, double *v, int n)
+{
+    double *p, *p1, *q, *pp, *w, *e;
+
+    double s, t, h, r, sv;
+
+    int i, j, k, mm, nm, ms;
+
+    if (m < n)
+	return -1;
+    w = (double *)calloc(m + n, sizeof(double));
+    e = w + m;
+    for (i = 0, mm = m, p = a; i < n; ++i, --mm, p += n + 1) {
+	if (mm > 1) {
+	    sv = h = 0.;
+	    for (j = 0, q = p, s = 0.; j < mm; ++j, q += n) {
+		w[j] = *q;
+		s += *q * *q;
+	    }
+	    if (s > 0.) {
+		h = sqrt(s);
+		if (*p < 0.)
+		    h = -h;
+		s += *p * h;
+		s = 1. / s;
+		t = 1. / (w[0] += h);
+		sv = 1. + fabs(*p / h);
+		for (k = 1, ms = n - i; k < ms; ++k) {
+		    for (j = 0, q = p + k, r = 0.; j < mm; q += n)
+			r += w[j++] * *q;
+		    r = r * s;
+		    for (j = 0, q = p + k; j < mm; q += n)
+			*q -= r * w[j++];
+		}
+		for (j = 1, q = p; j < mm;)
+		    *(q += n) = w[j++] * t;
+	    }
+	    *p = sv;
+	    d[i] = -h;
+	}
+	if (mm == 1)
+	    d[i] = *p;
+    }
+    ldumat(a, u, m, n);
+    for (i = 0, q = a; i < n; ++i) {
+	for (j = 0; j < n; ++j, ++q) {
+	    if (j < i)
+		*q = 0.;
+	    else if (j == i)
+		*q = d[i];
+	}
+    }
+    for (i = 0, mm = n, nm = n - 1, p = a; i < n; ++i, --mm, --nm, p += n + 1) {
+	if (i && mm > 1) {
+	    sv = h = 0.;
+	    for (j = 0, q = p, s = 0.; j < mm; ++j, q += n) {
+		w[j] = *q;
+		s += *q * *q;
+	    }
+	    if (s > 0.) {
+		h = sqrt(s);
+		if (*p < 0.)
+		    h = -h;
+		s += *p * h;
+		s = 1. / s;
+		t = 1. / (w[0] += h);
+		sv = 1. + fabs(*p / h);
+		for (k = 1, ms = n - i; k < ms; ++k) {
+		    for (j = 0, q = p + k, r = 0.; j < mm; q += n)
+			r += w[j++] * *q;
+		    for (j = 0, q = p + k, r *= s; j < mm; q += n)
+			*q -= r * w[j++];
+		}
+		for (k = 0, p1 = u + i; k < m; ++k, p1 += m) {
+		    for (j = 0, q = p1, r = 0.; j < mm;)
+			r += w[j++] * *q++;
+		    for (j = 0, q = p1, r *= s; j < mm;)
+			*q++ -= r * w[j++];
+		}
+	    }
+	    *p = sv;
+	    d[i] = -h;
+	}
+	if (mm == 1)
+	    d[i] = *p;
+	p1 = p + 1;
+	if (nm > 1) {
+	    sv = h = 0.;
+	    for (j = 0, q = p1, s = 0.; j < nm; ++j, ++q)
+		s += *q * *q;
+	    if (s > 0.) {
+		h = sqrt(s);
+		if (*p1 < 0.)
+		    h = -h;
+		sv = 1. + fabs(*p1 / h);
+		s += *p1 * h;
+		s = 1. / s;
+		t = 1. / (*p1 += h);
+		for (k = n, ms = n * (n - i); k < ms; k += n) {
+		    for (j = 0, q = p1, pp = p1 + k, r = 0.; j < nm; ++j)
+			r += *q++ * *pp++;
+		    for (j = 0, q = p1, pp = p1 + k, r *= s; j < nm; ++j)
+			*pp++ -= r * *q++;
+		}
+		for (j = 1, q = p1 + 1; j < nm; ++j)
+		    *q++ *= t;
+	    }
+	    *p1 = sv;
+	    e[i] = -h;
+	}
+	if (nm == 1)
+	    e[i] = *p1;
+    }
+    ldvmat(a, v, n);
+    qrbdv(d, e, u, m, v, n);
+    for (i = 0; i < n; ++i) {
+	if (d[i] < 0.) {
+	    d[i] = -d[i];
+	    for (j = 0, p = v + i; j < n; ++j, p += n)
+		*p = -*p;
+	}
+    }
+    free(w);
+    return 0;
+}

lib/external/ccmath/sv2val.c

@@ -0,0 +1,105 @@
+/*  sv2val.c    CCMATH mathematics library source code.
+ *
+ *  Copyright (C)  2000   Daniel A. Atkinson    All rights reserved.
+ *  This code may be redistributed under the terms of the GNU library
+ *  public license (LGPL). ( See the lgpl.license file for details.)
+ * ------------------------------------------------------------------------
+ */
+#include <stdlib.h>
+#include "ccmath.h"
+int sv2val(double *d, double *a, int m, int n)
+{
+    double *p, *p1, *q, *w, *v;
+
+    double s, h, u;
+
+    int i, j, k, mm, nm, ms;
+
+    if (m < n)
+	return -1;
+    w = (double *)calloc(m, sizeof(double));
+    for (i = 0, mm = m, p = a; i < n && mm > 1; ++i, --mm, p += n + 1) {
+	for (j = 0, q = p, s = 0.; j < mm; ++j, q += n) {
+	    w[j] = *q;
+	    s += *q * *q;
+	}
+	if (s > 0.) {
+	    h = sqrt(s);
+	    if (*p < 0.)
+		h = -h;
+	    s += *p * h;
+	    s = 1. / s;
+	    w[0] += h;
+	    for (k = 1, ms = n - i; k < ms; ++k) {
+		for (j = 0, q = p + k, u = 0.; j < mm; q += n)
+		    u += w[j++] * *q;
+		u = u * s;
+		for (j = 0, q = p + k; j < mm; q += n)
+		    *q -= u * w[j++];
+	    }
+	    *p = -h;
+	}
+    }
+    for (i = 0, p = a; i < n; ++i, p += n) {
+	for (j = 0, q = p; j < i; ++j)
+	    *q++ = 0.;
+    }
+    for (i = 0, mm = n, nm = n - 1, p = a; i < n; ++i, --mm, --nm, p += n + 1) {
+	if (i && mm > 1) {
+	    for (j = 0, q = p, s = 0.; j < mm; ++j, q += n) {
+		w[j] = *q;
+		s += *q * *q;
+	    }
+	    if (s > 0.) {
+		h = sqrt(s);
+		if (*p < 0.)
+		    h = -h;
+		s += *p * h;
+		s = 1. / s;
+		w[0] += h;
+		for (k = 1, ms = n - i; k < ms; ++k) {
+		    for (j = 0, q = p + k, u = 0.; j < mm; q += n)
+			u += w[j++] * *q;
+		    u *= s;
+		    for (j = 0, q = p + k; j < mm; q += n)
+			*q -= u * w[j++];
+		}
+		*p = -h;
+	    }
+	}
+	p1 = p + 1;
+	if (nm > 1) {
+	    for (j = 0, q = p1, s = 0.; j < nm; ++j, ++q)
+		s += *q * *q;
+	    if (s > 0.) {
+		h = sqrt(s);
+		if (*p1 < 0.)
+		    h = -h;
+		s += *p1 * h;
+		s = 1. / s;
+		*p1 += h;
+		for (k = n, ms = n * (m - i); k < ms; k += n) {
+		    for (j = 0, q = p1, v = p1 + k, u = 0.; j < nm; ++j)
+			u += *q++ * *v++;
+		    u *= s;
+		    for (j = 0, q = p1, v = p1 + k; j < nm; ++j)
+			*v++ -= u * *q++;
+		}
+		*p1 = -h;
+	    }
+	}
+    }
+    for (j = 0, p = a; j < n; ++j, p += n + 1) {
+	d[j] = *p;
+	if (j < n - 1)
+	    w[j] = *(p + 1);
+	else
+	    w[j] = 0.;
+    }
+    qrbdi(d, w, n);
+    for (i = 0; i < n; ++i)
+	if (d[i] < 0.)
+	    d[i] = -d[i];
+    free(w);
+    return 0;
+}

lib/external/ccmath/svdu1v.c

@@ -0,0 +1,93 @@
+/*  svdu1v.c    CCMATH mathematics library source code.
+ *
+ *  Copyright (C)  2000   Daniel A. Atkinson    All rights reserved.
+ *  This code may be redistributed under the terms of the GNU library
+ *  public license (LGPL). ( See the lgpl.license file for details.)
+ * ------------------------------------------------------------------------
+ */
+#include <stdlib.h>
+#include "ccmath.h"
+int svdu1v(double *d, double *a, int m, double *v, int n)
+{
+    double *p, *p1, *q, *pp, *w, *e;
+
+    double s, h, r, t, sv;
+
+    int i, j, k, mm, nm, ms;
+
+    if (m < n)
+	return -1;
+    w = (double *)calloc(m + n, sizeof(double));
+    e = w + m;
+    for (i = 0, mm = m, nm = n - 1, p = a; i < n; ++i, --mm, --nm, p += n + 1) {
+	if (mm > 1) {
+	    sv = h = 0.;
+	    for (j = 0, q = p, s = 0.; j < mm; ++j, q += n) {
+		w[j] = *q;
+		s += *q * *q;
+	    }
+	    if (s > 0.) {
+		h = sqrt(s);
+		if (*p < 0.)
+		    h = -h;
+		s += *p * h;
+		s = 1. / s;
+		t = 1. / (w[0] += h);
+		sv = 1. + fabs(*p / h);
+		for (k = 1, ms = n - i; k < ms; ++k) {
+		    for (j = 0, q = p + k, r = 0.; j < mm; q += n)
+			r += w[j++] * *q;
+		    r *= s;
+		    for (j = 0, q = p + k; j < mm; q += n)
+			*q -= r * w[j++];
+		}
+		for (j = 1, q = p; j < mm;)
+		    *(q += n) = t * w[j++];
+	    }
+	    *p = sv;
+	    d[i] = -h;
+	}
+	if (mm == 1)
+	    d[i] = *p;
+	p1 = p + 1;
+	sv = h = 0.;
+	if (nm > 1) {
+	    for (j = 0, q = p1, s = 0.; j < nm; ++j, ++q)
+		s += *q * *q;
+	    if (s > 0.) {
+		h = sqrt(s);
+		if (*p1 < 0.)
+		    h = -h;
+		sv = 1. + fabs(*p1 / h);
+		s += *p1 * h;
+		s = 1. / s;
+		t = 1. / (*p1 += h);
+		for (k = n, ms = n * (m - i); k < ms; k += n) {
+		    for (j = 0, q = p1, pp = p1 + k, r = 0.; j < nm; ++j)
+			r += *q++ * *pp++;
+		    r *= s;
+		    for (j = 0, q = p1, pp = p1 + k; j < nm; ++j)
+			*pp++ -= r * *q++;
+		}
+		for (j = 1, q = p1 + 1; j < nm; ++j)
+		    *q++ *= t;
+	    }
+	    *p1 = sv;
+	    e[i] = -h;
+	}
+	if (nm == 1)
+	    e[i] = *p1;
+    }
+    ldvmat(a, v, n);
+    atou1(a, m, n);
+    qrbdu1(d, e, a, m, v, n);
+    for (i = 0; i < n; ++i) {
+	if (d[i] < 0.) {
+	    d[i] = -d[i];
+	    for (j = 0, p = v + i; j < n; ++j, p += n)
+		*p = -*p;
+	}
+    }
+    free(w);
+    return 0;
+}

lib/external/ccmath/svduv.c

@@ -0,0 +1,93 @@
+/*  svduv.c    CCMATH mathematics library source code.
+ *
+ *  Copyright (C)  2000   Daniel A. Atkinson    All rights reserved.
+ *  This code may be redistributed under the terms of the GNU library
+ *  public license (LGPL). ( See the lgpl.license file for details.)
+ * ------------------------------------------------------------------------
+ */
+#include <stdlib.h>
+#include "ccmath.h"
+int svduv(double *d, double *a, double *u, int m, double *v, int n)
+{
+    double *p, *p1, *q, *pp, *w, *e;
+
+    double s, h, r, t, sv;
+
+    int i, j, k, mm, nm, ms;
+
+    if (m < n)
+	return -1;
+    w = (double *)calloc(m + n, sizeof(double));
+    e = w + m;
+    for (i = 0, mm = m, nm = n - 1, p = a; i < n; ++i, --mm, --nm, p += n + 1) {
+	if (mm > 1) {
+	    sv = h = 0.;
+	    for (j = 0, q = p, s = 0.; j < mm; ++j, q += n) {
+		w[j] = *q;
+		s += *q * *q;
+	    }
+	    if (s > 0.) {
+		h = sqrt(s);
+		if (*p < 0.)
+		    h = -h;
+		s += *p * h;
+		s = 1. / s;
+		t = 1. / (w[0] += h);
+		sv = 1. + fabs(*p / h);
+		for (k = 1, ms = n - i; k < ms; ++k) {
+		    for (j = 0, q = p + k, r = 0.; j < mm; q += n)
+			r += w[j++] * *q;
+		    r *= s;
+		    for (j = 0, q = p + k; j < mm; q += n)
+			*q -= r * w[j++];
+		}
+		for (j = 1, q = p; j < mm;)
+		    *(q += n) = t * w[j++];
+	    }
+	    *p = sv;
+	    d[i] = -h;
+	}
+	if (mm == 1)
+	    d[i] = *p;
+	p1 = p + 1;
+	sv = h = 0.;
+	if (nm > 1) {
+	    for (j = 0, q = p1, s = 0.; j < nm; ++j, ++q)
+		s += *q * *q;
+	    if (s > 0.) {
+		h = sqrt(s);
+		if (*p1 < 0.)
+		    h = -h;
+		sv = 1. + fabs(*p1 / h);
+		s += *p1 * h;
+		s = 1. / s;
+		t = 1. / (*p1 += h);
+		for (k = n, ms = n * (m - i); k < ms; k += n) {
+		    for (j = 0, q = p1, pp = p1 + k, r = 0.; j < nm; ++j)
+			r += *q++ * *pp++;
+		    r *= s;
+		    for (j = 0, q = p1, pp = p1 + k; j < nm; ++j)
+			*pp++ -= r * *q++;
+		}
+		for (j = 1, q = p1 + 1; j < nm; ++j)
+		    *q++ *= t;
+	    }
+	    *p1 = sv;
+	    e[i] = -h;
+	}
+	if (nm == 1)
+	    e[i] = *p1;
+    }
+    ldvmat(a, v, n);
+    ldumat(a, u, m, n);
+    qrbdv(d, e, u, m, v, n);
+    for (i = 0; i < n; ++i) {
+	if (d[i] < 0.) {
+	    d[i] = -d[i];
+	    for (j = 0, p = v + i; j < n; ++j, p += n)
+		*p = -*p;
+	}
+    }
+    free(w);
+    return 0;
+}

lib/external/ccmath/svdval.c

@@ -0,0 +1,80 @@
+/*  svdval.c    CCMATH mathematics library source code.
+ *
+ *  Copyright (C)  2000   Daniel A. Atkinson    All rights reserved.
+ *  This code may be redistributed under the terms of the GNU library
+ *  public license (LGPL). ( See the lgpl.license file for details.)
+ * ------------------------------------------------------------------------
+ */
+#include <stdlib.h>
+#include "ccmath.h"
+int svdval(double *d, double *a, int m, int n)
+{
+    double *p, *p1, *q, *w, *v;
+
+    double s, h, u;
+
+    int i, j, k, mm, nm, ms;
+
+    if (m < n)
+	return -1;
+    w = (double *)calloc(m, sizeof(double));
+    for (i = 0, mm = m, nm = n - 1, p = a; i < n; ++i, --mm, --nm, p += n + 1) {
+	if (mm > 1) {
+	    for (j = 0, q = p, s = 0.; j < mm; ++j, q += n) {
+		w[j] = *q;
+		s += *q * *q;
+	    }
+	    if (s > 0.) {
+		h = sqrt(s);
+		if (*p < 0.)
+		    h = -h;
+		s += *p * h;
+		s = 1. / s;
+		w[0] += h;
+		for (k = 1, ms = n - i; k < ms; ++k) {
+		    for (j = 0, q = p + k, u = 0.; j < mm; q += n)
+			u += w[j++] * *q;
+		    u *= s;
+		    for (j = 0, q = p + k; j < mm; q += n)
+			*q -= u * w[j++];
+		}
+		*p = -h;
+	    }
+	}
+	p1 = p + 1;
+	if (nm > 1) {
+	    for (j = 0, q = p1, s = 0.; j < nm; ++j, ++q)
+		s += *q * *q;
+	    if (s > 0.) {
+		h = sqrt(s);
+		if (*p1 < 0.)
+		    h = -h;
+		s += *p1 * h;
+		s = 1. / s;
+		*p1 += h;
+		for (k = n, ms = n * (m - i); k < ms; k += n) {
+		    for (j = 0, q = p1, v = p1 + k, u = 0.; j < nm; ++j)
+			u += *q++ * *v++;
+		    u *= s;
+		    for (j = 0, q = p1, v = p1 + k; j < nm; ++j)
+			*v++ -= u * *q++;
+		}
+		*p1 = -h;
+	    }
+	}
+    }
+
+    for (j = 0, p = a; j < n; ++j, p += n + 1) {
+	d[j] = *p;
+	if (j != n - 1)
+	    w[j] = *(p + 1);
+	else
+	    w[j] = 0.;
+    }
+    qrbdi(d, w, n);
+    for (i = 0; i < n; ++i)
+	if (d[i] < 0.)
+	    d[i] = -d[i];
+    free(w);
+    return 0;
+}

lib/external/ccmath/trncm.c

@@ -0,0 +1,23 @@
+/*  trncm.c    CCMATH mathematics library source code.
+ *
+ *  Copyright (C)  2000   Daniel A. Atkinson    All rights reserved.
+ *  This code may be redistributed under the terms of the GNU library
+ *  public license (LGPL). ( See the lgpl.license file for details.)
+ * ------------------------------------------------------------------------
+ */
+#include "ccmath.h"
+void trncm(Cpx * a, int n)
+{
+    Cpx s, *p, *q;
+
+    int i, j, e;
+
+    for (i = 0, e = n - 1; i < n - 1; ++i, --e, a += n + 1) {
+	for (j = 0, p = a + 1, q = a + n; j < e; ++j) {
+	    s = *p;
+	    *p++ = *q;
+	    *q = s;
+	    q += n;
+	}
+    }
+}

lib/external/ccmath/trnm.c

@@ -0,0 +1,22 @@
+/*  trnm.c    CCMATH mathematics library source code.
+ *
+ *  Copyright (C)  2000   Daniel A. Atkinson    All rights reserved.
+ *  This code may be redistributed under the terms of the GNU library
+ *  public license (LGPL). ( See the lgpl.license file for details.)
+ * ------------------------------------------------------------------------
+ */
+void trnm(double *a, int n)
+{
+    double s, *p, *q;
+
+    int i, j, e;
+
+    for (i = 0, e = n - 1; i < n - 1; ++i, --e, a += n + 1) {
+	for (p = a + 1, q = a + n, j = 0; j < e; ++j) {
+	    s = *p;
+	    *p++ = *q;
+	    *q = s;
+	    q += n;
+	}
+    }
+}

lib/external/ccmath/unfl.c

@@ -0,0 +1,22 @@
+/*  unfl.c    CCMATH mathematics library source code.
+ *
+ *  Copyright (C)  2000   Daniel A. Atkinson    All rights reserved.
+ *  This code may be redistributed under the terms of the GNU library
+ *  public license (LGPL). ( See the lgpl.license file for details.)
+ * ------------------------------------------------------------------------
+ */
+static unsigned int a=69069U,c=244045795U;
+static unsigned int s,h,sbuf[256];
+double unfl()
+{ int i;
+  i=(int)(s>>24); s=sbuf[i];
+  h=a*h+c; sbuf[i]=h;
+  return s*2.328306436538696e-10;
+}
+void setunfl(unsigned int k)
+{ int j;
+  for(h=k,j=0; j<=256 ;++j){
+    h=a*h+c;
+    if(j<256) sbuf[j]=h; else s=h;
+   }
+}

lib/external/ccmath/unitary.c

@@ -0,0 +1,99 @@
+/*  unitary.c    CCMATH mathematics library source code.
+ *
+ *  Copyright (C)  2000   Daniel A. Atkinson    All rights reserved.
+ *  This code may be redistributed under the terms of the GNU library
+ *  public license (LGPL). ( See the lgpl.license file for details.)
+ * ------------------------------------------------------------------------
+ */
+#include <stdlib.h>
+#include "ccmath.h"
+static double tpi = 6.283185307179586;
+
+static void uortho(double *g, int n);
+
+double unfl();
+
+void unitary(Cpx * u, int n)
+{
+    int i, j, k, m;
+
+    Cpx h, *v, *e, *p, *r;
+
+    double *g, *q, a;
+
+    m = n * n;
+    g = (double *)calloc(n * n, sizeof(double));
+    v = (Cpx *) calloc(m + n, sizeof(Cpx));
+    e = v + m;
+    h.re = 1.;
+    h.im = 0.;
+    for (i = 0; i < n; ++i) {
+	a = tpi * unfl();
+	e[i].re = cos(a);
+	e[i].im = sin(a);
+	a = h.re * e[i].re - h.im * e[i].im;
+	h.im = h.im * e[i].re + h.re * e[i].im;
+	h.re = a;
+    }
+    h.im = -h.im;
+    for (i = 0; i < n; ++i) {
+	a = e[i].re * h.re - e[i].im * h.im;
+	e[i].im = e[i].re * h.im + e[i].im * h.re;
+	e[i].re = a;
+    }
+    uortho(g, n);
+    for (i = 0, p = v, q = g; i < n; ++i) {
+	for (j = 0; j < n; ++j)
+	    (p++)->re = *q++;
+    }
+    for (i = 0, p = v; i < n; ++i) {
+	for (j = 0, h = e[i]; j < n; ++j, ++p) {
+	    a = h.re * p->re - h.im * p->im;
+	    p->im = h.im * p->re + h.re * p->im;
+	    p->re = a;
+	}
+    }
+    uortho(g, n);
+    for (i = m = 0, p = u; i < n; ++i, m += n) {
+	for (j = 0; j < n; ++j, ++p) {
+	    p->re = p->im = 0.;
+	    for (k = 0, q = g + m, r = v + j; k < n; ++k, r += n) {
+		p->re += *q * r->re;
+		p->im += *q++ * r->im;
+	    }
+	}
+    }
+    free(g);
+    free(v);
+}
+
+static void uortho(double *g, int n)
+{
+    int i, j, k, m;
+
+    double *p, *q, c, s, a;
+
+    for (i = 0, p = g; i < n; ++i) {
+	for (j = 0; j < n; ++j) {
+	    if (i == j)
+		*p++ = 1.;
+	    else
+		*p++ = 0.;
+	}
+    }
+    for (i = 0, m = n - 1; i < m; ++i) {
+	for (j = i + 1; j < n; ++j) {
+	    a = tpi * unfl();
+	    c = cos(a);
+	    s = sin(a);
+	    p = g + n * i;
+	    q = g + n * j;
+	    for (k = 0; k < n; ++k) {
+		a = *p * c + *q * s;
+		*q = *q * c - *p * s;
+		*p++ = a;
+		++q;
+	    }
+	}
+    }
+}

lib/external/ccmath/utrncm.c

@@ -0,0 +1,36 @@
+/*  utrncm.c    CCMATH mathematics library source code.
+ *
+ *  Copyright (C)  2000   Daniel A. Atkinson    All rights reserved.
+ *  This code may be redistributed under the terms of the GNU library
+ *  public license (LGPL). ( See the lgpl.license file for details.)
+ * ------------------------------------------------------------------------
+ */
+#include <stdlib.h>
+#include "ccmath.h"
+void utrncm(Cpx * cm, Cpx * a, Cpx * b, int n)
+{
+    Cpx z, *q0, *p, *s, *t;
+
+    int i, j, k;
+
+    q0 = (Cpx *) calloc(n, sizeof(Cpx));
+    for (i = 0; i < n; ++i, ++cm) {
+	for (j = 0, t = b; j < n; ++j) {
+	    z.re = z.im = 0.;
+	    for (k = 0, s = a + i * n; k < n; ++k, ++s, ++t) {
+		z.re += t->re * s->re + t->im * s->im;
+		z.im += t->im * s->re - t->re * s->im;
+	    }
+	    q0[j] = z;
+	}
+	for (j = 0, p = cm, t = a; j < n; ++j, p += n) {
+	    z.re = z.im = 0.;
+	    for (k = 0, s = q0; k < n; ++k, ++t, ++s) {
+		z.re += t->re * s->re - t->im * s->im;
+		z.im += t->im * s->re + t->re * s->im;
+	    }
+	    *p = z;
+	}
+    }
+    free(q0);
+}

lib/external/ccmath/utrnhm.c

@@ -0,0 +1,40 @@
+/*  utrnhm.c    CCMATH mathematics library source code.
+ *
+ *  Copyright (C)  2000   Daniel A. Atkinson    All rights reserved.
+ *  This code may be redistributed under the terms of the GNU library
+ *  public license (LGPL). ( See the lgpl.license file for details.)
+ * ------------------------------------------------------------------------
+ */
+#include <stdlib.h>
+#include "ccmath.h"
+void utrnhm(Cpx * hm, Cpx * a, Cpx * b, int n)
+{
+    Cpx z, *q0, *p, *s, *t;
+
+    int i, j, k;
+
+    q0 = (Cpx *) calloc(n, sizeof(Cpx));
+    for (i = 0; i < n; ++i) {
+	for (j = 0, t = b; j < n; ++j) {
+	    z.re = z.im = 0.;
+	    for (k = 0, s = a + i * n; k < n; ++k, ++s, ++t) {
+		z.re += t->re * s->re + t->im * s->im;
+		z.im += t->im * s->re - t->re * s->im;
+	    }
+	    q0[j] = z;
+	}
+	for (j = 0, p = hm + i, t = a; j <= i; ++j, p += n) {
+	    z.re = z.im = 0.;
+	    for (k = 0, s = q0; k < n; ++k, ++t, ++s) {
+		z.re += t->re * s->re - t->im * s->im;
+		z.im += t->im * s->re + t->re * s->im;
+	    }
+	    *p = z;
+	    if (j < i) {
+		z.im = -z.im;
+		hm[i * n + j] = z;
+	    }
+	}
+    }
+    free(q0);
+}

lib/external/ccmath/vmul.c

@@ -0,0 +1,30 @@
+/*  vmul.c    CCMATH mathematics library source code.
+ *
+ *  Copyright (C)  2000   Daniel A. Atkinson    All rights reserved.
+ *  This code may be redistributed under the terms of the GNU library
+ *  public license (LGPL). ( See the lgpl.license file for details.)
+ * ------------------------------------------------------------------------
+ */
+void vmul(double *vp, double *mat, double *v, int n)
+{
+    double s, *q;
+
+    int k, i;
+
+    for (k = 0; k < n; ++k) {
+	for (i = 0, q = v, s = 0.; i < n; ++i)
+	    s += *mat++ * *q++;
+	*vp++ = s;
+    }
+}
+
+double vnrm(double *u, double *v, int n)
+{
+    double s;
+
+    int i;
+
+    for (i = 0, s = 0.; i < n; ++i)
+	s += *u++ * *v++;
+    return s;
+}

lib/gmath/ATLAS_wrapper_blas_level_1.c

@@ -0,0 +1,417 @@
+
+/*****************************************************************************
+*
+* MODULE:       Grass PDE Numerical Library
+* AUTHOR(S):    Soeren Gebbert, Berlin (GER) Dec 2006
+* 		soerengebbert <at> gmx <dot> de
+*               
+* PURPOSE:      blas level 1 like functions   
+* 		part of the gpde library
+*               
+* COPYRIGHT:    (C) 2000 by the GRASS Development Team
+*
+*               This program is free software under the GNU General Public
+*               License (>=v2). Read the file COPYING that comes with GRASS
+*               for details.
+*
+*****************************************************************************/
+
+#include <math.h>
+#include <unistd.h>
+#include <stdio.h>
+#include <string.h>
+#include <grass/gmath.h>
+
+#if defined(HAVE_ATLAS)
+#include <cblas.h>
+#endif
+
+
+/*!
+ * \brief Compute the dot product of vector x and y 
+ * using the ATLAS routine cblas_ddot 
+ *
+ * If grass was not compiled with ATLAS support
+ * it will call #G_math_f_x_dot_y, the OpenMP multi threaded 
+ * grass implementatiom
+ *
+ * \param x       (float *)
+ * \param y       (float *)
+ * \param rows (int)
+ * \return (double)
+ *
+ * */
+double G_math_ddot(double *x, double *y, int rows)
+{
+#if defined(HAVE_ATLAS)
+    return cblas_ddot(rows, x, 1, y, 1);
+#else
+    double val;
+
+    G_math_d_x_dot_y(x, y, &val, rows);
+    return val;
+#endif
+}
+
+
+/*!
+ * \brief Compute the dot product of vector x and y 
+ * using the ATLAS routine cblas_sdsdot 
+ *
+ * If grass was not compiled with ATLAS support
+ * it will call #G_math_f_x_dot_y, the OpenMP multi threaded 
+ * grass implementatiom
+ *
+ * \param x       (float *)
+ * \param y       (float *)
+ * \param a       (float)
+ * \param rows (int)
+ * \return (float)
+ *
+ * */
+float G_math_sdsdot(float *x, float *y, float a, int rows)
+{
+#if defined(HAVE_ATLAS)
+    return cblas_sdsdot(rows, a, x, 1, y, 1);
+#else
+    float val;
+
+    G_math_f_x_dot_y(x, y, &val, rows);
+    return a + val;
+#endif
+}
+
+/*!
+ * \brief Compute the euclidean norm of vector x  
+ * using the ATLAS routine cblas_dnrm2 
+ *
+ * If grass was not compiled with ATLAS support
+ * it will call #G_math_d_euclid_norm, the OpenMP multi threaded 
+ * grass implementatiom
+ *
+ * \param x       (double *)
+ * \param rows (int)
+ * \return (double)
+ *
+ * */
+double G_math_dnrm2(double *x, int rows)
+{
+#if defined(HAVE_ATLAS)
+    return cblas_dnrm2(rows, x, 1);
+#else
+    double val;
+
+    G_math_d_euclid_norm(x, &val, rows);
+    return val;
+#endif
+}
+
+/*!
+ * \brief Compute the absolute sum norm of vector x  
+ * using the ATLAS routine cblas_dasum 
+ *
+ * If grass was not compiled with ATLAS support
+ * it will call #G_math_d_asum_norm, the OpenMP multi threaded 
+ * grass implementatiom
+ *
+ * \param x       (double *)
+ * \param rows (int)
+ * \return (double)
+ *
+ * */
+double G_math_dasum(double *x, int rows)
+{
+#if defined(HAVE_ATLAS)
+    return cblas_dasum(rows, x, 1);
+#else
+    double val;
+
+    G_math_d_asum_norm(x, &val, rows);
+    return val;
+#endif
+}
+
+/*!
+ * \brief Compute the maximum norm of vector x  
+ * using the ATLAS routine cblas_idamax 
+ *
+ * If grass was not compiled with ATLAS support
+ * it will call #G_math_d_max_norm, the OpenMP multi threaded 
+ * grass implementatiom
+ *
+ * \param x       (double *)
+ * \param rows (int)
+ * \return (double)
+ *
+ * */
+double G_math_idamax(double *x, int rows)
+{
+#if defined(HAVE_ATLAS)
+    return cblas_idamax(rows, x, 1);
+#else
+    double val;
+
+    G_math_d_max_norm(x, &val, rows);
+    return val;
+#endif
+}
+
+/*!
+ * \brief Scale vector x with scalar a
+ * using the ATLAS routine cblas_dscal
+ *
+ * If grass was not compiled with ATLAS support
+ * it will call #G_math_d_ax_by, the OpenMP multi threaded 
+ * grass implementatiom
+ *
+ * \param x       (double *)
+ * \param rows (int)
+ * \return (void)
+ *
+ * */
+void G_math_dscal(double *x, double a, int rows)
+{
+#if defined(HAVE_ATLAS)
+    cblas_dscal(rows, a, x, 1);
+#else
+    G_math_d_ax_by(x, x, x, a, 0.0, rows);
+#endif
+
+    return;
+}
+
+/*!
+ * \brief  Copy vector x to vector y
+ *
+ * If grass was not compiled with ATLAS support
+ * it will call #G_math_d_copy
+ *
+ * \param x       (double *)
+ * \param y       (double *)
+ * \param rows (int)
+ * \return (void)
+ *
+ * */
+void G_math_dcopy(double *x, double *y, int rows)
+{
+#if defined(HAVE_ATLAS)
+    cblas_dcopy(rows, x, 1, y, 1);
+#else
+    G_math_d_copy(x, y, rows);
+#endif
+
+    return;
+}
+
+
+/*!
+ * \brief Scale vector x with scalar a and add it to y 
+ *
+ * \f[ {\bf z} = a{\bf x} + {\bf y} \f]
+ *
+ * If grass was not compiled with ATLAS support
+ * it will call #G_math_d_ax_by, the 
+ * grass implementatiom
+
+ *
+ * \param x      (double *)
+ * \param y      (double *)
+ * \param a      (double)
+ * \param rows (int)
+ * \return (void)
+ * 
+ * */
+void G_math_daxpy(double *x, double *y, double a, int rows)
+{
+#if defined(HAVE_ATLAS)
+    cblas_daxpy(rows, a, x, 1, y, 1);
+#else
+    G_math_d_ax_by(x, y, y, a, 1.0, rows);
+#endif
+
+    return;
+}
+
+/****************************************************************** */
+
+/********* F L O A T / S I N G L E   P E P R E C I S I O N ******** */
+
+/****************************************************************** */
+
+/*!
+ * \brief Compute the dot product of vector x and y 
+ * using the ATLAS routine cblas_sdot 
+ *
+ * If grass was not compiled with ATLAS support
+ * it will call #G_math_f_x_dot_y, the OpenMP multi threaded 
+ * grass implementatiom
+ *
+ * \param x       (float *)
+ * \param y       (float *)
+ * \param rows (int)
+ * \return (float)
+ *
+ * */
+float G_math_sdot(float *x, float *y, int rows)
+{
+#if defined(HAVE_ATLAS)
+    return cblas_sdot(rows, x, 1, y, 1);
+#else
+    float val;
+
+    G_math_f_x_dot_y(x, y, &val, rows);
+    return val;
+#endif
+}
+
+/*!
+ * \brief Compute the euclidean norm of vector x  
+ * using the ATLAS routine cblas_dnrm2 
+ *
+ * If grass was not compiled with ATLAS support
+ * it will call #G_math_f_euclid_norm, the OpenMP multi threaded 
+ * grass implementatiom
+ *
+ * \param x       (float *)
+ * \param rows (int)
+ * \return (float)
+ *
+ * */
+float G_math_snrm2(float *x, int rows)
+{
+#if defined(HAVE_ATLAS)
+    return cblas_snrm2(rows, x, 1);
+#else
+    float val;
+
+    G_math_f_euclid_norm(x, &val, rows);
+    return val;
+#endif
+}
+
+/*!
+ * \brief Compute the absolute sum norm of vector x  
+ * using the ATLAS routine cblas_dasum 
+ *
+ * If grass was not compiled with ATLAS support
+ * it will call #G_math_f_asum_norm, the OpenMP multi threaded 
+ * grass implementatiom
+ *
+ * \param x       (float *)
+ * \param rows (int)
+ * \return (float)
+ *
+ * */
+float G_math_sasum(float *x, int rows)
+{
+#if defined(HAVE_ATLAS)
+    return cblas_sasum(rows, x, 1);
+#else
+    float val;
+
+    G_math_f_asum_norm(x, &val, rows);
+    return val;
+#endif
+}
+
+/*!
+ * \brief Compute the maximum norm of vector x  
+ * using the ATLAS routine cblas_idamax 
+ *
+ * If grass was not compiled with ATLAS support
+ * it will call #G_math_f_max_norm, the OpenMP multi threaded 
+ * grass implementatiom
+ *
+ * \param x       (float *)
+ * \param rows (int)
+ * \return (float)
+ *
+ * */
+float G_math_isamax(float *x, int rows)
+{
+#if defined(HAVE_ATLAS)
+    return cblas_isamax(rows, x, 1);
+#else
+    float val;
+
+    G_math_f_max_norm(x, &val, rows);
+    return val;
+#endif
+}
+
+/*!
+ * \brief Scale vector x with scalar a
+ * using the ATLAS routine cblas_dscal
+ *
+ * If grass was not compiled with ATLAS support
+ * it will call #G_math_f_ax_by, the OpenMP multi threaded 
+ * grass implementatiom
+ *
+ * \param x       (float *)
+ * \param rows (int)
+ * \return (float)
+ *
+ * */
+void G_math_sscal(float *x, float a, int rows)
+{
+#if defined(HAVE_ATLAS)
+    cblas_sscal(rows, a, x, 1);
+#else
+    G_math_f_ax_by(x, x, x, a, 0.0, rows);
+#endif
+
+    return;
+}
+
+/*!
+ * \brief  Copy vector x to vector y
+ *
+ * If grass was not compiled with ATLAS support
+ * it will call #G_math_f_copy, the 
+ * grass implementatiom
+ *
+ * \param x       (float *)
+ * \param y       (float *)
+ * \param rows (int)
+ * \return (void)
+ *
+ * */
+void G_math_scopy(float *x, float *y, int rows)
+{
+#if defined(HAVE_ATLAS)
+    cblas_scopy(rows, x, 1, y, 1);
+#else
+    G_math_f_copy(x, y, rows);
+#endif
+
+    return;
+}
+
+
+/*!
+ * \brief Scale vector x with scalar a and add it to y 
+ *
+ * \f[ {\bf z} = a{\bf x} + {\bf y} \f]
+ *
+ * If grass was not compiled with ATLAS support
+ * it will call #G_math_f_ax_by, the 
+ * grass implementatiom
+
+ *
+ * \param x      (float *)
+ * \param y      (float *)
+ * \param a      (float)
+ * \param rows (int)
+ * \return (void)
+ * 
+ * */
+void G_math_saxpy(float *x, float *y, float a, int rows)
+{
+#if defined(HAVE_ATLAS)
+    cblas_saxpy(rows, a, x, 1, y, 1);
+#else
+    G_math_f_ax_by(x, y, y, a, 1.0, rows);
+#endif
+
+    return;
+}

lib/gmath/TODO

@@ -1,4 +1,13 @@
 TODO
+Date_ 2009-10-03
+* Add ATLAS wrapper for blas level 2 and level 3 functions.
+* Inlcude the HAVE_ATLAS definition in the configure system
+* Replace the lu-solver in lu.c with the one from the ccmath library
+  and patch alll modules using lu.c
+* Implement a robust parallelizable LU solver with pivoting
+
+
+TODO
 Date: 2006-11-20
 
 http://www.netlib.org/lapack/
@@ -32,11 +41,3 @@ row1: 13.59  20.12  19.61  70.66 34.82 16.35
 row2: 28.26  34.82  38.27  40.1 38.27 23.7
 row3: 10.54  16.35  23.7   38.98 40.1 38.98
 
------------------------------------------------------------------------
-eigen.c/jacobi.c:
- there are two conflicting
-  egvorder(), egvorder2()
-  transpose(), transpose2()
- both used in i.pca and i.cca. Header different, functionality identical.
- To be merged.
- -> some cleanup done by Glynn

lib/gmath/blas_level_1.c

@@ -0,0 +1,674 @@
+
+/*****************************************************************************
+ *
+ * MODULE:       Grass Gmath Library
+ * AUTHOR(S):    Soeren Gebbert, Berlin (GER) Dec 2007
+ * 		soerengebbert <at> gmx <dot> de
+ *               
+ * PURPOSE:      blas level 1 like functions   
+ * 		part of the gmath library
+ *               
+ * COPYRIGHT:    (C) 2000 by the GRASS Development Team
+ *
+ *               This program is free software under the GNU General Public
+ *               License (>=v2). Read the file COPYING that comes with GRASS
+ *               for details.
+ *
+ *****************************************************************************/
+
+#include <math.h>
+#include <unistd.h>
+#include <stdio.h>
+#include <string.h>
+#include <stdlib.h>
+#include <grass/gmath.h>
+#include <grass/gis.h>
+
+/* **************************************************************** */
+/* *************** D O U B L E ************************************ */
+/* **************************************************************** */
+
+/*!
+ * \brief Compute the dot product of vector x and y 
+ *
+ * \f[ a = {\bf x}^T  {\bf y} \f]
+ *
+ * The functions creates its own parallel OpenMP region.
+ * It can be called within a parallel OpenMP region if nested parallelism is supported
+ * by the compiler.
+ *
+ * \param x       (double *)
+ * \param y       (double *)
+ * \param value (double *)  -- the return value
+ * \param rows (int)
+ * \return (void)
+ *
+ * */
+void G_math_d_x_dot_y(double *x, double *y, double *value, int rows)
+{
+    int i;
+
+    double s = 0.0;
+
+#pragma omp parallel for schedule (static) reduction(+:s)
+    for (i = rows - 1; i >= 0; i--) {
+	s += x[i] * y[i];
+    }
+#pragma omp single
+    {
+	*value = s;
+    }
+    return;
+}
+
+/*!
+ * \brief Compute the euclid norm of vector x  
+ *
+ * \f[ a = ||{\bf x}||_2 \f]
+ *
+ * The functions creates its own parallel OpenMP region.
+ * It can be called within a parallel OpenMP region if nested parallelism is supported
+ * by the compiler.
+ *
+ * \param x       (double *) -- the vector
+ * \param value (double *)  -- the return value
+ * \param rows (int)
+ * \return (void)
+ *
+ * */
+void G_math_d_euclid_norm(double *x, double *value, int rows)
+{
+    int i;
+
+    double s = 0.0;
+
+#pragma omp parallel for schedule (static) reduction(+:s)
+    for (i = rows - 1; i >= 0; i--) {
+	s += x[i] * x[i];
+    }
+#pragma omp single
+    {
+	*value = sqrt(s);
+    }
+    return;
+}
+
+/*!
+ * \brief Compute the asum norm of vector x  
+ *
+ * \f[ a = ||{\bf x}||_1 \f]
+ *
+ * The functions creates its own parallel OpenMP region.
+ * It can be called within a parallel OpenMP region if nested parallelism is supported
+ * by the compiler.
+ *
+ * \param x       (double *)-- the vector
+ * \param value (double *)  -- the return value
+ * \param rows (int)
+ * \return (void)
+ *
+ * */
+void G_math_d_asum_norm(double *x, double *value, int rows)
+{
+    int i = 0;
+
+    double s = 0.0;
+
+#pragma omp parallel for schedule (static) reduction(+:s)
+    for (i = rows - 1; i >= 0; i--) {
+	s += fabs(x[i]);
+    }
+#pragma omp single
+    {
+	*value = s;
+    }
+    return;
+}
+
+/*!
+ * \brief Compute the maximum norm of vector x  
+ *
+ * \f[ a = ||{\bf x}||_\infty \f]
+ *
+ * This function is not multi-threaded
+ *
+ * \param x       (double *)-- the vector
+ * \param value (double *)  -- the return value
+ * \param rows (int)
+ * \return (void)
+ *
+ * */
+void G_math_d_max_norm(double *x, double *value, int rows)
+{
+    int i;
+
+    double max = 0.0;
+
+    max = fabs(x[rows - 1]);
+    for (i = rows - 2; i >= 0; i--) {
+	if (max < fabs(x[i]))
+	    max = fabs(x[i]);
+    }
+
+    *value = max;
+}
+
+/*!
+ * \brief Scales vectors x and y with the scalars a and b and adds them
+ *
+ * \f[ {\bf z} = a{\bf x} + b{\bf y} \f]
+ *
+ * This function is multi-threaded with OpenMP and can be called within a parallel OpenMP region.
+ *
+ * \param x      (double *)
+ * \param y      (double *)
+ * \param z      (double *)
+ * \param a      (double)
+ * \param b      (double)
+ * \param rows (int)
+ * \return (void)
+ * 
+ * */
+void G_math_d_ax_by(double *x, double *y, double *z, double a, double b,
+		    int rows)
+{
+    int i;
+
+    /*find specific cases */
+    if (b == 0.0) {
+#pragma omp for schedule (static)
+	for (i = rows - 1; i >= 0; i--) {
+	    z[i] = a * x[i];
+	}
+    }
+    else if ((a == 1.0) && (b == 1.0)) {
+#pragma omp for schedule (static)
+	for (i = rows - 1; i >= 0; i--) {
+	    z[i] = x[i] + y[i];
+	}
+    }
+    else if ((a == 1.0) && (b == -1.0)) {
+#pragma omp for schedule (static)
+	for (i = rows - 1; i >= 0; i--) {
+	    z[i] = x[i] - y[i];
+	}
+    }
+    else if (a == b) {
+#pragma omp for schedule (static)
+	for (i = rows - 1; i >= 0; i--) {
+	    z[i] = a * (x[i] + y[i]);
+	}
+    }
+    else if (b == -1.0) {
+#pragma omp for schedule (static)
+	for (i = rows - 1; i >= 0; i--) {
+	    z[i] = a * x[i] - y[i];
+	}
+    }
+    else if (b == 1.0) {
+#pragma omp for schedule (static)
+	for (i = rows - 1; i >= 0; i--) {
+	    z[i] = a * x[i] + y[i];
+	}
+    }
+    else {
+#pragma omp for schedule (static)
+	for (i = rows - 1; i >= 0; i--) {
+	    z[i] = a * x[i] + b * y[i];
+	}
+    }
+
+    return;
+}
+
+/*!
+ * \brief Copy the vector x to y
+ *
+ * \f[ {\bf y} = {\bf x} \f]
+ *
+ * This function is not multi-threaded
+ *
+ * \param x      (double *)
+ * \param y      (double *)
+ * \param rows (int)
+ * 
+ * */
+void G_math_d_copy(double *x, double *y, int rows)
+{
+    y = memcpy(y, x, rows * sizeof(double));
+
+    return;
+}
+
+/* **************************************************************** */
+/* *************** F L O A T ************************************** */
+/* **************************************************************** */
+
+/*!
+ * \brief Compute the dot product of vector x and y 
+ *
+ * \f[ a = {\bf x}^T  {\bf y} \f]
+ *
+ * The functions creates its own parallel OpenMP region.
+ * It can be called within a parallel OpenMP region if nested parallelism is supported
+ * by the compiler.
+ *
+ * \param x       (float *)
+ * \param y       (float *)
+ * \param value (float *)  -- the return value
+ * \param rows (int)
+ * \return (void)
+ *
+ * */
+void G_math_f_x_dot_y(float *x, float *y, float *value, int rows)
+{
+    int i;
+
+    float s = 0.0;
+
+#pragma omp parallel for schedule (static) reduction(+:s)
+    for (i = rows - 1; i >= 0; i--) {
+	s += x[i] * y[i];
+    }
+#pragma omp single
+    {
+	*value = s;
+    }
+    return;
+}
+
+/*!
+ * \brief Compute the euclid norm of vector x  
+ *
+ * \f[ a = ||{\bf x}||_2 \f]
+ *
+ * The functions creates its own parallel OpenMP region.
+ * It can be called within a parallel OpenMP region if nested parallelism is supported
+ * by the compiler.
+ *
+ * \param x       (double *) -- the vector
+ * \param value (float *)  -- the return value
+ * \param rows (int)
+ * \return (void)
+ *
+ * */
+void G_math_f_euclid_norm(float *x, float *value, int rows)
+{
+    int i;
+
+    float s = 0.0;
+
+#pragma omp parallel for schedule (static) reduction(+:s)
+    for (i = rows - 1; i >= 0; i--) {
+	s += x[i] * x[i];
+    }
+#pragma omp single
+    {
+	*value = sqrt(s);
+    }
+    return;
+}
+
+/*!
+ * \brief Compute the asum norm of vector x  
+ *
+ * \f[ a = ||{\bf x}||_1 \f]
+ *
+ * The functions creates its own parallel OpenMP region.
+ * It can be called within a parallel OpenMP region if nested parallelism is supported
+ * by the compiler.
+ *
+ * \param x       (float *)-- the vector
+ * \param value (float *)  -- the return value
+ * \param rows (int)
+ * \return (void)
+ *
+ * */
+void G_math_f_asum_norm(float *x, float *value, int rows)
+{
+    int i;
+
+    int count = 0;
+
+    float s = 0.0;
+
+#pragma omp parallel for schedule (static) private(i) reduction(+:s, count)
+    for (i = 0; i < rows; i++) {
+	s += fabs(x[i]);
+	count++;
+    }
+#pragma omp single
+    {
+	*value = s;
+    }
+    return;
+}
+
+/*!
+ * \brief Compute the maximum norm of vector x  
+ *
+ * \f[ a = ||{\bf x}||_\infty \f]
+ *
+ * This function is not multi-threaded
+ *
+ * \param x       (float *)-- the vector
+ * \param value (float *)  -- the return value
+ * \param rows (int)
+ * \return (void)
+ *
+ * */
+void G_math_f_max_norm(float *x, float *value, int rows)
+{
+    int i;
+
+    float max = 0.0;
+
+    max = fabs(x[rows - 1]);
+    for (i = rows - 2; i >= 0; i--) {
+	if (max < fabs(x[i]))
+	    max = fabs(x[i]);
+    }
+    *value = max;
+    return;
+}
+
+/*!
+ * \brief Scales vectors x and y with the scalars a and b and adds them
+ *
+ * \f[ {\bf z} = a{\bf x} + b{\bf y} \f]
+ *
+ * This function is multi-threaded with OpenMP and can be called within a parallel OpenMP region.
+ *
+ * \param x      (float *)
+ * \param y      (float *)
+ * \param z      (float *)
+ * \param a      (float)
+ * \param b      (float)
+ * \param rows (int)
+ * \return (void)
+ * 
+ * */
+void G_math_f_ax_by(float *x, float *y, float *z, float a, float b, int rows)
+{
+    int i;
+
+    /*find specific cases */
+    if (b == 0.0) {
+#pragma omp for schedule (static)
+	for (i = rows - 1; i >= 0; i--) {
+	    z[i] = a * x[i];
+	}
+    }
+    else if ((a == 1.0) && (b == 1.0)) {
+#pragma omp for schedule (static)
+	for (i = rows - 1; i >= 0; i--) {
+	    z[i] = x[i] + y[i];
+	}
+    }
+    else if ((a == 1.0) && (b == -1.0)) {
+#pragma omp for schedule (static)
+	for (i = rows - 1; i >= 0; i--) {
+	    z[i] = x[i] - y[i];
+	}
+    }
+    else if (a == b) {
+#pragma omp for schedule (static)
+	for (i = rows - 1; i >= 0; i--) {
+	    z[i] = a * (x[i] + y[i]);
+	}
+    }
+    else if (b == -1.0) {
+#pragma omp for schedule (static)
+	for (i = rows - 1; i >= 0; i--) {
+	    z[i] = a * x[i] - y[i];
+	}
+    }
+    else if (b == 1.0) {
+#pragma omp for schedule (static)
+	for (i = rows - 1; i >= 0; i--) {
+	    z[i] = a * x[i] + y[i];
+	}
+    }
+    else {
+#pragma omp for schedule (static)
+	for (i = rows - 1; i >= 0; i--) {
+	    z[i] = a * x[i] + b * y[i];
+	}
+    }
+
+    return;
+}
+
+/*!
+ * \brief Copy the vector x to y
+ *
+ * \f[ {\bf y} = {\bf x} \f]
+ *
+ * This function is not multi-threaded
+ *
+ * \param x      (float *)
+ * \param y      (float *)
+ * \param rows (int)
+ * 
+ * */
+void G_math_f_copy(float *x, float *y, int rows)
+{
+    y = memcpy(y, x, rows * sizeof(float));
+
+    return;
+}
+
+/* **************************************************************** */
+/* *************** I N T E G E R ********************************** */
+/* **************************************************************** */
+
+/*!
+ * \brief Compute the dot product of vector x and y 
+ *
+ * \f[ a = {\bf x}^T  {\bf y} \f]
+ *
+ * The functions creates its own parallel OpenMP region.
+ * It can be called within a parallel OpenMP region if nested parallelism is supported
+ * by the compiler.
+ *
+ * \param x       (int *)
+ * \param y       (int *)
+ * \param value (double *)  -- the return value
+ * \param rows (int)
+ * \return (void)
+ *
+ * */
+void G_math_i_x_dot_y(int *x, int *y, double *value, int rows)
+{
+    int i;
+
+    double s = 0.0;
+
+#pragma omp parallel for schedule (static) reduction(+:s)
+    for (i = rows - 1; i >= 0; i--) {
+	s += x[i] * y[i];
+    }
+#pragma omp single
+    {
+	*value = s;
+    }
+    return;
+}
+
+/*!
+ * \brief Compute the euclid norm of vector x  
+ *
+ * \f[ a = ||{\bf x}||_2 \f]
+ *
+ * The functions creates its own parallel OpenMP region.
+ * It can be called within a parallel OpenMP region if nested parallelism is supported
+ * by the compiler.
+ *
+ * \param x       (int *) -- the vector
+ * \param value (double *)  -- the return value
+ * \param rows (int)
+ * \return (void)
+ *
+ * */
+void G_math_i_euclid_norm(int *x, double *value, int rows)
+{
+    int i;
+
+    double s = 0.0;
+
+#pragma omp parallel for schedule (static) reduction(+:s)
+    for (i = rows - 1; i >= 0; i--) {
+	s += x[i] * x[i];
+    }
+#pragma omp single
+    {
+	*value = sqrt(s);
+    }
+    return;
+}
+
+/*!
+ * \brief Compute the asum norm of vector x  
+ *
+ * \f[ a = ||{\bf x}||_1 \f]
+ *
+ * The functions creates its own parallel OpenMP region.
+ * It can be called within a parallel OpenMP region if nested parallelism is supported
+ * by the compiler.
+ *
+ * \param x       (int *)-- the vector
+ * \param value (double *)  -- the return value
+ * \param rows (int)
+ * \return (void)
+ *
+ * */
+void G_math_i_asum_norm(int *x, double *value, int rows)
+{
+    int i;
+
+    double s = 0.0;
+
+#pragma omp parallel for schedule (static) reduction(+:s)
+    for (i = rows - 1; i >= 0; i--) {
+	s += fabs(x[i]);
+    }
+#pragma omp single
+    {
+	*value = s;
+    }
+    return;
+}
+
+/*!
+ * \brief Compute the maximum norm of vector x  
+ *
+ * \f[ a = ||{\bf x}||_\infty \f]
+ *
+ * This function is not multi-threaded
+ *
+ * \param x       (int *)-- the vector
+ * \param value (int *)  -- the return value
+ * \param rows (int)
+ * \return (void)
+ *
+ * */
+void G_math_i_max_norm(int *x, int *value, int rows)
+{
+    int i;
+
+    int max = 0.0;
+
+    max = fabs(x[rows - 1]);
+    for (i = rows - 2; i >= 0; i--) {
+	if (max < fabs(x[i]))
+	    max = fabs(x[i]);
+    }
+
+    *value = max;
+}
+
+/*!
+ * \brief Scales vectors x and y with the scalars a and b and adds them
+ *
+ * \f[ {\bf z} = a{\bf x} + b{\bf y} \f]
+ *
+ * This function is multi-threaded with OpenMP and can be called within a parallel OpenMP region.
+ *
+ * \param x      (int *)
+ * \param y      (int *)
+ * \param z      (int *)
+ * \param a      (int)
+ * \param b      (int)
+ * \param rows (int)
+ * \return (void)
+ * 
+ * */
+void G_math_i_ax_by(int *x, int *y, int *z, int a, int b, int rows)
+{
+    int i;
+
+    /*find specific cases */
+    if (b == 0.0) {
+#pragma omp for schedule (static)
+	for (i = rows - 1; i >= 0; i--) {
+	    z[i] = a * x[i];
+	}
+    }
+    else if ((a == 1.0) && (b == 1.0)) {
+#pragma omp for schedule (static)
+	for (i = rows - 1; i >= 0; i--) {
+	    z[i] = x[i] + y[i];
+	}
+    }
+    else if ((a == 1.0) && (b == -1.0)) {
+#pragma omp for schedule (static)
+	for (i = rows - 1; i >= 0; i--) {
+	    z[i] = x[i] - y[i];
+	}
+    }
+    else if (a == b) {
+#pragma omp for schedule (static)
+	for (i = rows - 1; i >= 0; i--) {
+	    z[i] = a * (x[i] + y[i]);
+	}
+    }
+    else if (b == -1.0) {
+#pragma omp for schedule (static)
+	for (i = rows - 1; i >= 0; i--) {
+	    z[i] = a * x[i] - y[i];
+	}
+    }
+    else if (b == 1.0) {
+#pragma omp for schedule (static)
+	for (i = rows - 1; i >= 0; i--) {
+	    z[i] = a * x[i] + y[i];
+	}
+    }
+    else {
+#pragma omp for schedule (static)
+	for (i = rows - 1; i >= 0; i--) {
+	    z[i] = a * x[i] + b * y[i];
+	}
+    }
+
+    return;
+}
+
+/*!
+ * \brief Copy the vector x to y
+ *
+ * \f[ {\bf y} = {\bf x} \f]
+ *
+ * This function is not multi-threaded
+ *
+ * \param x      (int *)
+ * \param y      (int *)
+ * \param rows (int)
+ * 
+ * */
+void G_math_i_copy(int *x, int *y, int rows)
+{
+    y = memcpy(y, x, rows * sizeof(int));
+
+    return;
+}

lib/gmath/blas_level_2.c

@@ -0,0 +1,420 @@
+
+/*****************************************************************************
+ *
+ * MODULE:       Grass PDE Numerical Library
+ * AUTHOR(S):    Soeren Gebbert, Berlin (GER) Dec 2007
+ * 		soerengebbert <at> gmx <dot> de
+ *               
+ * PURPOSE:      linear equation system solvers
+ * 		part of the gpde library
+ *               
+ * COPYRIGHT:    (C) 2007 by the GRASS Development Team
+ *
+ *               This program is free software under the GNU General Public
+ *               License (>=v2). Read the file COPYING that comes with GRASS
+ *               for details.
+ *
+ *****************************************************************************/
+
+#include <math.h>
+#include <unistd.h>
+#include <stdio.h>
+#include <string.h>
+#include <stdlib.h>
+#include <grass/gmath.h>
+#include <grass/gis.h>
+#include <grass/gisdefs.h>
+
+#define EPSILON 0.00000000000000001
+
+/*!
+ * \brief Compute the matrix - vector product  
+ * of sparse matrix **Asp and vector x.
+ *
+ * This function is multi-threaded with OpenMP and can be called within a parallel OpenMP region.
+ *
+ * y = A * x
+ *
+ *
+ * \param Asp (G_math_spvector **) 
+ * \param x (double) *)
+ * \param y (double * )
+ * \return (void)
+ *
+ * */
+void G_math_Ax_sparse(G_math_spvector ** Asp, double *x, double *y, int rows)
+{
+    int i, j;
+
+    double tmp;
+
+#pragma omp for schedule (static) private(i, j, tmp)
+    for (i = 0; i < rows; i++) {
+	tmp = 0;
+	for (j = 0; j < Asp[i]->cols; j++) {
+	    tmp += Asp[i]->values[j] * x[Asp[i]->index[j]];
+	}
+	y[i] = tmp;
+    }
+    return;
+}
+
+/*!
+ * \brief Compute the matrix - vector product  
+ * of matrix A and vector x.
+ *
+ * This function is multi-threaded with OpenMP and can be called within a parallel OpenMP region.
+ *
+ * y = A * x
+ *
+ *
+ * \param A (double ** )
+ * \param x (double *)
+ * \param y (double *) 
+ * \param rows (int)
+ * \param cols (int)
+ * \return (void)
+ *
+ * */
+void G_math_d_Ax(double **A, double *x, double *y, int rows, int cols)
+{
+    int i, j;
+
+    double tmp;
+
+#pragma omp for schedule (static) private(i, j, tmp)
+    for (i = 0; i < rows; i++) {
+	tmp = 0;
+	for (j = cols - 1; j >= 0; j--) {
+	    tmp += A[i][j] * x[j];
+	}
+	y[i] = tmp;
+    }
+    return;
+}
+
+/*!
+ * \brief Compute the matrix - vector product  
+ * of matrix A and vector x.
+ *
+ * This function is multi-threaded with OpenMP and can be called within a parallel OpenMP region.
+ *
+ * y = A * x
+ *
+ *
+ * \param A (float ** )
+ * \param x (float *)
+ * \param y (float *) 
+ * \param rows (int)
+ * \param cols (int)
+ * \return (void)
+ *
+ * */
+void G_math_f_Ax(float **A, float *x, float *y, int rows, int cols)
+{
+    int i, j;
+
+    float tmp;
+
+#pragma omp for schedule (static) private(i, j, tmp)
+    for (i = 0; i < rows; i++) {
+	tmp = 0;
+	for (j = cols - 1; j >= 0; j--) {
+	    tmp += A[i][j] * x[j];
+	}
+	y[i] = tmp;
+    }
+    return;
+}
+
+/*!
+ * \brief Compute the dyadic product of two vectors. 
+ * The result is stored in the matrix A.
+ *
+ * This function is multi-threaded with OpenMP and can be called within a parallel OpenMP region.
+ *
+ * A = x * y^T
+ *
+ *
+ * \param x (double *)
+ * \param y (double *) 
+ * \param A (float **)  -- matrix of size rows*cols
+ * \param rows (int) -- length of vector x
+ * \param cols (int) -- lengt of vector y
+ * \return (void)
+ *
+ * */
+void G_math_d_x_dyad_y(double *x, double *y, double **A, int rows, int cols)
+{
+    int i, j;
+
+#pragma omp for schedule (static) private(i, j)
+    for (i = 0; i < rows; i++) {
+	for (j = cols - 1; j >= 0; j--) {
+	    A[i][j] = x[i] * y[j];
+	}
+    }
+    return;
+}
+
+/*!
+ * \brief Compute the dyadic product of twMo vectors. 
+ * The result is stored in the matrix A.
+ *
+ * This function is multi-threaded with OpenMP and can be called within a parallel OpenMP region.
+ *
+ * A = x * y^T
+ *
+ *
+ * \param x (float *)
+ * \param y (float *) 
+ * \param A (float **=  -- matrix of size rows*cols 
+ * \param rows (int) -- length of vector x
+ * \param cols (int) -- lengt of vector y
+ * \return (void)
+ *
+ * */
+void G_math_f_x_dyad_y(float *x, float *y, float **A, int rows, int cols)
+{
+    int i, j;
+
+#pragma omp for schedule (static) private(i, j)
+    for (i = 0; i < rows; i++) {
+	for (j = cols - 1; j >= 0; j--) {
+	    A[i][j] = x[i] * y[j];
+	}
+    }
+    return;
+}
+
+/*!
+ * \brief Compute the scaled matrix - vector product  
+ * of matrix double **A and vector x and y.
+ *
+ * z = a * A * x + b * y
+ *
+ * This function is multi-threaded with OpenMP and can be called within a parallel OpenMP region.
+ *
+ *
+ * \param A (double **) 
+ * \param x (double *)
+ * \param y (double *) 
+ * \param a (double)
+ * \param b (double)
+ * \param z (double *) 
+ * \param rows (int)
+ * \param cols (int)
+ * \return (void)
+ *
+ * */
+
+void G_math_d_aAx_by(double **A, double *x, double *y, double a, double b,
+		     double *z, int rows, int cols)
+{
+    int i, j;
+
+    double tmp;
+
+    /*catch specific cases */
+    if (a == b) {
+#pragma omp for schedule (static) private(i, j, tmp)
+	for (i = 0; i < rows; i++) {
+	    tmp = 0;
+	    for (j = cols - 1; j >= 0; j--) {
+		tmp += A[i][j] * x[j] + y[j];
+	    }
+	    z[i] = a * tmp;
+	}
+    }
+    else if (b == -1.0) {
+#pragma omp for schedule (static) private(i, j, tmp)
+	for (i = 0; i < rows; i++) {
+	    tmp = 0;
+	    for (j = cols - 1; j >= 0; j--) {
+		tmp += a * A[i][j] * x[j] - y[j];
+	    }
+	    z[i] = tmp;
+	}
+    }
+    else if (b == 0.0) {
+#pragma omp for schedule (static) private(i, j, tmp)
+	for (i = 0; i < rows; i++) {
+	    tmp = 0;
+	    for (j = cols - 1; j >= 0; j--) {
+		tmp += A[i][j] * x[j];
+	    }
+	    z[i] = a * tmp;
+	}
+    }
+    else if (a == -1.0) {
+#pragma omp for schedule (static) private(i, j, tmp)
+	for (i = 0; i < rows; i++) {
+	    tmp = 0;
+	    for (j = cols - 1; j >= 0; j--) {
+		tmp += b * y[j] - A[i][j] * x[j];
+	    }
+	    z[i] = tmp;
+	}
+    }
+    else {
+#pragma omp for schedule (static) private(i, j, tmp)
+	for (i = 0; i < rows; i++) {
+	    tmp = 0;
+	    for (j = cols - 1; j >= 0; j--) {
+		tmp += a * A[i][j] * x[j] + b * y[j];
+	    }
+	    z[i] = tmp;
+	}
+    }
+    return;
+}
+
+/*!
+ * \brief Compute the scaled matrix - vector product  
+ * of matrix A and vectors x and y.
+ *
+ * z = a * A * x + b * y
+ *
+ * This function is multi-threaded with OpenMP and can be called within a parallel OpenMP region.
+ *
+ *
+ * \param A (float **) 
+ * \param x (float *)
+ * \param y (float *) 
+ * \param a (float)
+ * \param b (float)
+ * \param z (float *) 
+ * \param rows (int)
+ * \param cols (int)
+ * \return (void)
+ *
+ * */
+
+void G_math_f_aAx_by(float **A, float *x, float *y, float a, float b,
+		     float *z, int rows, int cols)
+{
+    int i, j;
+
+    float tmp;
+
+    /*catch specific cases */
+    if (a == b) {
+#pragma omp for schedule (static) private(i, j, tmp)
+	for (i = 0; i < rows; i++) {
+	    tmp = 0;
+	    for (j = cols - 1; j >= 0; j--) {
+		tmp += A[i][j] * x[j] + y[j];
+	    }
+	    z[i] = a * tmp;
+	}
+    }
+    else if (b == -1.0) {
+#pragma omp for schedule (static) private(i, j, tmp)
+	for (i = 0; i < rows; i++) {
+	    tmp = 0;
+	    for (j = cols - 1; j >= 0; j--) {
+		tmp += a * A[i][j] * x[j] - y[j];
+	    }
+	    z[i] = tmp;
+	}
+    }
+    else if (b == 0.0) {
+#pragma omp for schedule (static) private(i, j, tmp)
+	for (i = 0; i < rows; i++) {
+	    tmp = 0;
+	    for (j = cols - 1; j >= 0; j--) {
+		tmp += A[i][j] * x[j];
+	    }
+	    z[i] = a * tmp;
+	}
+    }
+    else if (a == -1.0) {
+#pragma omp for schedule (static) private(i, j, tmp)
+	for (i = 0; i < rows; i++) {
+	    tmp = 0;
+	    for (j = cols - 1; j >= 0; j--) {
+		tmp += b * y[j] - A[i][j] * x[j];
+	    }
+	    z[i] = tmp;
+	}
+    }
+    else {
+#pragma omp for schedule (static) private(i, j, tmp)
+	for (i = 0; i < rows; i++) {
+	    tmp = 0;
+	    for (j = cols - 1; j >= 0; j--) {
+		tmp += a * A[i][j] * x[j] + b * y[j];
+	    }
+	    z[i] = tmp;
+	}
+    }
+    return;
+}
+
+
+
+/*!
+ * \fn int G_math_d_A_T(double **A, int rows)
+ *
+ * \brief Compute the transposition of matrix A.
+ * Matrix A will be overwritten.
+ *
+ * This function is multi-threaded with OpenMP and can be called within a parallel OpenMP region.
+ *
+ * Returns 0.
+ *
+ * \param A (double **)
+ * \param rows (int)
+ * \return int
+ */
+
+int G_math_d_A_T(double **A, int rows)
+{
+    int i, j;
+
+    double tmp;
+
+#pragma omp for schedule (static) private(i, j, tmp)
+    for (i = 0; i < rows; i++)
+	for (j = 0; j < i; j++) {
+	    tmp = A[i][j];
+
+	    A[i][j] = A[j][i];
+	    A[j][i] = tmp;
+	}
+
+    return 0;
+}
+
+/*!
+ * \fn int G_math_d_A_T(float **A, int rows)
+ *
+ * \brief Compute the transposition of matrix A.
+ * Matrix A will be overwritten.
+ *
+ * This function is multi-threaded with OpenMP and can be called within a parallel OpenMP region.
+ *
+ * Returns 0.
+ *
+ * \param A (float **)
+ * \param rows (int)
+ * \return int
+ */
+
+int G_math_f_A_T(float **A, int rows)
+{
+    int i, j;
+
+    float tmp;
+
+#pragma omp for schedule (static) private(i, j, tmp)
+    for (i = 0; i < rows; i++)
+	for (j = 0; j < i; j++) {
+	    tmp = A[i][j];
+
+	    A[i][j] = A[j][i];
+	    A[j][i] = tmp;
+	}
+
+    return 0;
+}

lib/gmath/blas_level_3.c

@@ -0,0 +1,231 @@
+
+/*****************************************************************************
+*
+* MODULE:       Grass PDE Numerical Library
+* AUTHOR(S):    Soeren Gebbert, Berlin (GER) Dec 2007
+* 		soerengebbert <at> gmx <dot> de
+*               
+* PURPOSE:      linear equation system solvers
+* 		part of the gpde library
+*               
+* COPYRIGHT:    (C) 2007 by the GRASS Development Team
+*
+*               This program is free software under the GNU General Public
+*               License (>=v2). Read the file COPYING that comes with GRASS
+*               for details.
+*
+*****************************************************************************/
+
+#include <math.h>
+#include <unistd.h>
+#include <stdio.h>
+#include <string.h>
+#include <stdlib.h>
+#include "grass/gmath.h"
+#include <grass/gis.h>
+
+
+/*!
+ * \brief Add two matrices and scale matrix A with the scalar a
+ *
+ * \f[ {\bf C} = a {\bf A} + {\bf B} \f]
+ *
+ * In case B == NULL, matrix A will be scaled by scalar a. \n
+ * In case a == 1.0, a simple matrix addition is performed. \n
+ * In case a == -1.0 matrix A is substracted from matrix B. \n
+ * The result is written into matrix C. 
+ *
+ *
+ * This function is multi-threaded with OpenMP and can be called within a parallel OpenMP region.
+ *
+ * \param A (double **)
+ * \param B (double **) if NULL, matrix A is scaled by scalar a only
+ * \param a (double)
+ * \param C (double **)
+ * \param rows (int)
+ * \param cols (int)
+ * \return (void) 
+ *
+ * */
+void G_math_d_aA_B(double **A, double **B, double a, double **C, int rows,
+		   int cols)
+{
+    int i, j;
+
+
+    /*If B is null, scale the matrix A with th scalar a */
+    if (B == NULL) {
+#pragma omp for schedule (static) private(i, j)
+	for (i = rows - 1; i >= 0; i--)
+	    for (j = cols - 1; j >= 0; j--)
+		C[i][j] = a * A[i][j];
+
+	return;
+    }
+
+    /*select special cases */
+    if (a == 1.0) {
+#pragma omp for schedule (static) private(i, j)
+	for (i = rows - 1; i >= 0; i--)
+	    for (j = cols - 1; j >= 0; j--)
+		C[i][j] = A[i][j] + B[i][j];
+    }
+    else if (a == -1.0) {
+#pragma omp for schedule (static) private(i, j)
+	for (i = rows - 1; i >= 0; i--)
+	    for (j = cols - 1; j >= 0; j--)
+		C[i][j] = B[i][j] - A[i][j];
+    }
+    else {
+#pragma omp for schedule (static) private(i, j)
+	for (i = rows - 1; i >= 0; i--)
+	    for (j = cols - 1; j >= 0; j--)
+		C[i][j] = a * A[i][j] + B[i][j];
+    }
+
+    return;
+}
+
+/*!
+ * \brief Add two matrices and scale matrix A with the scalar a
+ *
+ * \f[ {\bf C} = a {\bf A} + {\bf B} \f]
+ *
+ * In case B == NULL, matrix A will be scaled by scalar a. \n
+ * In case a == 1.0, a simple matrix addition is performed. \n
+ * In case a == -1.0 matrix A is substracted from matrix B. \n
+ * The result is written into matrix C. 
+ *
+ *
+ *
+ * This function is multi-threaded with OpenMP and can be called within a parallel OpenMP region.
+ *
+ * \param A (float **)
+ * \param B (float **) if NULL, matrix A is scaled by scalar a only
+ * \param a (float)
+ * \param C (float **) 
+ * \param rows (int)
+ * \param cols (int)
+
+ * \return  (void) 
+ *
+ * */
+void G_math_f_aA_B(float **A, float **B, float a, float **C, int rows,
+		   int cols)
+{
+    int i, j;
+
+    /*If B is null, scale the matrix A with th scalar a */
+    if (B == NULL) {
+#pragma omp for schedule (static) private(i, j)
+	for (i = rows - 1; i >= 0; i--)
+	    for (j = cols - 1; j >= 0; j--)
+		C[i][j] = a * A[i][j];
+	return;
+    }
+
+    /*select special cases */
+    if (a == 1.0) {
+#pragma omp for schedule (static) private(i, j)
+	for (i = rows - 1; i >= 0; i--)
+	    for (j = cols - 1; j >= 0; j--)
+		C[i][j] = A[i][j] + B[i][j];
+    }
+    else if (a == -1.0) {
+#pragma omp for schedule (static) private(i, j)
+	for (i = rows - 1; i >= 0; i--)
+	    for (j = cols - 1; j >= 0; j--)
+		C[i][j] = B[i][j] - A[i][j];
+    }
+    else {
+#pragma omp for schedule (static) private(i, j)
+	for (i = rows - 1; i >= 0; i--)
+	    for (j = cols - 1; j >= 0; j--)
+		C[i][j] = a * A[i][j] + B[i][j];
+    }
+
+    return;
+}
+
+
+/*!
+ * \brief Matrix multiplication
+ *
+ * \f[ {\bf C} = {\bf A}{\bf B} \f]
+ *
+ * The result is written into matrix C. 
+ *
+ * A must be of size rows_A * cols_A
+ * B must be of size rows_B * cols_B with rows_B == cols_A
+ * C must be of size rows_A * rows_B
+ *
+ *
+ * This function is multi-threaded with OpenMP and can be called within a parallel OpenMP region.
+ *
+ * \param A (double **)
+ * \param B (double **)
+ * \param C (double **)
+ * \param rows_A (int)
+ * \param cols_A (int)
+ * \param rows_B (int)
+ * \return (void)
+ *
+ * */
+void G_math_d_AB(double **A, double **B, double **C, int rows_A,
+		 int cols_A, int rows_B)
+{
+    int i, j, k;
+
+#pragma omp for schedule (static) private(i, j, k)
+    for (i = 0; i < rows_A; i++) {
+	for (j = 0; j < rows_B; j++) {
+	    C[i][j] = 0.0;
+	    for (k = cols_A - 1; k >= 0; k--) {
+		C[i][j] += A[i][k] * B[k][j];
+	    }
+	}
+    }
+
+    return;
+}
+
+/*!
+ * \brief Matrix multiplication
+ *
+ * \f[ {\bf C} = {\bf A}{\bf B} \f]
+ *
+ * The result is written into matrix C. 
+ *
+ * A must be of size rows_A * cols_A
+ * B must be of size rows_B * cols_B with rows_B == cols_A
+ * C must be of size rows_A * rows_B
+ *
+ *
+ * This function is multi-threaded with OpenMP and can be called within a parallel OpenMP region.
+ *
+ * \param A (float **)
+ * \param B (float **) 
+ * \param D (float **) 
+ * \param rows_A (int)
+ * \param cols_A (int)
+ * \param rows_B (int)
+ * \return (void)
+ *
+ * */
+void G_math_f_AB(float **A, float **B, float **C, int rows_A,
+		 int cols_A, int rows_B)
+{
+    int i, j, k;
+
+#pragma omp for schedule (static) private(i, j, k)
+    for (i = 0; i < rows_A; i++) {
+	for (j = 0; j < rows_B; j++) {
+	    C[i][j] = 0.0;
+	    for (k = cols_A - 1; k >= 0; k--) {
+		C[i][j] += A[i][k] * B[k][j];
+	    }
+	}
+    }
+
+    return;
+}

lib/gmath/ccmath_grass_wrapper.c

@@ -0,0 +1,458 @@
+#if defined(HAVE_CCMATH)
+#include <ccmath.h>
+#else
+#include <grass/ccmath_grass.h>
+#endif
+/**
+                                Chapter 1
+
+                              LINEAR ALGEBRA
+
+                                 Summary
+
+               The matrix algebra library contains functions that
+               perform the standard computations of linear algebra.
+               General areas covered are:
+
+                         o Solution of Linear Systems
+                         o Matrix Inversion
+                         o Eigensystem Analysis
+                         o Matrix Utility Operations
+                         o Singular Value Decomposition
+
+               The operations covered here are fundamental to many
+               areas of mathematics and statistics. Thus, functions
+               in this library segment are called by other library
+               functions. Both real and complex valued matrices
+               are covered by functions in the first four of these
+               categories.
+
+
+ Notes on Contents
+
+     Functions in this library segment provide the basic operations of
+ numerical linear algebra and some useful utility functions for operations on
+ vectors and matrices. The following list describes the functions available for
+ operations with real-valued matrices.
+
+
+ o  Solving and Inverting Linear Systems:
+
+    solv  --------- solve a general system of real linear equations.
+    solvps  ------- solve a real symmetric linear system.
+    solvru  ------- solve a real right upper triangular linear system.
+    solvtd  ------- solve a tridiagonal real linear system.
+
+    minv  --------- invert a general real square matrix.
+    psinv  -------- invert a real symmetric matrix.
+    ruinv  -------- invert a right upper triangular matrix.
+
+
+     The solution of a general linear system and efficient algorithms for
+ solving special systems with symmetric and tridiagonal matrices are provided
+ by these functions. The general solution function employs a LU factorization
+ with partial pivoting and it is very robust. It will work efficiently on any
+ problem that is not ill-conditioned. The symmetric matrix solution is based
+ on a modified Cholesky factorization. It is best used on positive definite
+ matrices that do not require pivoting for numeric stability. Tridiagonal
+ solvers require order-N operations (N = dimension). Thus, they are highly
+ recommended for this important class of sparse systems. Two matrix inversion
+ routines are provided. The general inversion function is again LU based. It
+ is suitable for use on any stable (ie. well-conditioned) problem. The
+ Cholesky based symmetric matrix inversion is efficient and safe for use on
+ matrices known to be positive definite, such as the variance matrices
+ encountered in statistical computations. Both the solver and the inverse
+ functions are designed to enhance data locality. They are very effective
+ on modern microprocessors.
+
+
+ o  Eigensystem Analysis:
+
+    eigen  ------ extract all eigen values and vectors of a real
+                  symmetric matrix.
+    eigval  ----- extract the eigen values of a real symmetric matrix.
+    evmax  ------ compute the eigen value of maximum absolute magnitude
+                  and its corresponding vector for a symmetric matrix.
+
+
+     Eigensystem functions operate on real symmetric matrices. Two forms of
+ the general eigen routine are provided because the computation of eigen values
+ only is much faster when vectors are not required. The basic algorithms use
+ a Householder reduction to tridiagonal form followed by QR iterations with
+ shifts to enhance convergence. This has become the accepted standard for
+ symmetric eigensystem computation. The evmax function uses an efficient
+ iterative power method algorithm to extract the eigen value of maximum
+ absolute size and the corresponding eigenvector.
+
+
+ o Singular Value Decomposition:
+
+    svdval  ----- compute the singular values of a m by n real matrix.
+    sv2val  ----- compute the singular values of a real matrix
+                  efficiently for m >> n.
+    svduv  ------ compute the singular values and the transformation
+                  matrices u and v for a real m by n matrix.
+    sv2uv  ------ compute the singular values and transformation
+                  matrices efficiently for m >> n.
+    svdu1v  ----- compute the singular values and transformation
+                  matrices u1 and v, where u1 overloads the input
+                  with the first n column vectors of u.
+    sv2u1v  ----- compute the singular values and the transformation
+                  matrices u1 and v efficiently for m >> n.
+
+
+     Singular value decomposition is extremely useful when dealing with linear
+ systems that may be singular. Singular values with values near zero are flags
+ of a potential rank deficiency in the system matrix. They can be used to
+ identify the presence of an ill-conditioned problem and, in some cases, to
+ deal with the potential instability. They are applied to the linear least
+ squares problem in this library. Singular values also define some important
+ matrix norm parameters such as the 2-norm and the condition value. A complete
+ decomposition provides both singular values and an orthogonal decomposition of
+ vector spaces related to the matrix identifying the range and null-space.
+ Fortunately, a highly stable algorithm based on Householder reduction to
+ bidiagonal form and QR rotations can be used to implement the decomposition.
+ The library provides two forms with one more efficient when the dimensions
+ satisfy m > (3/2)n.
+
+ General Technical Comments
+
+     Efficient computation with matrices on modern processors must be
+ adapted to the storage scheme employed for matrix elements. The functions
+ of this library segment do not employ the multidimensional array intrinsic
+ of the C language. Access to elements employs the simple row-major scheme
+ described here.
+
+     Matrices are modeled by the library functions as arrays with elements
+ stored in row order. Thus, the element in the jth row and kth column of
+ the n by n matrix M, stored in the array mat[], is addressed by
+
+           M[j,k] = mat[n*j+k]  , with   0 =< j,k <= n-1 .
+
+ (Remember that C employs zero as the starting index.) The storage order has
+ important implications for data locality.
+
+     The algorithms employed here all have excellent numerical stability, and
+ the default double precision arithmetic of C enhances this. Thus, any
+ problems encountered in using the matrix algebra functions will almost
+ certainly be due to an ill-conditioned matrix. (The Hilbert matrices,
+
+                 H[i,j] = 1/(1+i+j)  for i,j < n
+
+ form a good example of such ill-conditioned systems.) We remind the reader
+ that the appropriate response to such ill-conditioning is to seek an
+ alternative approach to the problem. The option of increasing precision has
+ already been exploited. Modification of the linear algebra algorithm code is
+ not normally effective in an ill-conditioned problem.
+
+------------------------------------------------------------------------------
+                      FUNCTION SYNOPSES
+------------------------------------------------------------------------------
+
+ Linear System Solutions:
+-----------------------------------------------------------------------------
+*/
+/**
+     \brief Solve a general linear system  A*x = b.
+
+     \param  a = array containing system matrix A in row order (altered to L-U factored form by computation)
+     \param  b = array containing system vector b at entry and solution vector x at exit
+     \param  n = dimension of system
+     \return 0 -> normal exit; -1 -> singular input
+ */
+int G_math_solv(double **a,double *b,int n)
+{
+    return solv(a[0],b, n);
+}
+
+
+/**
+     \brief Solve a symmetric positive definite linear system S*x = b.
+
+     \param  a = array containing system matrix S (altered to Cholesky upper right factor by computation)
+     \param  b = array containing system vector b as input and solution vector x as output
+     \param  n = dimension of system
+     \return: 0 -> normal exit; -1 -> input matrix not positive definite
+ */
+ int G_math_solvps(double **a,double *b,int n)
+{
+    return solvps(a[0], b,n);
+}
+
+
+/**
+     \brief Solve a tridiagonal linear system M*x = y.
+
+     \param a = array containing m+1 diagonal elements of M
+     \param  b = array of m elements below the main diagonal of M
+     \param  c = array of m elements above the main diagonal
+     \param  x = array containing the system vector y initially, and the solution vector at exit (m+1 elements)
+     \param  m = dimension parameter ( M is (m+1)x(m+1) )
+
+*/
+void G_math_solvtd(double *a,double *b,double *c,double *x,int m)
+{
+    solvtd(a, b, c, x, m);
+    return;
+}
+
+
+/*
+     \brief Solve an upper right triangular linear system T*x = b.
+
+     \param  a = pointer to array of upper right triangular matrix T
+     \param  b = pointer to array of system vector The computation overloads this with the solution vector x.
+     \param  n = dimension (dim(a)=n*n,dim(b)=n)
+     \return value: f = status flag, with 0 -> normal exit, -1 -> system singular
+*/
+int G_math_solvru(double **a,double *b,int n)
+{
+    return solvru(a[0], b, n);
+}
+
+
+/**
+     \brief Invert (in place) a general real matrix A -> Inv(A).
+
+     \param  a = array containing the input matrix A. This is converted to the inverse matrix.
+     \param  n = dimension of the system (i.e. A is n x n )
+     \return: 0 -> normal exit, 1 -> singular input matrix
+*/
+int G_math_minv(double **a,int n)
+{
+    return minv(a[0], n);
+}
+
+
+/**
+     \brief Invert (in place) a symmetric real matrix, V -> Inv(V).
+
+     The input matrix V is symmetric (V[i,j] = V[j,i]).
+     \param  v = array containing a symmetric input matrix. This is converted to the inverse matrix.
+     \param  n = dimension of the system (dim(v)=n*n)
+     \return: 0 -> normal exit 1 -> input matrix not positive definite
+*/
+int G_math_psinv(double **a,int n)
+{
+    return psinv( a[0], n);
+}
+
+
+/**
+     \brief Invert an upper right triangular matrix T -> Inv(T).
+
+     \param  a = pointer to array of upper right triangular matrix, This is replaced by the inverse matrix.
+     \param  n = dimension (dim(a)=n*n)
+     \return value: status flag, with 0 -> matrix inverted -1 -> matrix singular
+*/
+int G_math_ruinv(double **a,int n)
+{
+    return ruinv(a[0], n);
+}
+
+
+/*
+-----------------------------------------------------------------------------
+
+     Symmetric Eigensystem Analysis:
+-----------------------------------------------------------------------------
+*/
+/**
+
+     \brief Compute the eigenvalues of a real symmetric matrix A.
+
+     \param  a = pointer to array of symmetric n by n input matrix A. The computation alters these values.
+     \param  ev = pointer to array of the output eigenvalues
+     \param  n = dimension parameter (dim(a)= n*n, dim(ev)= n)
+*/
+void G_math_eigval(double **a,double *ev,int n)
+{
+    eigval(a[0], ev, n);
+    return;
+}
+
+
+/**
+     \brief Compute the eigenvalues and eigenvectors of a real symmetric matrix A.
+
+      The input and output matrices are related by
+
+          A = E*D*E~ where D is the diagonal matrix of eigenvalues
+          D[i,j] = ev[i] if i=j and 0 otherwise.
+
+     The columns of E are the eigenvectors.
+
+     \param  a = pointer to store for symmetric n by n input matrix A. The computation overloads this with an orthogonal matrix of eigenvectors E.
+     \param  ev = pointer to the array of the output eigenvalues
+     \param  n = dimension parameter (dim(a)= n*n, dim(ev)= n)
+*/
+void G_math_eigen(double **a,double *ev,int n)
+{
+    eigen(a[0], ev, n);
+    return;
+}
+
+
+/*
+     \brief Compute the maximum (absolute) eigenvalue and corresponding eigenvector of a real symmetric matrix A.
+
+
+     \param  a = array containing symmetric input matrix A
+     \param  u = array containing the n components of the eigenvector at exit (vector normalized to 1)
+     \param  n = dimension of system
+     \return: ev = eigenvalue of A with maximum absolute value HUGE -> convergence failure
+*/
+double G_math_evmax(double **a,double *u,int n)
+{
+    return evmax(a[0], u, n);
+}
+
+
+/* 
+------------------------------------------------------------------------------
+
+ Singular Value Decomposition:
+------------------------------------------------------------------------------
+
+     A number of versions of the Singular Value Decomposition (SVD)
+     are implemented in the library. They support the efficient
+     computation of this important factorization for a real m by n
+     matrix A. The general form of the SVD is
+
+          A = U*S*V~     with S = | D |
+                                  | 0 |
+
+     where U is an m by m orthogonal matrix, V is an n by n orthogonal matrix,
+     D is the n by n diagonal matrix of singular value, and S is the singular
+     m by n matrix produced by the transformation.
+
+     The singular values computed by these functions provide important
+     information on the rank of the matrix A, and on several matrix
+     norms of A. The number of non-zero singular values d[i] in D
+     equal to the rank of A. The two norm of A is
+
+          ||A|| = max(d[i]) , and the condition number is
+
+          k(A) = max(d[i])/min(d[i]) .
+
+     The Frobenius norm of the matrix A is
+
+          Fn(A) = Sum(i=0 to n-1) d[i]^2 .
+
+     Singular values consistent with zero are easily recognized, since
+     the decomposition algorithms have excellent numerical stability.
+     The value of a 'zero' d[i] is no larger than a few times the
+     computational rounding error e.
+     
+     The matrix U1 is formed from the first n orthonormal column vectors
+     of U.  U1[i,j] = U[i,j] for i = 1 to m and j = 1 to n. A singular
+     value decomposition of A can also be expressed in terms of the m by\
+     n matrix U1, with
+
+                       A = U1*D*V~ .
+
+     SVD functions with three forms of output are provided. The first
+     form computes only the singular values, while the second computes
+     the singular values and the U and V orthogonal transformation
+     matrices. The third form of output computes singular values, the
+     V matrix, and saves space by overloading the input array with
+     the U1 matrix.
+
+     Two forms of decomposition algorithm are available for each of the
+     three output types. One is computationally efficient when m ~ n.
+     The second, distinguished by the prefix 'sv2' in the function name,
+     employs a two stage Householder reduction to accelerate computation
+     when m substantially exceeds n. Use of functions of the second form
+     is recommended for m > 2n.
+
+     Singular value output from each of the six SVD functions satisfies
+
+          d[i] >= 0 for i = 0 to n-1.
+-------------------------------------------------------------------------------
+*/
+
+
+/**
+     \brief Compute the singular values of a real m by n matrix A.
+
+
+     \param  d = pointer to double array of dimension n (output = singular values of A)
+     \param  a = pointer to store of the m by n input matrix A (A is altered by the computation)
+     \param  m = number of rows in A
+     \param  n = number of columns in A (m>=n required)
+     \return value: status flag with: 0 -> success -1 -> input error m < n
+
+*/
+int G_math_svdval(double *d,double **a,int m,int n)
+{
+    return svdval(d, a[0], m, n);
+}
+
+
+/**
+
+     \brief Compute singular values when m >> n.
+
+     \param  d = pointer to double array of dimension n (output = singular values of A)
+     \param  a = pointer to store of the m by n input matrix A (A is altered by the computation)
+     \param  m = number of rows in A
+     \param  n = number of columns in A (m>=n required)
+     \return value: status flag with: 0 -> success -1 -> input error m < n
+*/
+int G_math_sv2val(double *d,double **a,int m,int n)
+{
+    return sv2val(d, a[0], m, n);
+}
+
+
+/*
+     \brief Compute the singular value transformation S = U~*A*V.
+     
+     \param  d = pointer to double array of dimension n (output = singular values of A)
+     \param  a = pointer to store of the m by n input matrix A (A is altered by the computation)
+     \param  u = pointer to store for m by m orthogonal matrix U
+     \param  v = pointer to store for n by n orthogonal matrix V
+     \param  m = number of rows in A
+     \param  n = number of columns in A (m>=n required)
+     \return value: status flag with: 0 -> success -1 -> input error m < n
+*/
+int G_math_svduv(double *d,double **a,double **u,int m,double **v,int n)
+{
+    return svduv(d, a[0], u[0], m, v[0], n);
+}
+
+
+/**
+     \brief Compute the singular value transformation when m >> n.
+     
+     \param  d = pointer to double array of dimension n (output = singular values of A)
+     \param  a = pointer to store of the m by n input matrix A (A is altered by the computation)
+     \param  u = pointer to store for m by m orthogonal matrix U
+     \param  v = pointer to store for n by n orthogonal matrix V
+     \param  m = number of rows in A
+     \param  n = number of columns in A (m>=n required)
+     \return value: status flag with: 0 -> success -1 -> input error m < n
+*/
+int G_math_sv2uv(double *d,double **a,double **u,int m,double **v,int n)
+{
+    return sv2uv(d, a[0], u[0], m, v[0], n);
+}
+
+
+/**
+
+     \brief Compute the singular value transformation with A overloaded by the partial U-matrix.
+     
+     \param  d = pointer to double array of dimension n
+           (output = singular values of A)
+     \param   a = pointer to store of the m by n input matrix A (At output a is overloaded by the matrix U1 whose n columns are orthogonal vectors equal to the first n columns of U.)
+     \param   v = pointer to store for n by n orthogonal matrix V
+     \param   m = number of rows in A
+     \param   n = number of columns in A (m>=n required)
+     \return value: status flag with: 0 -> success -1 -> input error m < n
+
+*/
+int G_math_svdu1v(double *d,double **a,int m,double **v,int n)
+{
+    return svdu1v(d, a[0], m, v[0], n);
+}

lib/gmath/del2g.c

@@ -61,7 +61,7 @@ int del2g(double *img[2], int size, double w)
 
     /* multiply the complex vectors img and g, each of length size*size */
     G_message(_("    multiplying transforms..."));
-    mult(img, size * size, g, size * size, img, size * size);
+    G_math_complex_mult(img, size * size, g, size * size, img, size * size);
 
     G_message(_("    taking inverse FFT..."));
     fft(INVERSE, img, size * size, size, size);

lib/gmath/eigen.c

@@ -1,147 +0,0 @@
-/* taken from i.pca */
-
-#include <stdlib.h>
-#include <grass/gmath.h>
-#include <grass/gis.h>
-
-
-static int egcmp(const void *pa, const void *pb);
-
-
-/*!
- * \fn int eigen (double **M, double **Vectors, double *lambda, int n)
- *
- * \brief Computes eigenvalues (and eigen vectors if desired) for
- * symmetric matices.
- *
- * Computes eigenvalues (and eigen vectors if desired) for symmetric matices.
- *
- * \param M Input matrix
- * \param Vectors eigen output vector matrix
- * \param lambda Output eigenvalues
- * \param n Input matrix dimension
- * \return int
- */
-
-int eigen(double **M,		/* Input matrix */
-	  double **Vectors,	/* eigen vector matrix -output */
-	  double *lambda,	/* Output eigenvalues */
-	  int n			/* Input matrix dimension */
-    )
-{
-    int i, j;
-    double **a, *e;
-
-    a = G_alloc_matrix(n, n);
-    e = G_alloc_vector(n);
-
-    for (i = 0; i < n; i++)
-	for (j = 0; j < n; j++)
-	    a[i][j] = M[i][j];
-
-    G_tred2(a, n, lambda, e);
-    G_tqli(lambda, e, n, a);
-
-    /* Returns eigenvectors */
-    if (Vectors)
-	for (i = 0; i < n; i++)
-	    for (j = 0; j < n; j++)
-		Vectors[i][j] = a[i][j];
-
-    G_free_matrix(a);
-    G_free_vector(e);
-
-    return 0;
-}
-
-
-/*!
- * \fn int egvorder2 (double *d, double **z, long bands)
- *
- * \brief
- *
- * Returns 0.
- *
- * \param d
- * \param z
- * \param bands
- * \return int
- */
-
-int egvorder2(double *d, double **z, long bands)
-{
-    double *buff;
-    double **tmp;
-    int i, j;
-
-    /* allocate temporary matrix */
-    buff = (double *)G_malloc(bands * (bands + 1) * sizeof(double));
-    tmp = (double **)G_malloc(bands * sizeof(double *));
-    for (i = 0; i < bands; i++)
-	tmp[i] = &buff[i * (bands + 1)];
-
-    /* concatenate (vertically) z and d into tmp */
-    for (i = 0; i < bands; i++) {
-	for (j = 0; j < bands; j++)
-	    tmp[i][j + 1] = z[j][i];
-	tmp[i][0] = d[i];
-    }
-
-    /* sort the combined matrix */
-    qsort(tmp, bands, sizeof(double *), egcmp);
-
-    /* split tmp into z and d */
-    for (i = 0; i < bands; i++) {
-	for (j = 0; j < bands; j++)
-	    z[j][i] = tmp[i][j + 1];
-	d[i] = tmp[i][0];
-    }
-
-    /* free temporary matrix */
-    G_free(tmp);
-    G_free(buff);
-
-    return 0;
-}
-
-
-/*!
- * \fn int transpose2 (double **eigmat, long bands)
- *
- * \brief
- *
- * Returns 0.
- *
- * \param eigmat
- * \param bands
- * \return int
- */
-
-int transpose2(double **eigmat, long bands)
-{
-    int i, j;
-
-    for (i = 0; i < bands; i++)
-	for (j = 0; j < i; j++) {
-	    double tmp = eigmat[i][j];
-
-	    eigmat[i][j] = eigmat[j][i];
-	    eigmat[j][i] = tmp;
-	}
-
-    return 0;
-}
-
-
-static int egcmp(const void *pa, const void *pb)
-{
-    const double *a = *(const double *const *)pa;
-    const double *b = *(const double *const *)pb;
-
-    if (*a > *b)
-	return -1;
-    if (*a < *b)
-	return 1;
-
-    return 0;
-}

lib/gmath/eigen_tools.c

@@ -1,156 +1,59 @@
-#include <grass/gis.h>
+#include <stdlib.h>
 #include <math.h>
+#include <grass/gis.h>
+#include <grass/gmath.h>
 
-
-#define MAX_ITERS 30
-#define SIGN(a,b) ((b)<0 ? -fabs(a) : fabs(a))
+static int egcmp(const void *pa, const void *pb);
 
 
-int G_tqli(double d[], double e[], int n, double **z)
+int G_math_egvorder(double *d, double **z, long bands)
 {
-    int m, l, iter, i, k;
-    double s, r, p, g, f, dd, c, b;
-
-    for (i = 1; i < n; i++)
-	e[i - 1] = e[i];
-    e[n - 1] = 0.0;
-    for (l = 0; l < n; l++) {
-	iter = 0;
-
-	do {
-	    for (m = l; m < n - 1; m++) {
-		dd = fabs(d[m]) + fabs(d[m + 1]);
-		if (fabs(e[m]) + dd == dd)
-		    break;
-	    }
-
-	    if (m != l) {
-		if (iter++ == MAX_ITERS)
-		    return 0;	/* Too many iterations in TQLI */
-		g = (d[l + 1] - d[l]) / (2.0 * e[l]);
-		r = sqrt((g * g) + 1.0);
-		g = d[m] - d[l] + e[l] / (g + SIGN(r, g));
-		s = c = 1.0;
-		p = 0.0;
-
-		for (i = m - 1; i >= l; i--) {
-		    f = s * e[i];
-		    b = c * e[i];
-
-		    if (fabs(f) >= fabs(g)) {
-			c = g / f;
-			r = sqrt((c * c) + 1.0);
-			e[i + 1] = f * r;
-			c *= (s = 1.0 / r);
-		    }
-		    else {
-			s = f / g;
-			r = sqrt((s * s) + 1.0);
-			e[i + 1] = g * r;
-			s *= (c = 1.0 / r);
-		    }
+    double *buff;
+    double **tmp;
+    int i, j;
+
+    /* allocate temporary matrix */
+    buff = (double *)G_malloc(bands * (bands + 1) * sizeof(double));
+    tmp = (double **)G_malloc(bands * sizeof(double *));
+    for (i = 0; i < bands; i++)
+	tmp[i] = &buff[i * (bands + 1)];
+
+    /* concatenate (vertically) z and d into tmp */
+    for (i = 0; i < bands; i++) {
+	for (j = 0; j < bands; j++)
+	    tmp[i][j + 1] = z[j][i];
+	tmp[i][0] = d[i];
+    }
 
-		    g = d[i + 1] - p;
-		    r = (d[i] - g) * s + 2.0 * c * b;
-		    p = s * r;
-		    d[i + 1] = g + p;
-		    g = c * r - b;
+    /* sort the combined matrix */
+    qsort(tmp, bands, sizeof(double *), egcmp);
 
-		    /* Next loop can be omitted if eigenvectors not wanted */
-		    for (k = 0; k < n; k++) {
-			f = z[k][i + 1];
-			z[k][i + 1] = s * z[k][i] + c * f;
-			z[k][i] = c * z[k][i] - s * f;
-		    }
-		}
-		d[l] = d[l] - p;
-		e[l] = g;
-		e[m] = 0.0;
-	    }
-	} while (m != l);
+    /* split tmp into z and d */
+    for (i = 0; i < bands; i++) {
+	for (j = 0; j < bands; j++)
+	    z[j][i] = tmp[i][j + 1];
+	d[i] = tmp[i][0];
     }
 
-    return 1;
+    /* free temporary matrix */
+    G_free(tmp);
+    G_free(buff);
+
+    return 0;
 }
 
+/***************************************************************************/
 
-void G_tred2(double **a, int n, double d[], double e[])
+static int egcmp(const void *pa, const void *pb)
 {
-    int l, k, j, i;
-    double scale, hh, h, g, f;
-
-    for (i = n - 1; i >= 1; i--) {
-	l = i - 1;
-	h = scale = 0.0;
+    const double *a = *(const double *const *)pa;
+    const double *b = *(const double *const *)pb;
 
-	if (l > 0) {
-	    for (k = 0; k <= l; k++)
-		scale += fabs(a[i][k]);
+    if (*a > *b)
+	return -1;
+    if (*a < *b)
+	return 1;
 
-	    if (scale == 0.0)
-		e[i] = a[i][l];
-	    else {
-		for (k = 0; k <= l; k++) {
-		    a[i][k] /= scale;
-		    h += a[i][k] * a[i][k];
-		}
-
-		f = a[i][l];
-		g = f > 0 ? -sqrt(h) : sqrt(h);
-		e[i] = scale * g;
-		h -= f * g;
-		a[i][l] = f - g;
-		f = 0.0;
-
-		for (j = 0; j <= l; j++) {
-		    /* Next statement can be omitted if eigenvectors not wanted */
-		    a[j][i] = a[i][j] / h;
-		    g = 0.0;
-		    for (k = 0; k <= j; k++)
-			g += a[j][k] * a[i][k];
-		    for (k = j + 1; k <= l; k++)
-			g += a[k][j] * a[i][k];
-		    e[j] = g / h;
-		    f += e[j] * a[i][j];
-		}
-
-		hh = f / (h + h);
-		for (j = 0; j <= l; j++) {
-		    f = a[i][j];
-		    e[j] = g = e[j] - hh * f;
-
-		    for (k = 0; k <= j; k++)
-			a[j][k] -= (f * e[k] + g * a[i][k]);
-		}
-	    }
-	}
-	else
-	    e[i] = a[i][l];
-	d[i] = h;
-    }
-
-    /* Next statement can be omitted if eigenvectors not wanted */
-    d[0] = 0.0;
-    e[0] = 0.0;
-
-    /* Contents of this loop can be omitted if eigenvectors not
-       wanted except for statement d[i]=a[i][i]; */
-    for (i = 0; i < n; i++) {
-	l = i - 1;
-
-	if (d[i]) {
-	    for (j = 0; j <= l; j++) {
-		g = 0.0;
-		for (k = 0; k <= l; k++)
-		    g += a[i][k] * a[k][j];
-		for (k = 0; k <= l; k++)
-		    a[k][j] -= g * a[k][i];
-	    }
-	}
-
-	d[i] = a[i][i];
-	a[i][i] = 1.0;
-	for (j = 0; j <= l; j++)
-	    a[j][i] = a[i][j] = 0.0;
-    }
+    return 0;
 }
+/***************************************************************************/

lib/gmath/jacobi.c

@@ -1,99 +0,0 @@
-#include <stdlib.h>
-#include <math.h>
-#include <grass/gis.h>
-#include <grass/gmath.h>
-
-
-/***************************************************************************/
-
-/* this does not use the Jacobi method, but it should give the same result */
-
-int jacobi(double a[MX][MX], long n, double d[MX], double v[MX][MX])
-{
-    double *aa[MX], *vv[MX], *dd;
-    int i;
-
-    for (i = 0; i < n; i++) {
-	aa[i] = &a[i + 1][1];
-	vv[i] = &v[i + 1][1];
-    }
-    dd = &d[1];
-    eigen(aa, vv, dd, n);
-
-    return 0;
-}
-
-/***************************************************************************/
-
-static int egcmp(const void *pa, const void *pb)
-{
-    const double *a = *(const double *const *)pa;
-    const double *b = *(const double *const *)pb;
-
-    if (*a > *b)
-	return -1;
-    if (*a < *b)
-	return 1;
-
-    return 0;
-}
-
-int egvorder(double d[MX], double z[MX][MX], long bands)
-{
-    double *buff;
-    double **tmp;
-    int i, j;
-
-    /* allocate temporary matrix */
-
-    buff = (double *)G_malloc(bands * (bands + 1) * sizeof(double));
-    tmp = (double **)G_malloc(bands * sizeof(double *));
-    for (i = 0; i < bands; i++)
-	tmp[i] = &buff[i * (bands + 1)];
-
-    /* concatenate (vertically) z and d into tmp */
-
-    for (i = 0; i < bands; i++) {
-	for (j = 0; j < bands; j++)
-	    tmp[i][j + 1] = z[j + 1][i + 1];
-	tmp[i][0] = d[i + 1];
-    }
-
-    /* sort the combined matrix */
-
-    qsort(tmp, bands, sizeof(double *), egcmp);
-
-    /* split tmp into z and d */
-
-    for (i = 0; i < bands; i++) {
-	for (j = 0; j < bands; j++)
-	    z[j + 1][i + 1] = tmp[i][j + 1];
-	d[i + 1] = tmp[i][0];
-    }
-
-    /* free temporary matrix */
-
-    G_free(tmp);
-    G_free(buff);
-
-    return 0;
-}
-
-/***************************************************************************/
-
-int transpose(double eigmat[MX][MX], long bands)
-{
-    int i, j;
-
-    for (i = 1; i <= bands; i++)
-	for (j = 1; j < i; j++) {
-	    double tmp = eigmat[i][j];
-
-	    eigmat[i][j] = eigmat[j][i];
-	    eigmat[j][i] = tmp;
-	}
-
-    return 0;
-}
-
-/***************************************************************************/

lib/gmath/la.c

@@ -6,7 +6,8 @@
 
  * @Copyright David D.Gray <ddgray@armadce.demon.co.uk>
  * 26th. Sep. 2000
- * Last updated: 2006-11-23
+ * Last updated:
+ * 2006-11-23
 
  * This file is part of GRASS GIS. It is free software. You can 
  * redistribute it and/or modify it under the terms of 

lib/gmath/mult.c

@@ -1,7 +1,7 @@
 /* Author: Bill Hoff,2-114C,8645,3563478 (hoff) at uicsl */
 
 /*!
- * \fn int mult (double *v1[2], int size1, double *v2[2], int size2, double *v3[2], int size3)
+ * \fn int G_math_complex_mult (double *v1[2], int size1, double *v2[2], int size2, double *v3[2], int size3)
  *
  * \brief Multiply two complex vectors, point by point
  *
@@ -20,7 +20,7 @@
  */
 
 int
-mult(double *v1[2], int size1, double *v2[2], int size2, double *v3[2],
+G_math_complex_mult(double *v1[2], int size1, double *v2[2], int size2, double *v3[2],
      int size3)
 {
     int i, n;

lib/gmath/solvers_classic_iter.c

@@ -0,0 +1,281 @@
+
+/*****************************************************************************
+*
+* MODULE:       Grass PDE Numerical Library
+* AUTHOR(S):    Soeren Gebbert, Berlin (GER) Dec 2006
+* 		soerengebbert <at> gmx <dot> de
+*               
+* PURPOSE:      linear equation system solvers
+* 		part of the gpde library
+*               
+* COPYRIGHT:    (C) 2007 by the GRASS Development Team
+*
+*               This program is free software under the GNU General Public
+*               License (>=v2). Read the file COPYING that comes with GRASS
+*               for details.
+*
+*****************************************************************************/
+
+#include <math.h>
+#include <unistd.h>
+#include <stdio.h>
+#include <string.h>
+#include <grass/gis.h>
+#include <grass/glocale.h>
+#include <grass/gmath.h>
+
+
+/*!
+ * \brief The iterative jacobi solver for sparse matrices
+ *
+ * The Jacobi solver solves the linear equation system Ax = b
+ * The result is written to the vector x.
+ *
+ * The parameter <i>maxit</i> specifies the maximum number of iterations. If the maximum is reached, the
+ * solver will abort the calculation and writes the current result into the vector x.
+ * The parameter <i>err</i> defines the error break criteria for the solver.
+ *
+ * \param Asp G_math_spvector ** -- the sparse matrix
+ * \param x double * -- the vector of unknowns
+ * \param b double * -- the right side vector
+ * \param rows int -- number of rows
+ * \param maxit int -- the maximum number of iterations
+ * \param sor double -- defines the successive overrelaxion parameter [0:1]
+ * \param error double -- defines the error break criteria
+ * \return int -- 1=success, -1=could not solve the les
+ *
+ * */
+int G_math_solver_sparse_jacobi(G_math_spvector ** Asp, double *x, double *b,
+				int rows, int maxit, double sor, double error)
+{
+    int i, j, k, center, finished = 0;
+
+    double *Enew;
+
+    double E, err = 0;
+
+    Enew = G_alloc_vector(rows);
+
+    for (k = 0; k < maxit; k++) {
+	err = 0;
+	{
+	    if (k == 0) {
+		for (j = 0; j < rows; j++) {
+		    Enew[j] = x[j];
+		}
+	    }
+	    for (i = 0; i < rows; i++) {
+		E = 0;
+		center = 0;
+		for (j = 0; j < Asp[i]->cols; j++) {
+		    E += Asp[i]->values[j] * x[Asp[i]->index[j]];
+		    if (Asp[i]->index[j] == i)
+			center = j;
+		}
+		Enew[i] = x[i] - sor * (E - b[i]) / Asp[i]->values[center];
+	    }
+	    for (j = 0; j < rows; j++) {
+		err += (x[j] - Enew[j]) * (x[j] - Enew[j]);
+
+		x[j] = Enew[j];
+	    }
+	}
+
+	G_message(_("sparse Jacobi -- iteration %5i error %g\n"), k, err);
+
+	if (err < error) {
+	    finished = 1;
+	    break;
+	}
+    }
+
+    G_free(Enew);
+
+    return finished;
+}
+
+
+/*!
+ * \brief The iterative gauss seidel solver for sparse matrices
+ *
+ * The Jacobi solver solves the linear equation system Ax = b
+ * The result is written to the vector x.
+ *
+ * The parameter <i>maxit</i> specifies the maximum number of iterations. If the maximum is reached, the
+ * solver will abort the calculation and writes the current result into the vector x.
+ * The parameter <i>err</i> defines the error break criteria for the solver.
+ *
+ * \param Asp G_math_spvector ** -- the sparse matrix
+ * \param x double * -- the vector of unknowns
+ * \param b double * -- the right side vector
+ * \param rows int -- number of rows
+ * \param maxit int -- the maximum number of iterations
+ * \param sor double -- defines the successive overrelaxion parameter [0:2]
+ * \param error double -- defines the error break criteria
+ * \return int -- 1=success, -1=could not solve the les
+ *
+ * */
+int G_math_solver_sparse_gs(G_math_spvector ** Asp, double *x, double *b,
+			    int rows, int maxit, double sor, double error)
+{
+    int i, j, k, finished = 0;
+
+    double *Enew;
+
+    double E, err = 0;
+
+    int center;
+
+    Enew = G_alloc_vector(rows);
+
+    for (k = 0; k < maxit; k++) {
+	err = 0;
+	{
+	    if (k == 0) {
+		for (j = 0; j < rows; j++) {
+		    Enew[j] = x[j];
+		}
+	    }
+	    for (i = 0; i < rows; i++) {
+		E = 0;
+		center = 0;
+		for (j = 0; j < Asp[i]->cols; j++) {
+		    E += Asp[i]->values[j] * Enew[Asp[i]->index[j]];
+		    if (Asp[i]->index[j] == i)
+			center = j;
+		}
+		Enew[i] = x[i] - sor * (E - b[i]) / Asp[i]->values[center];
+	    }
+	    for (j = 0; j < rows; j++) {
+		err += (x[j] - Enew[j]) * (x[j] - Enew[j]);
+
+		x[j] = Enew[j];
+	    }
+	}
+
+	G_message(_("sparse SOR -- iteration %5i error %g\n"), k, err);
+
+	if (err < error) {
+	    finished = 1;
+	    break;
+	}
+    }
+
+    G_free(Enew);
+
+    return finished;
+}
+
+
+/*!
+ * \brief The iterative jacobi solver for quadratic matrices
+ *
+ * The Jacobi solver solves the linear equation system Ax = b
+ * The result is written to the vector x.
+ *
+ * The parameter <i>maxit</i> specifies the maximum number of iterations. If the maximum is reached, the
+ * solver will abort the calculation and writes the current result into the vector x.
+ * The parameter <i>err</i> defines the error break criteria for the solver.
+ *
+ * \param Asp G_math_spvector ** -- the sparse matrix
+ * \param x double * -- the vector of unknowns
+ * \param b double * -- the right side vector
+ * \param rows int -- number of rows
+ * \param maxit int -- the maximum number of iterations
+ * \param sor double -- defines the successive overrelaxion parameter [0:1]
+ * \param error double -- defines the error break criteria
+ * \return int -- 1=success, -1=could not solve the les
+ *
+ * */
+int G_math_solver_jacobi(double **A, double *x, double *b, int rows,
+			 int maxit, double sor, double error)
+{
+    int i, j, k;
+
+    double *Enew;
+
+    double E, err = 0;
+
+    Enew = G_alloc_vector(rows);
+
+    for (j = 0; j < rows; j++) {
+	Enew[j] = x[j];
+    }
+
+    for (k = 0; k < maxit; k++) {
+	for (i = 0; i < rows; i++) {
+	    E = 0;
+	    for (j = 0; j < rows; j++) {
+		E += A[i][j] * x[j];
+	    }
+	    Enew[i] = x[i] - sor * (E - b[i]) / A[i][i];
+	}
+	err = 0;
+	for (j = 0; j < rows; j++) {
+	    err += (x[j] - Enew[j]) * (x[j] - Enew[j]);
+	    x[j] = Enew[j];
+	}
+	G_message(_("Jacobi -- iteration %5i error %g\n"), k, err);
+	if (err < error)
+	    break;
+    }
+
+    return 1;
+}
+
+
+/*!
+ * \brief The iterative gauss seidel solver for quadratic matrices
+ *
+ * The Jacobi solver solves the linear equation system Ax = b
+ * The result is written to the vector x.
+ *
+ * The parameter <i>maxit</i> specifies the maximum number of iterations. If the maximum is reached, the
+ * solver will abort the calculation and writes the current result into the vector x.
+ * The parameter <i>err</i> defines the error break criteria for the solver.
+ *
+ * \param Asp G_math_spvector ** -- the sparse matrix
+ * \param x double * -- the vector of unknowns
+ * \param b double * -- the right side vector
+ * \param rows int -- number of rows
+ * \param maxit int -- the maximum number of iterations
+ * \param sor double -- defines the successive overrelaxion parameter [0:2]
+ * \param error double -- defines the error break criteria
+ * \return int -- 1=success, -1=could not solve the les
+ *
+ * */
+int G_math_solver_gs(double **A, double *x, double *b, int rows, int maxit,
+		     double sor, double error)
+{
+    int i, j, k;
+
+    double *Enew;
+
+    double E, err = 0;
+
+    Enew = G_alloc_vector(rows);
+
+    for (j = 0; j < rows; j++) {
+	Enew[j] = x[j];
+    }
+
+    for (k = 0; k < maxit; k++) {
+	for (i = 0; i < rows; i++) {
+	    E = 0;
+	    for (j = 0; j < rows; j++) {
+		E += A[i][j] * Enew[j];
+	    }
+	    Enew[i] = x[i] - sor * (E - b[i]) / A[i][i];
+	}
+	err = 0;
+	for (j = 0; j < rows; j++) {
+	    err += (x[j] - Enew[j]) * (x[j] - Enew[j]);
+	    x[j] = Enew[j];
+	}
+	G_message(_("SOR -- iteration %5i error %g\n"), k, err);
+	if (err < error)
+	    break;
+    }
+
+    return 1;
+}

lib/gmath/solvers_direct.c

@@ -0,0 +1,416 @@
+
+/*****************************************************************************
+ *
+ * MODULE:       Grass PDE Numerical Library
+ * AUTHOR(S):    Soeren Gebbert, Berlin (GER) Dec 2006
+ * 		soerengebbert <at> gmx <dot> de
+ *               
+ * PURPOSE:      direkt linear equation system solvers
+ * 		part of the gpde library
+ *               
+ * COPYRIGHT:    (C) 2007 by the GRASS Development Team
+ *
+ *               This program is free software under the GNU General Public
+ *               License (>=v2). Read the file COPYING that comes with GRASS
+ *               for details.
+ *
+ *****************************************************************************/
+
+#include <math.h>
+#include <unistd.h>
+#include <stdio.h>
+#include <string.h>
+#include "grass/gis.h"
+#include "grass/glocale.h"
+#include "grass/gmath.h"
+
+#define TINY 1.0e-20
+#define COMP_PIVOT 100
+
+/*!
+ * \brief The gauss elimination solver for quardatic matrices
+ *
+ * This solver does not support sparse matrices
+ * The matrix A will be overwritten.
+ * The result is written to the vector x 
+ *
+ * \param A double **
+ * \param x double *
+ * \param b double *
+ * \int rows int
+ * \return int -- 1 success
+ * */
+int G_math_solver_gauss(double **A, double *x, double *b, int rows)
+{
+    G_message(_("Starting direct gauss elimination solver"));
+
+    G_math_gauss_elimination(A, b, rows);
+    G_math_backward_solving(A, x, b, rows);
+
+    return 1;
+}
+
+/*!
+ * \brief The LU solver for quardatic matrices
+ *
+ * This solver does not support sparse matrices
+ * The matrix A will be overwritten.
+ * The result is written to the vector x in the G_math_les structure
+ *
+ *
+ * \param A double **
+ * \param x double *
+ * \param b double *
+ * \int rows int
+ * \return int -- 1 success
+ * */
+int G_math_solver_lu(double **A, double *x, double *b, int rows)
+{
+    int i;
+
+    double *c, *tmpv;
+
+    G_message(_("Starting direct lu decomposition solver"));
+
+    tmpv = G_alloc_vector(rows);
+    c = G_alloc_vector(rows);
+
+    G_math_lu_decomposition(A, b, rows);
+
+#pragma omp parallel
+    {
+
+#pragma omp for  schedule (static) private(i)
+	for (i = 0; i < rows; i++) {
+	    tmpv[i] = A[i][i];
+	    A[i][i] = 1;
+	}
+
+#pragma omp single
+	{
+	    G_math_forward_solving(A, b, b, rows);
+	}
+
+#pragma omp for  schedule (static) private(i)
+	for (i = 0; i < rows; i++) {
+	    A[i][i] = tmpv[i];
+	}
+
+#pragma omp single
+	{
+	    G_math_backward_solving(A, x, b, rows);
+	}
+    }
+
+    G_free(c);
+    G_free(tmpv);
+
+
+    return 1;
+}
+
+/*!
+ * \brief The choleksy decomposition solver for quardatic, symmetric
+ * positiv definite matrices
+ *
+ * This solver does not support sparse matrices
+ * The matrix A will be overwritten.
+ * The result is written to the vector x 
+ *
+ * \param A double **
+ * \param x double *
+ * \param b double *
+ * \int rows int
+ * \return int -- 1 success
+ * */
+int G_math_solver_cholesky(double **A, double *x, double *b, int bandwith,
+			   int rows)
+{
+
+    G_message(_("Starting cholesky decomposition solver"));
+
+    if (G_math_cholesky_decomposition(A, rows, bandwith) != 1) {
+	G_warning(_("Unable to solve the linear equation system"));
+	return -2;
+    }
+
+    G_math_forward_solving(A, b, b, rows);
+    G_math_backward_solving(A, x, b, rows);
+
+    return 1;
+}
+
+/*!
+ * \brief Gauss elimination
+ *
+ * To run this solver efficiently,
+ * no pivoting is supported.
+ * The matrix will be overwritten with the decomposite form
+ * \param A double **
+ * \param b double * 
+ * \param rows int
+ * \return void
+ *
+ * */
+void G_math_gauss_elimination(double **A, double *b, int rows)
+{
+    int i, j, k;
+
+    double tmpval = 0.0;
+
+    /*compute the pivot -- commented out, because its meaningless
+       to compute it only nth times. */
+    /*G_math_pivot_create(A, b, rows, 0); */
+
+    for (k = 0; k < rows - 1; k++) {
+#pragma omp parallel for schedule (static) private(i, j, tmpval) shared(k, A, b, rows)
+	for (i = k + 1; i < rows; i++) {
+	    tmpval = A[i][k] / A[k][k];
+	    b[i] = b[i] - tmpval * b[k];
+	    for (j = k + 1; j < rows; j++) {
+		A[i][j] = A[i][j] - tmpval * A[k][j];
+	    }
+	}
+    }
+
+    return;
+}
+
+/*!
+ * \brief lu decomposition
+ *
+ * To run this solver efficiently,
+ * no pivoting is supported.
+ * The matrix will be overwritten with the decomposite form
+ *
+ * \param A double **
+ * \param b double * -- this vector is needed if its part of the linear equation system, otherwise set it to NULL
+ * \param rows int
+ * \return void
+ *
+ * */
+void G_math_lu_decomposition(double **A, double *b, int rows)
+{
+
+    int i, j, k;
+
+    /*compute the pivot -- commented out, because its meaningless
+       to compute it only nth times. */
+    /*G_math_pivot_create(A, b, rows, 0); */
+
+    for (k = 0; k < rows - 1; k++) {
+#pragma omp parallel for schedule (static) private(i, j) shared(k, A, rows)
+	for (i = k + 1; i < rows; i++) {
+	    A[i][k] = A[i][k] / A[k][k];
+	    for (j = k + 1; j < rows; j++) {
+		A[i][j] = A[i][j] - A[i][k] * A[k][j];
+	    }
+	}
+    }
+
+    return;
+}
+
+/*!
+ * \brief cholesky decomposition for symmetric, positiv definite matrices
+ *        with bandwith optimization
+ *
+ * The provided matrix will be overwritten with the lower and 
+ * upper triangle matrix A = LL^T 
+ *
+ * \param A double **
+ * \param rows int
+ * \param bandwith int -- the bandwith of the matrix (0 > bandwith <= cols)
+ * \return void
+ *
+ * */
+int G_math_cholesky_decomposition(double **A, int rows, int bandwith)
+{
+
+    int i = 0, j = 0, k = 0;
+
+    double sum_1 = 0.0;
+
+    double sum_2 = 0.0;
+
+    int colsize;
+
+    if (bandwith <= 0)
+	bandwith = rows;
+
+    colsize = bandwith;
+
+    for (k = 0; k < rows; k++) {
+#pragma omp parallel for schedule (static) private(i, j, sum_2) shared(A, k) reduction(+:sum_1)
+	for (j = 0; j < k; j++) {
+	    sum_1 += A[k][j] * A[k][j];
+	}
+
+	if (0 > (A[k][k] - sum_1)) {
+	    G_warning("Matrix is not positive definite. break.");
+	    return -1;
+	}
+	A[k][k] = sqrt(A[k][k] - sum_1);
+	sum_1 = 0.0;
+
+	if ((k + bandwith) > rows) {
+	    colsize = rows;
+	}
+	else {
+	    colsize = k + bandwith;
+	}
+
+#pragma omp parallel for schedule (static) private(i, j, sum_2) shared(A, k, sum_1, colsize)
+
+	for (i = k + 1; i < colsize; i++) {
+	    sum_2 = 0.0;
+	    for (j = 0; j < k; j++) {
+		sum_2 += A[i][j] * A[k][j];
+	    }
+	    A[i][k] = (A[i][k] - sum_2) / A[k][k];
+	}
+
+    }
+    /*we need to copy the lower triangle matrix to the upper trianle */
+#pragma omp parallel for schedule (static) private(i, k) shared(A, rows)
+    for (k = 0; k < rows; k++) {
+	for (i = k + 1; i < rows; i++) {
+	    A[k][i] = A[i][k];
+	}
+    }
+
+
+    return 1;
+}
+
+/*!
+ * \brief backward solving
+ *
+ * \param A double **
+ * \param x double *
+ * \param b double *
+ * \param rows int
+ * \return void
+ *
+ * */
+void G_math_backward_solving(double **A, double *x, double *b, int rows)
+{
+    int i, j;
+
+    for (i = rows - 1; i >= 0; i--) {
+	for (j = i + 1; j < rows; j++) {
+	    b[i] = b[i] - A[i][j] * x[j];
+	}
+	x[i] = (b[i]) / A[i][i];
+    }
+
+    return;
+}
+
+/*!
+ * \brief forward solving
+ *
+ * \param A double **
+ * \param x double *
+ * \param b double *
+ * \param rows int
+ * \return void
+ *
+ * */
+void G_math_forward_solving(double **A, double *x, double *b, int rows)
+{
+    int i, j;
+
+    double tmpval = 0.0;
+
+    for (i = 0; i < rows; i++) {
+	tmpval = 0;
+	for (j = 0; j < i; j++) {
+	    tmpval += A[i][j] * x[j];
+	}
+	x[i] = (b[i] - tmpval) / A[i][i];
+    }
+
+    return;
+}
+
+
+/*!
+ * \brief Optimize the structure of the linear equation system with a common pivoting strategy
+ *
+ * Create a optimized linear equation system for
+ * direct solvers: gauss and lu decomposition.
+ *
+ * The rows are permuted based on the pivot elements.
+ *
+ * This algorithm will modify the provided linear equation system
+ * and should only be used with the gauss elimination and lu decomposition solver.
+ *
+ * \param A double ** - a quadratic matrix
+ * \param b double *  - the right hand  vector, if not available set it to NULL
+ * \param rows int 
+ * \param start int -- the row
+ * \return int - the number of swapped rows
+ *
+ *
+ * */
+int G_math_pivot_create(double **A, double *b, int rows, int start)
+{
+    int num = 0;		/*number of changed rows */
+
+    int i, j, k;
+
+    double max;
+
+    int number = 0;
+
+    double tmpval = 0.0, s = 0.0;
+
+    double *link = NULL;
+
+    link = G_alloc_vector(rows);
+
+    G_debug(2, "G_math_pivot_create: swap rows if needed");
+    for (i = start; i < rows; i++) {
+	s = 0.0;
+	for (k = i + 1; k < rows; k++) {
+	    s += fabs(A[i][k]);
+	}
+	max = fabs(A[i][i]) / s;
+	number = i;
+	for (j = i + 1; j < rows; j++) {
+	    s = 0.0;
+	    for (k = j; k < rows; k++) {
+		s += fabs(A[j][k]);
+	    }
+	    /*search for the pivot element */
+	    if (max < fabs(A[j][i]) / s) {
+		max = fabs(A[j][i] / s);
+		number = j;
+	    }
+	}
+	if (max == 0) {
+	    max = TINY;
+	    G_warning("Matrix is singular");
+	}
+	/*if an pivot element was found, swap the les entries */
+	if (number != i) {
+
+	    G_debug(4, "swap row %i with row %i", i, number);
+
+	    if (b != NULL) {
+		tmpval = b[number];
+		b[number] = b[i];
+		b[i] = tmpval;
+	    }
+	    G_math_d_copy(A[number], link, rows);
+	    G_math_d_copy(A[i], A[number], rows);
+	    G_math_d_copy(link, A[i], rows);
+	    num++;
+	}
+    }
+
+    G_free_vector(link);
+
+    return num;
+}

lib/gmath/solvers_krylov.c

@@ -0,0 +1,733 @@
+
+/*****************************************************************************
+*
+* MODULE:       Grass PDE Numerical Library
+* AUTHOR(S):    Soeren Gebbert, Berlin (GER) Dec 2006
+* 		soerengebbert <at> gmx <dot> de
+*               
+* PURPOSE:      linear equation system solvers
+* 		part of the gpde library
+*               
+* COPYRIGHT:    (C) 2000 by the GRASS Development Team
+*
+*               This program is free software under the GNU General Public
+*               License (>=v2). Read the file COPYING that comes with GRASS
+*               for details.
+*
+*****************************************************************************/
+
+#include <math.h>
+#include <unistd.h>
+#include <stdio.h>
+#include <string.h>
+#include <grass/gis.h>
+#include <grass/gmath.h>
+#include <grass/glocale.h>
+
+static G_math_spvector **create_diag_precond_matrix(double **A,
+						    G_math_spvector ** Asp,
+						    int rows, int prec);
+static int solver_pcg(double **A, G_math_spvector ** Asp, double *x,
+		      double *b, int rows, int maxit, double err, int prec);
+static int solver_cg(double **A, G_math_spvector ** Asp, double *x, double *b,
+		     int rows, int maxit, double err);
+static int solver_bicgstab(double **A, G_math_spvector ** Asp, double *x,
+			   double *b, int rows, int maxit, double err);
+
+
+/*!
+ * \brief The iterative preconditioned conjugate gradients solver for symmetric positive definite matrices
+ *
+ * This iterative solver works with symmetric positive definite  regular quadratic matrices.
+ *
+ * This solver solves the linear equation system:
+ *  A x = b
+ *
+ * The parameter <i>maxit</i> specifies the maximum number of iterations. If the maximum is reached, the
+ * solver will abort the calculation and writes the current result into the vector x.
+ * The parameter <i>err</i> defines the error break criteria for the solver.
+ *
+ * \param A (double **) -- the matrix
+ * \param x (double *) -- the value vector
+ * \param b (double *) -- the right hand side
+ * \param rows (int)
+ * \param maxit (int) -- the maximum number of iterations
+ * \param err (double) -- defines the error break criteria
+ * \param prec (int) -- the preconditioner which shoudl be used 1,2 or 3
+ * \return (int) -- 1 - success, 2 - not finisehd but success, 0 - matrix singular, -1 - could not solve the les
+ * 
+ * */
+int G_math_solver_pcg(double **A, double *x, double *b, int rows, int maxit,
+		      double err, int prec)
+{
+
+    return solver_pcg(A, NULL, x, b, rows, maxit, err, prec);
+}
+
+/*!
+ * \brief The iterative preconditioned conjugate gradients solver for sparse symmetric positive definite matrices
+ *
+ * This iterative solver works with symmetric positive definite sparse matrices.
+ *
+ * This solver solves the linear equation system:
+ *  A x = b
+ *
+ * The parameter <i>maxit</i> specifies the maximum number of iterations. If the maximum is reached, the
+ * solver will abort the calculation and writes the current result into the vector x.
+ * The parameter <i>err</i> defines the error break criteria for the solver.
+ *
+ * \param Asp (G_math_spvector **) -- the sparse matrix
+ * \param x (double *) -- the value vector
+ * \param b (double *) -- the right hand side
+ * \param rows (int)
+ * \param maxit (int) -- the maximum number of iterations
+ * \param err (double) -- defines the error break criteria
+ * \param prec (int) -- the preconditioner which shoudl be used 1,2 or 3
+ * \return (int) -- 1 - success, 2 - not finisehd but success, 0 - matrix singular, -1 - could not solve the les
+ * 
+ * */
+int G_math_solver_sparse_pcg(G_math_spvector ** Asp, double *x, double *b,
+			     int rows, int maxit, double err, int prec)
+{
+
+    return solver_pcg(NULL, Asp, x, b, rows, maxit, err, prec);
+}
+
+int solver_pcg(double **A, G_math_spvector ** Asp, double *x, double *b,
+	       int rows, int maxit, double err, int prec)
+{
+    double *r, *z;
+
+    double *p;
+
+    double *v;
+
+    double s = 0.0;
+
+    double a0 = 0, a1 = 0, mygamma, tmp = 0;
+
+    int m, i;
+
+    int finished = 2;
+
+    int error_break;
+
+    G_math_spvector **M;
+
+    r = G_alloc_vector(rows);
+    p = G_alloc_vector(rows);
+    v = G_alloc_vector(rows);
+    z = G_alloc_vector(rows);
+
+    error_break = 0;
+
+    /*compute the preconditioning matrix, this is a sparse matrix */
+    M = create_diag_precond_matrix(A, Asp, rows, prec);
+
+    /*
+     * residual calculation 
+     */
+#pragma omp parallel
+    {
+	if (Asp)
+	    G_math_Ax_sparse(Asp, x, v, rows);
+	else
+	    G_math_d_Ax(A, x, v, rows, rows);
+
+	G_math_d_ax_by(b, v, r, 1.0, -1.0, rows);
+	/*performe the preconditioning */
+	G_math_Ax_sparse(M, r, p, rows);
+
+	/* scalar product */
+#pragma omp for schedule (static) private(i) reduction(+:s)
+	for (i = 0; i < rows; i++) {
+	    s += p[i] * r[i];
+	}
+    }
+
+    a0 = s;
+    s = 0.0;
+
+    /* ******************* */
+    /* start the iteration */
+    /* ******************* */
+    for (m = 0; m < maxit; m++) {
+#pragma omp parallel default(shared)
+	{
+	    if (Asp)
+		G_math_Ax_sparse(Asp, p, v, rows);
+	    else
+		G_math_d_Ax(A, p, v, rows, rows);
+
+
+
+	    /* scalar product */
+#pragma omp for schedule (static) private(i) reduction(+:s)
+	    for (i = 0; i < rows; i++) {
+		s += v[i] * p[i];
+	    }
+
+	    /* barrier */
+#pragma omp single
+	    {
+		tmp = s;
+		mygamma = a0 / tmp;
+		s = 0.0;
+	    }
+
+	    G_math_d_ax_by(p, x, x, mygamma, 1.0, rows);
+
+	    if (m % 50 == 1) {
+		if (Asp)
+		    G_math_Ax_sparse(Asp, x, v, rows);
+		else
+		    G_math_d_Ax(A, x, v, rows, rows);
+
+		G_math_d_ax_by(b, v, r, 1.0, -1.0, rows);
+	    }
+	    else {
+		G_math_d_ax_by(r, v, r, 1.0, -1.0 * mygamma, rows);
+	    }
+
+	    /*performe the preconditioning */
+	    G_math_Ax_sparse(M, r, z, rows);
+
+
+	    /* scalar product */
+#pragma omp for schedule (static) private(i) reduction(+:s)
+	    for (i = 0; i < rows; i++) {
+		s += z[i] * r[i];
+	    }
+
+	    /* barrier */
+#pragma omp single
+	    {
+		a1 = s;
+		tmp = a1 / a0;
+		a0 = a1;
+		s = 0.0;
+
+		if (a1 < 0 || a1 == 0 || a1 > 0) {
+		    ;
+		}
+		else {
+		    G_warning(_
+			      ("Unable to solve the linear equation system"));
+		    error_break = 1;
+		}
+	    }
+	    G_math_d_ax_by(p, z, p, tmp, 1.0, rows);
+	}
+
+	if (Asp != NULL)
+	    G_message(_("Sparse PCG -- iteration %i error  %g\n"), m, a0);
+	else
+	    G_message(_("PCG -- iteration %i error  %g\n"), m, a0);
+
+	if (error_break == 1) {
+	    finished = -1;
+	    break;
+	}
+
+
+	if (a0 < err) {
+	    finished = 1;
+	    break;
+	}
+    }
+
+    G_free(r);
+    G_free(p);
+    G_free(v);
+    G_free(z);
+    G_math_free_spmatrix(M, rows);
+
+    return finished;
+}
+
+
+/*!
+ * \brief The iterative conjugate gradients solver for symmetric positive definite matrices
+ *
+ * This iterative solver works with symmetric positive definite  regular quadratic matrices.
+ *
+ * This solver solves the linear equation system:
+ *  A x = b
+ *
+ * The parameter <i>maxit</i> specifies the maximum number of iterations. If the maximum is reached, the
+ * solver will abort the calculation and writes the current result into the vector x.
+ * The parameter <i>err</i> defines the error break criteria for the solver.
+ *
+ * \param A (double **) -- the matrix
+ * \param x (double *) -- the value vector
+ * \param b (double *) -- the right hand side
+ * \param rows (int)
+ * \param maxit (int) -- the maximum number of iterations
+ * \param err (double) -- defines the error break criteria
+ * \return (int) -- 1 - success, 2 - not finisehd but success, 0 - matrix singular, -1 - could not solve the les
+ * 
+ * */
+int G_math_solver_cg(double **A, double *x, double *b, int rows, int maxit,
+		     double err)
+{
+    return solver_cg(A, NULL, x, b, rows, maxit, err);
+}
+
+/*!
+ * \brief The iterative conjugate gradients solver for sparse symmetric positive definite matrices
+ *
+ * This iterative solver works with symmetric positive definite sparse matrices.
+ *
+ * This solver solves the linear equation system:
+ *  A x = b
+ *
+ * The parameter <i>maxit</i> specifies the maximum number of iterations. If the maximum is reached, the
+ * solver will abort the calculation and writes the current result into the vector x.
+ * The parameter <i>err</i> defines the error break criteria for the solver.
+ *
+ * \param Asp (G_math_spvector **) -- the sparse matrix
+ * \param x (double *) -- the value vector
+ * \param b (double *) -- the right hand side
+ * \param rows (int)
+ * \param maxit (int) -- the maximum number of iterations
+ * \param err (double) -- defines the error break criterias
+ * \return (int) -- 1 - success, 2 - not finisehd but success, 0 - matrix singular, -1 - could not solve the les
+ * 
+ * */
+int G_math_solver_sparse_cg(G_math_spvector ** Asp, double *x, double *b,
+			    int rows, int maxit, double err)
+{
+    return solver_cg(NULL, Asp, x, b, rows, maxit, err);
+}
+
+
+int solver_cg(double **A, G_math_spvector ** Asp, double *x, double *b,
+	      int rows, int maxit, double err)
+{
+    double *r;
+
+    double *p;
+
+    double *v;
+
+    double s = 0.0;
+
+    double a0 = 0, a1 = 0, mygamma, tmp = 0;
+
+    int m, i;
+
+    int finished = 2;
+
+    int error_break;
+
+    r = G_alloc_vector(rows);
+    p = G_alloc_vector(rows);
+    v = G_alloc_vector(rows);
+
+    error_break = 0;
+    /*
+     * residual calculation 
+     */
+#pragma omp parallel
+    {
+	if (Asp)
+	    G_math_Ax_sparse(Asp, x, v, rows);
+	else
+	    G_math_d_Ax(A, x, v, rows, rows);
+
+	G_math_d_ax_by(b, v, r, 1.0, -1.0, rows);
+	G_math_d_copy(r, p, rows);
+
+	/* scalar product */
+#pragma omp for schedule (static) private(i) reduction(+:s)
+	for (i = 0; i < rows; i++) {
+	    s += r[i] * r[i];
+	}
+    }
+
+    a0 = s;
+    s = 0.0;
+
+    /* ******************* */
+    /* start the iteration */
+    /* ******************* */
+    for (m = 0; m < maxit; m++) {
+#pragma omp parallel default(shared)
+	{
+	    if (Asp)
+		G_math_Ax_sparse(Asp, p, v, rows);
+	    else
+		G_math_d_Ax(A, p, v, rows, rows);
+
+	    /* scalar product */
+#pragma omp for schedule (static) private(i) reduction(+:s)
+	    for (i = 0; i < rows; i++) {
+		s += v[i] * p[i];
+	    }
+
+	    /* barrier */
+#pragma omp single
+	    {
+		tmp = s;
+		mygamma = a0 / tmp;
+		s = 0.0;
+	    }
+
+	    G_math_d_ax_by(p, x, x, mygamma, 1.0, rows);
+
+	    if (m % 50 == 1) {
+		if (Asp)
+		    G_math_Ax_sparse(Asp, x, v, rows);
+		else
+		    G_math_d_Ax(A, x, v, rows, rows);
+
+		G_math_d_ax_by(b, v, r, 1.0, -1.0, rows);
+	    }
+	    else {
+		G_math_d_ax_by(r, v, r, 1.0, -1.0 * mygamma, rows);
+	    }
+
+	    /* scalar product */
+#pragma omp for schedule (static) private(i) reduction(+:s)
+	    for (i = 0; i < rows; i++) {
+		s += r[i] * r[i];
+	    }
+
+	    /* barrier */
+#pragma omp single
+	    {
+		a1 = s;
+		tmp = a1 / a0;
+		a0 = a1;
+		s = 0.0;
+
+		if (a1 < 0 || a1 == 0 || a1 > 0) {
+		    ;
+		}
+		else {
+		    G_warning(_
+			      ("Unable to solve the linear equation system"));
+		    error_break = 1;
+		}
+	    }
+	    G_math_d_ax_by(p, r, p, tmp, 1.0, rows);
+	}
+
+	if (Asp != NULL)
+	    G_message(_("Sparse CG -- iteration %i error  %g\n"), m, a0);
+	else
+	    G_message(_("CG -- iteration %i error  %g\n"), m, a0);
+
+	if (error_break == 1) {
+	    finished = -1;
+	    break;
+	}
+
+	if (a0 < err) {
+	    finished = 1;
+	    break;
+	}
+    }
+
+    G_free(r);
+    G_free(p);
+    G_free(v);
+
+    return finished;
+}
+
+
+
+/*!
+ * \brief The iterative biconjugate gradients solver with stabilization for unsymmetric non-definite matrices
+ *
+ * This iterative solver works with regular quadratic matrices.
+ *
+ * This solver solves the linear equation system:
+ *  A x = b
+ *
+ * The parameter <i>maxit</i> specifies the maximum number of iterations. If the maximum is reached, the
+ * solver will abort the calculation and writes the current result into the vector x.
+ * The parameter <i>err</i> defines the error break criteria for the solver.
+ *
+ * \param A (double **) -- the matrix
+ * \param x (double *) -- the value vector
+ * \param b (double *) -- the right hand side
+ * \param rows (int)
+ * \param maxit (int) -- the maximum number of iterations
+ * \param err (double) -- defines the error break criterias
+ * \return (int) -- 1 - success, 2 - not finisehd but success, 0 - matrix singular, -1 - could not solve the les
+ * 
+ * */
+int G_math_solver_bicgstab(double **A, double *x, double *b, int rows,
+			   int maxit, double err)
+{
+    return solver_bicgstab(A, NULL, x, b, rows, maxit, err);
+}
+
+/*!
+ * \brief The iterative biconjugate gradients solver with stabilization for unsymmetric non-definite matrices
+ *
+ * This iterative solver works with sparse matrices.
+ *
+ * This solver solves the linear equation system:
+ *  A x = b
+ *
+ * The parameter <i>maxit</i> specifies the maximum number of iterations. If the maximum is reached, the
+ * solver will abort the calculation and writes the current result into the vector x.
+ * The parameter <i>err</i> defines the error break criteria for the solver.
+ *
+ * \param Asp (G_math_spvector **) -- the sparse matrix
+ * \param x (double *) -- the value vector
+ * \param b (double *) -- the right hand side
+ * \param rows (int)
+ * \param maxit (int) -- the maximum number of iterations
+ * \param err (double) -- defines the error break criterias
+ * \return (int) -- 1 - success, 2 - not finisehd but success, 0 - matrix singular, -1 - could not solve the les
+ * 
+ * */
+int G_math_solver_sparse_bicgstab(G_math_spvector ** Asp, double *x,
+				  double *b, int rows, int maxit, double err)
+{
+    return solver_bicgstab(NULL, Asp, x, b, rows, maxit, err);
+}
+
+
+int solver_bicgstab(double **A, G_math_spvector ** Asp, double *x, double *b,
+		    int rows, int maxit, double err)
+{
+    double *r;
+
+    double *r0;
+
+    double *p;
+
+    double *v;
+
+    double *s;
+
+    double *t;
+
+    double s1 = 0.0, s2 = 0.0, s3 = 0.0;
+
+    double alpha = 0, beta = 0, omega, rr0 = 0, error;
+
+    int m, i;
+
+    int finished = 2;
+
+    int error_break;
+
+    r = G_alloc_vector(rows);
+    r0 = G_alloc_vector(rows);
+    p = G_alloc_vector(rows);
+    v = G_alloc_vector(rows);
+    s = G_alloc_vector(rows);
+    t = G_alloc_vector(rows);
+
+    error_break = 0;
+
+#pragma omp parallel
+    {
+	if (Asp)
+	    G_math_Ax_sparse(Asp, x, v, rows);
+	else
+	    G_math_d_Ax(A, x, v, rows, rows);
+
+	G_math_d_ax_by(b, v, r, 1.0, -1.0, rows);
+	G_math_d_copy(r, r0, rows);
+	G_math_d_copy(r, p, rows);
+    }
+
+    s1 = s2 = s3 = 0.0;
+
+    /* ******************* */
+    /* start the iteration */
+    /* ******************* */
+    for (m = 0; m < maxit; m++) {
+
+#pragma omp parallel default(shared)
+	{
+	    if (Asp)
+		G_math_Ax_sparse(Asp, p, v, rows);
+	    else
+		G_math_d_Ax(A, p, v, rows, rows);
+
+	    /* scalar product */
+#pragma omp for schedule (static) private(i) reduction(+:s1, s2, s3)
+	    for (i = 0; i < rows; i++) {
+		s1 += r[i] * r[i];
+		s2 += r[i] * r0[i];
+		s3 += v[i] * r0[i];
+	    }
+
+#pragma omp single
+	    {
+		error = s1;
+
+		if (error < 0 || error == 0 || error > 0) {
+		    ;
+		}
+		else {
+		    G_warning(_
+			      ("Unable to solve the linear equation system"));
+		    error_break = 1;
+		}
+
+		rr0 = s2;
+		alpha = rr0 / s3;
+		s1 = s2 = s3 = 0.0;
+	    }
+
+	    G_math_d_ax_by(r, v, s, 1.0, -1.0 * alpha, rows);
+	    if (Asp)
+		G_math_Ax_sparse(Asp, s, t, rows);
+	    else
+		G_math_d_Ax(A, s, t, rows, rows);
+
+	    /* scalar product */
+#pragma omp for schedule (static) private(i) reduction(+:s1, s2)
+	    for (i = 0; i < rows; i++) {
+		s1 += t[i] * s[i];
+		s2 += t[i] * t[i];
+	    }
+
+#pragma omp single
+	    {
+		omega = s1 / s2;
+		s1 = s2 = 0.0;
+	    }
+
+	    G_math_d_ax_by(p, s, r, alpha, omega, rows);
+	    G_math_d_ax_by(x, r, x, 1.0, 1.0, rows);
+	    G_math_d_ax_by(s, t, r, 1.0, -1.0 * omega, rows);
+
+#pragma omp for schedule (static) private(i) reduction(+:s1)
+	    for (i = 0; i < rows; i++) {
+		s1 += r[i] * r0[i];
+	    }
+
+#pragma omp single
+	    {
+		beta = alpha / omega * s1 / rr0;
+		s1 = s2 = s3 = 0.0;
+	    }
+
+	    G_math_d_ax_by(p, v, p, 1.0, -1.0 * omega, rows);
+	    G_math_d_ax_by(p, r, p, beta, 1.0, rows);
+	}
+
+
+	if (Asp != NULL)
+	    G_message(_("Sparse BiCGStab -- iteration %i error  %g\n"), m,
+		      error);
+	else
+	    G_message(_("BiCGStab -- iteration %i error  %g\n"), m, error);
+
+	if (error_break == 1) {
+	    finished = -1;
+	    break;
+	}
+
+	if (error < err) {
+	    finished = 1;
+	    break;
+	}
+    }
+
+    G_free(r);
+    G_free(r0);
+    G_free(p);
+    G_free(v);
+    G_free(s);
+    G_free(t);
+
+    return finished;
+}
+
+
+/*!
+ * \brief Compute a diagonal preconditioning matrix for krylov space solver
+ *
+ * \param A (double **) -- the matrix for which the precondition should be computed (if the sparse matrix is used, set it to NULL)
+ * \param Asp (G_math_spvector **) -- the matrix for which the precondition should be computed 
+ * \param rows (int)
+ * \param prec (int) -- which preconditioner should be used 1, 2 or 3
+ *
+ * */
+G_math_spvector **create_diag_precond_matrix(double **A,
+					     G_math_spvector ** Asp, int rows,
+					     int prec)
+{
+    G_math_spvector **Msp;
+
+    int i, j, cols = rows;
+
+    double sum;
+
+    Msp = G_math_alloc_spmatrix(rows);
+
+    if (A != NULL) {
+#pragma omp parallel for schedule (static) private(i, j, sum) shared(A, Msp, rows, cols, prec)
+	for (i = 0; i < rows; i++) {
+	    G_math_spvector *spvect = G_math_alloc_spvector(1);
+
+	    switch (prec) {
+	    case G_MATH_ROWSCALE_EUKLIDNORM_PRECONDITION:
+		sum = 0;
+		for (j = 0; j < cols; j++)
+		    sum += A[i][j] * A[i][j];
+		spvect->values[0] = 1.0 / sqrt(sum);
+		break;
+	    case G_MATH_ROWSCALE_ABSSUMNORM_PRECONDITION:
+		sum = 0;
+		for (j = 0; j < cols; j++)
+		    sum += fabs(A[i][j]);
+		spvect->values[0] = 1.0 / (sum);
+		break;
+	    case G_MATH_DIAGONAL_PRECONDITION:
+	    default:
+		spvect->values[0] = 1.0 / A[i][i];
+		break;
+	    }
+
+
+	    spvect->index[0] = i;
+	    spvect->cols = 1;;
+	    G_math_add_spvector(Msp, spvect, i);
+
+	}
+    }
+    else {
+#pragma omp parallel for schedule (static) private(i, j, sum) shared(Asp, Msp, rows, cols, prec)
+	for (i = 0; i < rows; i++) {
+	    G_math_spvector *spvect = G_math_alloc_spvector(1);
+
+	    switch (prec) {
+	    case G_MATH_ROWSCALE_EUKLIDNORM_PRECONDITION:
+		sum = 0;
+		for (j = 0; j < Asp[i]->cols; j++)
+		    sum += Asp[i]->values[j] * Asp[i]->values[j];
+		spvect->values[0] = 1.0 / sqrt(sum);
+		break;
+	    case G_MATH_ROWSCALE_ABSSUMNORM_PRECONDITION:
+		sum = 0;
+		for (j = 0; j < Asp[i]->cols; j++)
+		    sum += fabs(Asp[i]->values[j]);
+		spvect->values[0] = 1.0 / (sum);
+		break;
+	    case G_MATH_DIAGONAL_PRECONDITION:
+	    default:
+		for (j = 0; j < Asp[i]->cols; j++)
+		    if (i == Asp[i]->index[j])
+			spvect->values[0] = 1.0 / Asp[i]->values[j];
+		break;
+	    }
+
+	    spvect->index[0] = i;
+	    spvect->cols = 1;;
+	    G_math_add_spvector(Msp, spvect, i);
+	}
+    }
+    return Msp;
+}

lib/gmath/sparse_matrix.c

@@ -0,0 +1,240 @@
+
+/*****************************************************************************
+ *
+ * MODULE:       Grass Gmath Library
+ * AUTHOR(S):    Soeren Gebbert, Berlin (GER) Dec 2006
+ * 		soerengebbert <at> gmx <dot> de
+ *               
+ * PURPOSE:      functions to manage linear equation systems
+ * 		part of the gmath library
+ *               
+ * COPYRIGHT:    (C) 2000 by the GRASS Development Team
+ *
+ *               This program is free software under the GNU General Public
+ *               License (>=v2). Read the file COPYING that comes with GRASS
+ *               for details.
+ *
+ *****************************************************************************/
+
+#include <stdlib.h>
+#include <math.h>
+#include <grass/gmath.h>
+#include <grass/gis.h>
+
+/*!
+ * \brief Adds a sparse vector to a sparse matrix at position row
+ *
+ * Return 1 for success and -1 for failure
+ *
+ * \param spmatrix G_math_spvector ** 
+ * \param spvector G_math_spvector * 
+ * \param row int
+ * \return int 1 success, -1 failure
+ *
+ * */
+int G_math_add_spvector(G_math_spvector ** Asp, G_math_spvector * spvector,
+			int row)
+{
+    if (Asp != NULL) {
+	G_debug(5,
+		"Add sparse vector %p to the sparse linear equation system at row %i\n",
+		spvector, row);
+	Asp[row] = spvector;
+    }
+    else {
+	return -1;
+    }
+
+    return 1;
+}
+
+/*!
+ * \brief Allocate memory for a sparse matrix
+ *
+ * \param rows int
+ * \return G_math_spvector **
+ *
+ * */
+G_math_spvector **G_math_alloc_spmatrix(int rows)
+{
+    G_math_spvector **spmatrix;
+
+    G_debug(4, "Allocate memory for a sparse matrix with %i rows\n", rows);
+
+    spmatrix = (G_math_spvector **) G_calloc(rows, sizeof(G_math_spvector *));
+
+    return spmatrix;
+}
+
+/*!
+ * \brief Allocate memory for a sparse vector
+ *
+ * \param cols int
+ * \return G_math_spvector *
+ *
+ * */
+G_math_spvector *G_math_alloc_spvector(int cols)
+{
+    G_math_spvector *spvector;
+
+    G_debug(4, "Allocate memory for a sparse vector with %i cols\n", cols);
+
+    spvector = (G_math_spvector *) G_calloc(1, sizeof(G_math_spvector));
+
+    spvector->cols = cols;
+    spvector->index = (unsigned int *)G_calloc(cols, sizeof(unsigned int));
+    spvector->values = (double *)G_calloc(cols, sizeof(double));
+
+    return spvector;
+}
+
+/*!
+ * \brief Release the memory of the sparse vector
+ *
+ * \param spvector G_math_spvector *
+ * \return void
+ *
+ * */
+void G_math_free_spvector(G_math_spvector * spvector)
+{
+    if (spvector) {
+	if (spvector->values)
+	    G_free(spvector->values);
+	if (spvector->index)
+	    G_free(spvector->index);
+	G_free(spvector);
+
+	spvector = NULL;
+    }
+
+    return;
+}
+
+/*!
+ * \brief Release the memory of the sparse matrix
+ *
+ * \param spvector G_math_spvector **
+ * \param rows int
+ * \return void
+ *
+ * */
+void G_math_free_spmatrix(G_math_spvector ** spmatrix, int rows)
+{
+    int i;
+
+    if (spmatrix) {
+	for (i = 0; i < rows; i++)
+	    G_math_free_spvector(spmatrix[i]);
+
+	G_free(spmatrix);
+	spmatrix = NULL;
+    }
+
+    return;
+}
+
+/*!
+ *
+ * \brief print the sparse matrix Asp to stdout
+ *
+ *
+ * \param Asp (G_math_spvector **)
+ * \param rows (int)
+ * \return void
+ *  
+ * */
+void G_math_print_spmatrix(G_math_spvector ** Asp, int rows)
+{
+    int i, j, k, out;
+
+    for (i = 0; i < rows; i++) {
+	for (j = 0; j < rows; j++) {
+	    out = 0;
+	    for (k = 0; k < Asp[i]->cols; k++) {
+		if (Asp[i]->index[k] == j) {
+		    fprintf(stdout, "%4.5f ", Asp[i]->values[k]);
+		    out = 1;
+		}
+	    }
+	    if (!out)
+		fprintf(stdout, "%4.5f ", 0.0);
+	}
+	fprintf(stdout, "\n");
+    }
+
+    return;
+}
+
+
+/*!
+ * \brief Convert a sparse matrix into a quadratic matrix
+ *
+ * This function is multi-threaded with OpenMP. It creates its own parallel OpenMP region.
+ *
+ * \param Asp (G_math_spvector **) 
+ * \param rows (int)
+ * \return (double **)
+ *
+ * */
+double **G_math_Asp_to_A(G_math_spvector ** Asp, int rows)
+{
+    int i, j;
+
+    double **A = NULL;
+
+    A = G_alloc_matrix(rows, rows);
+
+#pragma omp parallel for schedule (static) private(i, j)
+    for (i = 0; i < rows; i++) {
+	for (j = 0; j < Asp[i]->cols; j++) {
+	    A[i][Asp[i]->index[j]] = Asp[i]->values[j];
+	}
+    }
+    return A;
+}
+
+/*!
+ * \brief Convert a quadratic matrix into a sparse matrix
+ *
+ * This function is multi-threaded with OpenMP. It creates its own parallel OpenMP region.
+ *
+ * \param A (double **) 
+ * \param rows (int)
+ * \param epsilon (double) -- non-zero values are greater then epsilon
+ * \return (G_math_spvector **)
+ *
+ * */
+G_math_spvector **G_math_A_to_Asp(double **A, int rows, double epsilon)
+{
+    int i, j;
+
+    int nonull, count = 0;
+
+    G_math_spvector **Asp = NULL;
+
+    Asp = G_math_alloc_spmatrix(rows);
+
+#pragma omp parallel for schedule (static) private(i, j, nonull, count)
+    for (i = 0; i < rows; i++) {
+	nonull = 0;
+	/*Count the number of non zero entries */
+	for (j = 0; j < rows; j++) {
+	    if (A[i][j] > epsilon)
+		nonull++;
+	}
+	/*Allocate the sparse vector and insert values */
+	G_math_spvector *v = G_math_alloc_spvector(nonull);
+
+	count = 0;
+	for (j = 0; j < rows; j++) {
+	    if (A[i][j] > epsilon) {
+		v->index[count] = j;
+		v->values[count] = A[i][j];
+		count++;
+	    }
+	}
+	/*Add vector to sparse matrix */
+	G_math_add_spvector(Asp, v, i);
+    }
+    return Asp;
+}

lib/gmath/svd.c

@@ -1,283 +0,0 @@
-#include <math.h>
-#include <grass/gis.h>
-#include <grass/gmath.h>
-
-static double at, bt, ct;
-
-#define PYTHAG(a,b) ((at=fabs(a)) > (bt=fabs(b)) ? \
-    (ct=bt/at,at*sqrt(1.0+ct*ct)) : (bt ? (ct=at/bt,bt*sqrt(1.0+ct*ct)): 0.0))
-
-static double maxarg1, maxarg2;
-
-#define MAX(a,b) (maxarg1=(a),maxarg2=(b),(maxarg1) > (maxarg2) ?\
-	(maxarg1) : (maxarg2))
-#define SIGN(a,b) ((b) >= 0.0 ? fabs(a) : -fabs(a))
-
-int G_svdcmp(double **a, int m, int n, double *w, double **v)
-{
-    int flag, i, its, j, jj, k, ii = 0, nm = 0;
-    double c, f, h, s, x, y, z;
-    double anorm = 0.0, g = 0.0, scale = 0.0;
-    double *rv1, *G_alloc_vector();
-
-
-    if (m < n)
-	return -1;		/* must augment A with extra zero rows */
-    rv1 = G_alloc_vector(n);
-
-    n--;
-    m--;
-
-    for (i = 0; i <= n; i++) {
-	ii = i + 1;
-	rv1[i] = scale * g;
-	g = s = scale = 0.0;
-	if (i <= m) {
-	    for (k = i; k <= m; k++)
-		scale += fabs(a[k][i]);
-	    if (scale) {
-		for (k = i; k <= m; k++) {
-		    a[k][i] /= scale;
-		    s += a[k][i] * a[k][i];
-		}
-		f = a[i][i];
-		g = -SIGN(sqrt(s), f);
-		h = f * g - s;
-		a[i][i] = f - g;
-		if (i != n) {
-		    for (j = ii; j <= n; j++) {
-			for (s = 0.0, k = i; k <= m; k++)
-			    s += a[k][i] * a[k][j];
-			f = s / h;
-			for (k = i; k <= m; k++)
-			    a[k][j] += f * a[k][i];
-		    }
-		}
-		for (k = i; k <= m; k++)
-		    a[k][i] *= scale;
-	    }
-	}
-	w[i] = scale * g;
-	g = s = scale = 0.0;
-	if (i <= m && i != n) {
-	    for (k = ii; k <= n; k++)
-		scale += fabs(a[i][k]);
-	    if (scale) {
-		for (k = ii; k <= n; k++) {
-		    a[i][k] /= scale;
-		    s += a[i][k] * a[i][k];
-		}
-		f = a[i][ii];
-		g = -SIGN(sqrt(s), f);
-		h = f * g - s;
-		a[i][ii] = f - g;
-		for (k = ii; k <= n; k++)
-		    rv1[k] = a[i][k] / h;
-		if (i != m) {
-		    for (j = ii; j <= m; j++) {
-			for (s = 0.0, k = ii; k <= n; k++)
-			    s += a[j][k] * a[i][k];
-			for (k = ii; k <= n; k++)
-			    a[j][k] += s * rv1[k];
-		    }
-		}
-		for (k = ii; k <= n; k++)
-		    a[i][k] *= scale;
-	    }
-	}
-	anorm = MAX(anorm, (fabs(w[i]) + fabs(rv1[i])));
-    }
-    for (i = n; i >= 0; i--) {
-	if (i < n) {
-	    if (g) {
-		for (j = ii; j <= n; j++)
-		    v[j][i] = (a[i][j] / a[i][ii]) / g;
-		for (j = ii; j <= n; j++) {
-		    for (s = 0.0, k = ii; k <= n; k++)
-			s += a[i][k] * v[k][j];
-		    for (k = ii; k <= n; k++)
-			v[k][j] += s * v[k][i];
-		}
-	    }
-	    for (j = ii; j <= n; j++)
-		v[i][j] = v[j][i] = 0.0;
-	}
-	v[i][i] = 1.0;
-	g = rv1[i];
-	ii = i;
-    }
-    for (i = n; i >= 0; i--) {
-	ii = i + 1;
-	g = w[i];
-	if (i < n)
-	    for (j = ii; j <= n; j++)
-		a[i][j] = 0.0;
-	if (g) {
-	    g = 1.0 / g;
-	    if (i != n) {
-		for (j = ii; j <= n; j++) {
-		    for (s = 0.0, k = ii; k <= m; k++)
-			s += a[k][i] * a[k][j];
-		    f = (s / a[i][i]) * g;
-		    for (k = i; k <= m; k++)
-			a[k][j] += f * a[k][i];
-		}
-	    }
-	    for (j = i; j <= m; j++)
-		a[j][i] *= g;
-	}
-	else {
-	    for (j = i; j <= m; j++)
-		a[j][i] = 0.0;
-	}
-	++a[i][i];
-    }
-    for (k = n; k >= 0; k--) {
-	for (its = 1; its <= 30; its++) {
-	    flag = 1;
-	    for (ii = k; ii >= 0; ii--) {
-		nm = ii - 1;
-		if (fabs(rv1[ii]) + anorm == anorm) {
-		    flag = 0;
-		    break;
-		}
-		if (fabs(w[nm]) + anorm == anorm)
-		    break;
-	    }
-	    if (flag) {
-		c = 0.0;
-		s = 1.0;
-		for (i = ii; i <= k; i++) {
-		    f = s * rv1[i];
-		    if (fabs(f) + anorm != anorm) {
-			g = w[i];
-			h = PYTHAG(f, g);
-			w[i] = h;
-			h = 1.0 / h;
-			c = g * h;
-			s = (-f * h);
-			for (j = 0; j <= m; j++) {
-			    y = a[j][nm];
-			    z = a[j][i];
-			    a[j][nm] = y * c + z * s;
-			    a[j][i] = z * c - y * s;
-			}
-		    }
-		}
-	    }
-	    z = w[k];
-	    if (ii == k) {
-		if (z < 0.0) {
-		    w[k] = -z;
-		    for (j = 0; j <= n; j++)
-			v[j][k] = (-v[j][k]);
-		}
-		break;
-	    }
-	    if (its == 30)
-		return -2;	/*No convergence in 30 SVDCMP iterations */
-	    x = w[ii];
-	    nm = k - 1;
-	    y = w[nm];
-	    g = rv1[nm];
-	    h = rv1[k];
-	    f = ((y - z) * (y + z) + (g - h) * (g + h)) / (2.0 * h * y);
-	    g = PYTHAG(f, 1.0);
-	    f = ((x - z) * (x + z) + h * ((y / (f + SIGN(g, f))) - h)) / x;
-	    c = s = 1.0;
-	    for (j = ii; j <= nm; j++) {
-		i = j + 1;
-		g = rv1[i];
-		y = w[i];
-		h = s * g;
-		g = c * g;
-		z = PYTHAG(f, h);
-		rv1[j] = z;
-		c = f / z;
-		s = h / z;
-		f = x * c + g * s;
-		g = g * c - x * s;
-		h = y * s;
-		y = y * c;
-		for (jj = 0; jj <= n; jj++) {
-		    x = v[jj][j];
-		    z = v[jj][i];
-		    v[jj][j] = x * c + z * s;
-		    v[jj][i] = z * c - x * s;
-		}
-		z = PYTHAG(f, h);
-		w[j] = z;
-		if (z) {
-		    z = 1.0 / z;
-		    c = f * z;
-		    s = h * z;
-		}
-		f = (c * g) + (s * y);
-		x = (c * y) - (s * g);
-		for (jj = 0; jj <= m; jj++) {
-		    y = a[jj][j];
-		    z = a[jj][i];
-		    a[jj][j] = y * c + z * s;
-		    a[jj][i] = z * c - y * s;
-		}
-	    }
-	    rv1[ii] = 0.0;
-	    rv1[k] = f;
-	    w[k] = x;
-	}
-    }
-    G_free_vector(rv1);
-    return 0;
-}
-
-#undef SIGN
-#undef MAX
-#undef PYTHAG
-
-int G_svbksb(double **u, double w[], double **v,
-	     int m, int n, double b[], double x[])
-{
-    int j, i;
-    double s, *tmp, *G_alloc_vector();
-
-    tmp = G_alloc_vector(n);
-    for (j = 0; j < n; j++) {
-	s = 0.0;
-	if (w[j]) {
-	    for (i = 0; i < m; i++)
-		s += u[i][j] * b[i];
-	    s /= w[j];
-	}
-	tmp[j] = s;
-    }
-    for (j = 0; j < n; j++) {
-	s = 0.0;
-	for (i = 0; i < n; i++)
-	    s += v[j][i] * tmp[i];
-	x[j] = s;
-    }
-    G_free_vector(tmp);
-
-    return 0;
-}
-
-#define TOL 1e-8
-
-int G_svelim(double *w, int n)
-{
-    int i;
-    double thresh;
-
-    thresh = 0.0;		/* remove singularity */
-    for (i = 0; i < n; i++)
-	if (w[i] > thresh)
-	    thresh = w[i];
-    thresh *= TOL;
-    for (i = 0; i < n; i++)
-	if (w[i] < thresh)
-	    w[i] = 0.0;
-
-    return 0;
-}
-
-#undef TOL

lib/gmath/test/Makefile

@@ -0,0 +1,9 @@
+MODULE_TOPDIR = ../../..
+
+PGM=test.gmath.lib
+
+LIBES = $(GISLIB) $(GMATHLIB) 
+DEPENDENCIES = $(GISDEP) $(GMATHDEP)
+include $(MODULE_TOPDIR)/include/Make/Module.make
+
+default: cmd

lib/gmath/test/bench_blas2.c

@@ -0,0 +1,111 @@
+
+/*****************************************************************************
+*
+* MODULE:       Grass PDE Numerical Library
+* AUTHOR(S):    Soeren Gebbert, Berlin (GER) Dec 2006
+* 		soerengebbert <at> gmx <dot> de
+*               
+* PURPOSE:      Unit benchs for les creation
+*
+* COPYRIGHT:    (C) 2000 by the GRASS Development Team
+*
+*               This program is free software under the GNU General Public
+*               License (>=v2). Read the file COPYING that comes with GRASS
+*               for details.
+*
+*****************************************************************************/
+
+#include <grass/gis.h>
+#include <grass/glocale.h>
+#include <grass/gmath.h>
+#include <math.h>
+#include "test_gmath_lib.h"
+#include <sys/time.h>
+#define EPSILON 0.0000001
+
+/* prototypes */
+static void bench_blas_level_2_double(int rows);
+
+
+/* *************************************************************** */
+/* Perfrome the blas level 2 unit benchs ************************** */
+/* *************************************************************** */
+int bench_blas_level_2(int rows)
+{
+    G_message(_("\n++ Running blas level 2 benchmark ++"));
+
+    bench_blas_level_2_double(rows);
+
+    return 1;
+}
+
+/* *************************************************************** */
+/* ************** D O U B L E ************************************ */
+/* *************************************************************** */
+void bench_blas_level_2_double(int rows)
+{
+
+    double **A, *x, *y, *z;
+    struct timeval tstart;
+    struct timeval tend;
+
+    G_math_les *les;
+    les = create_normal_unsymmetric_les(rows);
+    G_math_les *sples;
+    sples = create_sparse_unsymmetric_les(rows);
+
+    x = G_alloc_vector(rows);
+    y = G_alloc_vector(rows);
+    z = G_alloc_vector(rows);
+
+    A = G_alloc_matrix(rows, rows);
+
+    fill_d_vector_range_1(x, 1, rows);
+
+    gettimeofday(&tstart, NULL);
+#pragma omp parallel default(shared)
+{
+    G_math_Ax_sparse(sples->Asp, x, z, rows);
+}
+    gettimeofday(&tend, NULL);
+    G_important_message("Computation time G_math_Ax_sparse: %g\n", compute_time_difference(tstart, tend));
+    gettimeofday(&tstart, NULL);
+#pragma omp parallel default(shared)
+{
+    G_math_d_Ax(les->A, x, z, rows, rows);
+}
+    gettimeofday(&tend, NULL);
+    G_important_message("Computation time G_math_d_Ax: %g\n", compute_time_difference(tstart, tend));
+    gettimeofday(&tstart, NULL);
+#pragma omp parallel default(shared)
+{
+    G_math_d_aAx_by(les->A, x, y, 3.0, 4.0, z, rows, rows);
+}
+    gettimeofday(&tend, NULL);
+    G_important_message("Computation time G_math_d_Ax_by: %g\n", compute_time_difference(tstart, tend));
+    gettimeofday(&tstart, NULL);
+#pragma omp parallel default(shared)
+{
+    G_math_d_x_dyad_y(x, x, A, rows, rows);
+}
+    gettimeofday(&tend, NULL);
+    G_important_message("Computation time G_math_d_x_dyad: %g\n", compute_time_difference(tstart, tend));
+    gettimeofday(&tstart, NULL);
+
+
+    if(x)
+      G_free_vector(x);
+    if(y)
+      G_free_vector(y);
+    if(z)
+    G_free_vector(z);
+
+    G_math_free_les(les);
+    G_math_free_les(sples);
+
+    if(A)
+      G_free_matrix(A);
+
+    return;
+}
+

lib/gmath/test/bench_blas3.c

@@ -0,0 +1,93 @@
+
+/*****************************************************************************
+*
+* MODULE:       Grass PDE Numerical Library
+* AUTHOR(S):    Soeren Gebbert, Berlin (GER) Dec 2007
+* 		soerengebbert <at> gmx <dot> de
+*               
+* PURPOSE:      Unit benchs for les creation
+*
+* COPYRIGHT:    (C) 2007 by the GRASS Development Team
+*
+*               This program is free software under the GNU General Public
+*               License (>=v2). Read the file COPYING that comes with GRASS
+*               for details.
+*
+*****************************************************************************/
+
+#include <grass/gis.h>
+#include <grass/glocale.h>
+#include <grass/gmath.h>
+#include <math.h>
+#include "test_gmath_lib.h"
+#include <sys/time.h>
+
+/* prototypes */
+static void bench_blas_level_3_double(int rows);
+
+
+/* *************************************************************** */
+/* Perfrome the blas level 3 benchs ****************************** */
+/* *************************************************************** */
+int bench_blas_level_3(int rows)
+{
+    G_message(_("\n++ Running blas level 3 benchmark ++"));
+
+    bench_blas_level_3_double(rows);
+
+    return 1;
+}
+
+/* *************************************************************** */
+/* ************** D O U B L E ************************************ */
+/* *************************************************************** */
+void bench_blas_level_3_double(int rows)
+{
+    struct timeval tstart;
+    struct timeval tend;
+    double **A, **B, **C, *x, *y;
+
+    x = G_alloc_vector(rows);
+    y = G_alloc_vector(rows);
+
+    A = G_alloc_matrix(rows, rows);
+    B = G_alloc_matrix(rows, rows);
+    C = G_alloc_matrix(rows, rows);
+
+    fill_d_vector_range_1(x, 1, rows);
+    fill_d_vector_range_1(y, 1, rows);
+
+    fill_d_vector_range_1(A[0], 1, rows*rows);
+    fill_d_vector_range_1(B[0], 1, rows*rows);
+
+
+    gettimeofday(&tstart, NULL);
+#pragma omp parallel default(shared)
+{
+    G_math_d_aA_B(A, B, 4.0 , C, rows , rows);
+}
+    gettimeofday(&tend, NULL);
+    G_important_message("Computation time G_math_d_aA_B: %g\n", compute_time_difference(tstart, tend));
+    gettimeofday(&tstart, NULL);
+#pragma omp parallel default(shared)
+{
+    G_math_d_AB(A, B, C, rows , rows , rows);
+}
+    gettimeofday(&tend, NULL);
+    G_important_message("Computation time G_math_d_AB: %g\n", compute_time_difference(tstart, tend));
+
+
+    if(x)
+      G_free_vector(x);
+    if(y)
+      G_free_vector(y);
+
+    if(A)
+      G_free_matrix(A);
+    if(B)
+      G_free_matrix(B);
+    if(C)
+      G_free_matrix(C);
+
+    return;
+}

lib/gmath/test/bench_solver_direct.c

@@ -0,0 +1,99 @@
+/*****************************************************************************
+ *
+ * MODULE:       Grass PDE Numerical Library
+ * AUTHOR(S):    Soeren Gebbert, Berlin (GER) Dec 2006
+ * 		soerengebbert <at> gmx <dot> de
+ *               
+ * PURPOSE:      benchmarking the direct solvers
+ *
+ * COPYRIGHT:    (C) 2000 by the GRASS Development Team
+ *
+ *               This program is free software under the GNU General Public
+ *               License (>=v2). Read the file COPYING that comes with GRASS
+ *               for details.
+ *
+ *****************************************************************************/
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <grass/glocale.h>
+#include <grass/gmath.h>
+#include "test_gmath_lib.h"
+#include <sys/time.h>
+
+/* prototypes */
+static int bench_solvers(int rows);
+
+
+/* ************************************************************************* */
+/* Performe the solver unit tests ****************************************** */
+
+/* ************************************************************************* */
+int bench_solvers_direct(int rows) {
+    G_message(_("\n++ Running direct solver benchmark ++"));
+
+    bench_solvers(rows);
+
+    return 1;
+}
+
+
+/* *************************************************************** */
+/* Test all implemented solvers for sparse and normal matrix *** */
+
+/* *************************************************************** */
+int bench_solvers(int rows) {
+    G_math_les *les;
+    struct timeval tstart;
+    struct timeval tend;
+
+    G_message("\t * benchmarking gmath lu decomposition solver with unsymmetric matrix\n");
+
+    les = create_normal_unsymmetric_les(rows);
+    gettimeofday(&tstart, NULL);
+    G_math_solver_lu(les->A, les->x, les->b, les->rows);
+    gettimeofday(&tend, NULL);
+    G_important_message("Computation time gmath lu decomposition: %g\n", compute_time_difference(tstart, tend));
+    G_math_free_les(les);
+
+    G_message("\t * benchmarking lu ccmath decomposition solver with unsymmetric matrix\n");
+
+    les = create_normal_unsymmetric_les(rows);
+    gettimeofday(&tstart, NULL);
+    G_math_solv(les->A, les->b, les->rows);
+    gettimeofday(&tend, NULL);
+    G_important_message("Computation time ccmath lu decomposition: %g\n", compute_time_difference(tstart, tend));
+    G_math_free_les(les);
+
+
+    G_message("\t * benchmarking gauss elimination solver with unsymmetric matrix\n");
+
+    les = create_normal_unsymmetric_les(rows);
+    gettimeofday(&tstart, NULL);
+    G_math_solver_gauss(les->A, les->x, les->b, les->rows);
+    gettimeofday(&tend, NULL);
+    G_important_message("Computation time gauss elimination: %g\n", compute_time_difference(tstart, tend));
+    G_math_free_les(les);
+
+    G_message("\t * benchmarking gmath cholesky decomposition solver with symmetric matrix\n");
+
+    les = create_normal_symmetric_les(rows);
+    gettimeofday(&tstart, NULL);
+    G_math_solver_cholesky(les->A, les->x, les->b, les->rows, les->rows);
+    gettimeofday(&tend, NULL);
+    G_important_message("Computation time gmath cholesky decomposition: %g\n", compute_time_difference(tstart, tend));
+    G_math_free_les(les);
+
+    G_message("\t * benchmarking ccmath cholesky decomposition solver with symmetric matrix\n");
+
+    les = create_normal_symmetric_les(rows);
+    gettimeofday(&tstart, NULL);
+    G_math_solvps(les->A, les->b, les->rows);
+    gettimeofday(&tend, NULL);
+    G_important_message("Computation time ccmath cholesky decomposition: %g\n", compute_time_difference(tstart, tend));
+    G_math_free_les(les);
+
+    return 1;
+}
+

lib/gmath/test/bench_solver_krylov.c

@@ -0,0 +1,111 @@
+/*****************************************************************************
+ *
+ * MODULE:       Grass PDE Numerical Library
+ * AUTHOR(S):    Soeren Gebbert, Berlin (GER) Dec 2006
+ * 		soerengebbert <at> gmx <dot> de
+ *               
+ * PURPOSE:      benchmarking the krylov subspace solvers
+ *
+ * COPYRIGHT:    (C) 2000 by the GRASS Development Team
+ *
+ *               This program is free software under the GNU General Public
+ *               License (>=v2). Read the file COPYING that comes with GRASS
+ *               for details.
+ *
+ *****************************************************************************/
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <grass/glocale.h>
+#include <grass/gmath.h>
+#include "test_gmath_lib.h"
+#include <sys/time.h>
+
+/* prototypes */
+static int bench_solvers(int rows);
+
+
+/* ************************************************************************* */
+/* Performe the solver unit tests ****************************************** */
+
+/* ************************************************************************* */
+int bench_solvers_krylov(int rows) {
+    G_message(_("\n++ Running krylov solver benchmark ++"));
+
+    bench_solvers(rows);
+
+    return 1;
+}
+
+
+/* *************************************************************** */
+/* Test all implemented solvers for sparse and normal matrix *** */
+
+/* *************************************************************** */
+int bench_solvers(int rows) {
+    G_math_les *les;
+    G_math_les *sples;
+    struct timeval tstart;
+    struct timeval tend;
+
+    G_message("\t * benchmarking pcg solver with symmetric matrix and preconditioner 1\n");
+
+    les = create_normal_symmetric_les(rows);
+    sples = create_sparse_symmetric_les(rows);
+
+    gettimeofday(&tstart, NULL);
+    G_math_solver_pcg(les->A, les->x, les->b, les->rows, 250, 0.1e-9, 1);
+    gettimeofday(&tend, NULL);
+    G_important_message("Computation time pcg normal matrix: %g\n", compute_time_difference(tstart, tend));
+
+    gettimeofday(&tstart, NULL);
+    G_math_solver_sparse_pcg(sples->Asp, sples->x, sples->b, les->rows, 250,
+            0.1e-9, 1);
+    gettimeofday(&tend, NULL);
+    G_important_message("Computation time pcg sparse matrix: %g\n", compute_time_difference(tstart, tend));
+
+    G_math_free_les(les);
+    G_math_free_les(sples);
+
+    G_message("\t * benchmark cg solver with symmetric matrix\n");
+
+    les = create_normal_symmetric_les(rows);
+    sples = create_sparse_symmetric_les(rows);
+    
+    gettimeofday(&tstart, NULL);
+    G_math_solver_cg(les->A, les->x, les->b, les->rows, 250, 0.1e-9);
+    gettimeofday(&tend, NULL);
+    G_important_message("Computation time cg normal matrix: %g\n", compute_time_difference(tstart, tend));
+    
+    gettimeofday(&tstart, NULL);
+    G_math_solver_sparse_cg(sples->Asp, sples->x, sples->b, les->rows, 250,
+            0.1e-9);
+    gettimeofday(&tend, NULL);
+    G_important_message("Computation time cg sparse matrix: %g\n", compute_time_difference(tstart, tend));
+    
+    G_math_free_les(les);
+    G_math_free_les(sples);
+
+    G_message("\t * benchmark bicgstab solver with unsymmetric matrix\n");
+
+    les = create_normal_unsymmetric_les(rows);
+    sples = create_sparse_unsymmetric_les(rows);
+    
+    gettimeofday(&tstart, NULL);
+    G_math_solver_bicgstab(les->A, les->x, les->b, les->rows, 250, 0.1e-9);
+    gettimeofday(&tend, NULL);
+    G_important_message("Computation time bicgstab normal matrix: %g\n", compute_time_difference(tstart, tend));
+    
+    gettimeofday(&tstart, NULL);
+    G_math_solver_sparse_bicgstab(sples->Asp, sples->x, sples->b, les->rows,
+            250, 0.1e-9);
+    gettimeofday(&tend, NULL);
+    G_important_message("Computation time bicgstab sparse matrix: %g\n", compute_time_difference(tstart, tend));
+
+    G_math_free_les(les);
+    G_math_free_les(sples);
+
+    return 1;
+}
+

lib/gmath/test/test.gmath.lib.html

@@ -0,0 +1,3 @@
+
+
+Take a look at the module command line help for more information.