pyEQL 1.4.0rc9__cp313-cp313-macosx_10_13_x86_64.whl

pyEQL/phreeqc/ext/iphreeqc-3.8.6-17100/src/phreeqcpp/smalldense.cpp

@@ -0,0 +1,324 @@
+/**************************************************************************
+ *                                                                        *
+ * File          : smalldense.c                                           *
+ * Programmers   : Scott D. Cohen and Alan C. Hindmarsh @ LLNL            *
+ * Version of    : 26 June 2002                                           *
+ *------------------------------------------------------------------------*
+ * Copyright (c) 2002, The Regents of the University of California        *
+ * Produced at the Lawrence Livermore National Laboratory                 *
+ * All rights reserved                                                    *
+ * For details, see LICENSE below                                         *
+ *------------------------------------------------------------------------*
+ * This is the implementation file for a generic DENSE linear             *
+ * solver package, intended for small dense matrices.                     *
+ *                                                                        *
+ *------------------------------------------------------------------------*
+ * LICENSE                                                                *
+ *------------------------------------------------------------------------*
+ * Copyright (c) 2002, The Regents of the University of California.       *
+ * Produced at the Lawrence Livermore National Laboratory.                *
+ * Written by S.D. Cohen, A.C. Hindmarsh, R. Serban,                      *
+ *            D. Shumaker, and A.G. Taylor.                               *
+ * UCRL-CODE-155951    (CVODE)                                            *
+ * UCRL-CODE-155950    (CVODES)                                           *
+ * UCRL-CODE-155952    (IDA)                                              *
+ * UCRL-CODE-237203    (IDAS)                                             *
+ * UCRL-CODE-155953    (KINSOL)                                           *
+ * All rights reserved.                                                   *
+ *                                                                        *
+ * This file is part of SUNDIALS.                                         *
+ *                                                                        *
+ * Redistribution and use in source and binary forms, with or without     *
+ * modification, are permitted provided that the following conditions     *
+ * are met:                                                               *
+ *                                                                        *
+ * 1. Redistributions of source code must retain the above copyright      *
+ * notice, this list of conditions and the disclaimer below.              *
+ *                                                                        *
+ * 2. Redistributions in binary form must reproduce the above copyright   *
+ * notice, this list of conditions and the disclaimer (as noted below)    *
+ * in the documentation and/or other materials provided with the          *
+ * distribution.                                                          *
+ *                                                                        *
+ * 3. Neither the name of the UC/LLNL nor the names of its contributors   *
+ * may be used to endorse or promote products derived from this software  *
+ * without specific prior written permission.                             *
+ *                                                                        *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS    *
+ * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT      *
+ * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS      *
+ * FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE         *
+ * REGENTS OF THE UNIVERSITY OF CALIFORNIA, THE U.S. DEPARTMENT OF ENERGY *
+ * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,        *
+ * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT       *
+ * LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,  *
+ * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY  *
+ * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT    *
+ * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE  *
+ * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.   *
+ **************************************************************************/
+
+#include <stdio.h>
+#include <stdlib.h>
+#include "smalldense.h"
+#include "sundialstypes.h"
+#include "sundialsmath.h"
+
+#if defined(PHREEQCI_GUI)
+#ifdef _DEBUG
+#define new DEBUG_NEW
+#undef THIS_FILE
+static char THIS_FILE[] = __FILE__;
+#endif
+#endif
+
+/* WARNING don`t include any headers below here */
+
+#define ZERO RCONST(0.0)
+#define ONE  RCONST(1.0)
+
+/* Implementation */
+
+realtype **
+denalloc(integertype n)
+{
+	integertype j;
+	realtype **a;
+
+	if (n <= 0)
+		return (NULL);
+
+	a = (realtype **) malloc(n * sizeof(realtype *));
+	if (a == NULL)
+		return (NULL);
+
+	a[0] = (realtype *) malloc((size_t)n * (size_t)n * sizeof(realtype));
+	if (a[0] == NULL)
+	{
+		free(a);
+		return (NULL);
+	}
+
+	for (j = 1; j < n; j++)
+		a[j] = a[0] + (size_t)j * (size_t)n;
+
+	return (a);
+}
+
+integertype *
+denallocpiv(integertype n)
+{
+	if (n <= 0)
+		return (NULL);
+
+	return ((integertype *) malloc(n * sizeof(integertype)));
+}
+
+integertype
+gefa(realtype ** a, integertype n, integertype * p)
+{
+	integertype i, j, k, l;
+	realtype *col_j, *col_k, *diag_k;
+	realtype temp, mult, a_kj;
+	booleantype swap;
+
+	/* k = elimination step number */
+
+	for (k = 0; k < n - 1; k++, p++)
+	{
+
+		col_k = a[k];
+		diag_k = col_k + k;
+
+		/* find l = pivot row number */
+
+		l = k;
+		for (i = k + 1; i < n; i++)
+			if (ABS(col_k[i]) > ABS(col_k[l]))
+				l = i;
+		*p = l;
+
+		/* check for zero pivot element */
+
+		if (col_k[l] == ZERO)
+			return (k + 1);
+
+		/* swap a(l,k) and a(k,k) if necessary */
+
+		/*if ( (swap = (l != k) )) { */
+		swap = (l != k);
+		if (swap)
+		{
+			temp = col_k[l];
+			col_k[l] = *diag_k;
+			*diag_k = temp;
+		}
+
+		/* Scale the elements below the diagonal in         */
+		/* column k by -1.0 / a(k,k). After the above swap, */
+		/* a(k,k) holds the pivot element. This scaling     */
+		/* stores the pivot row multipliers -a(i,k)/a(k,k)  */
+		/* in a(i,k), i=k+1, ..., n-1.                      */
+
+		mult = -ONE / (*diag_k);
+		for (i = k + 1; i < n; i++)
+			col_k[i] *= mult;
+
+		/* row_i = row_i - [a(i,k)/a(k,k)] row_k, i=k+1, ..., n-1 */
+		/* row k is the pivot row after swapping with row l.      */
+		/* The computation is done one column at a time,          */
+		/* column j=k+1, ..., n-1.                                */
+
+		for (j = k + 1; j < n; j++)
+		{
+
+			col_j = a[j];
+			a_kj = col_j[l];
+
+			/* Swap the elements a(k,j) and a(k,l) if l!=k. */
+
+			if (swap)
+			{
+				col_j[l] = col_j[k];
+				col_j[k] = a_kj;
+			}
+
+			/* a(i,j) = a(i,j) - [a(i,k)/a(k,k)]*a(k,j)  */
+			/* a_kj = a(k,j), col_k[i] = - a(i,k)/a(k,k) */
+
+			if (a_kj != ZERO)
+			{
+				for (i = k + 1; i < n; i++)
+					col_j[i] += a_kj * col_k[i];
+			}
+		}
+	}
+
+	/* set the last pivot row to be n-1 and check for a zero pivot */
+
+	*p = n - 1;
+	if (a[n - 1][n - 1] == ZERO)
+		return (n);
+
+	/* return 0 to indicate success */
+
+	return (0);
+}
+
+void
+gesl(realtype ** a, integertype n, integertype * p, realtype * b)
+{
+	integertype k, l, i;
+	realtype mult, *col_k;
+
+	/* Solve Ly = Pb, store solution y in b */
+
+	for (k = 0; k < n - 1; k++)
+	{
+		l = p[k];
+		mult = b[l];
+		if (l != k)
+		{
+			b[l] = b[k];
+			b[k] = mult;
+		}
+		col_k = a[k];
+		for (i = k + 1; i < n; i++)
+			b[i] += mult * col_k[i];
+	}
+
+	/* Solve Ux = y, store solution x in b */
+
+	for (k = n - 1; k >= 0; k--)
+	{
+		col_k = a[k];
+		b[k] /= col_k[k];
+		mult = -b[k];
+		for (i = 0; i < k; i++)
+			b[i] += mult * col_k[i];
+	}
+}
+
+void
+denzero(realtype ** a, integertype n)
+{
+	integertype i, j;
+	realtype *col_j;
+
+	for (j = 0; j < n; j++)
+	{
+		col_j = a[j];
+		for (i = 0; i < n; i++)
+			col_j[i] = ZERO;
+	}
+}
+
+void
+dencopy(realtype ** a, realtype ** b, integertype n)
+{
+	integertype i, j;
+	realtype *a_col_j, *b_col_j;
+
+	for (j = 0; j < n; j++)
+	{
+		a_col_j = a[j];
+		b_col_j = b[j];
+		for (i = 0; i < n; i++)
+			b_col_j[i] = a_col_j[i];
+	}
+
+}
+
+void
+denscale(realtype c, realtype ** a, integertype n)
+{
+	integertype i, j;
+	realtype *col_j;
+
+	for (j = 0; j < n; j++)
+	{
+		col_j = a[j];
+		for (i = 0; i < n; i++)
+			col_j[i] *= c;
+	}
+}
+
+void
+denaddI(realtype ** a, integertype n)
+{
+	integertype i;
+
+	for (i = 0; i < n; i++)
+		a[i][i] += ONE;
+}
+
+void
+denfreepiv(integertype * p)
+{
+	free(p);
+}
+
+void
+denfree(realtype ** a)
+{
+	free(a[0]);
+	free(a);
+}
+
+void
+denprint(realtype ** a, integertype n)
+{
+#if !defined(R_SO)
+	integertype i, j;
+	printf("\n");
+	for (i = 0; i < n; i++)
+	{
+		for (j = 0; j < n; j++)
+		{
+			printf("%10g", (double) a[j][i]);
+		}
+		printf("\n");
+	}
+	printf("\n");
+#endif
+}

pyEQL/phreeqc/ext/iphreeqc-3.8.6-17100/src/phreeqcpp/smalldense.h

@@ -0,0 +1,261 @@
+/**************************************************************************
+ *                                                                        *
+ * File          : smalldense.h                                           *
+ * Programmers   : Scott D. Cohen and Alan C. Hindmarsh @ LLNL            *
+ * Version of    : 26 June 2002                                           *
+ *-----------------------------------------------------------------       *
+ * Copyright (c) 2002, The Regents of the University of California        *
+ * Produced at the Lawrence Livermore National Laboratory                 *
+ * All rights reserved                                                    *
+ * For details, see LICENSE below                                         *
+ *-----------------------------------------------------------------       *
+ * This is the header file for a generic DENSE linear solver              *
+ * package, intended for small dense matrices.  These routines            *
+ * use the type realtype** for dense matrix arguments.                    *
+ *                                                                        *
+ * These routines begin with "den" (except for the factor and             *
+ * solve routines which are called gefa and gesl, respectively).          *
+ * The underlying matrix storage is described in the                      *
+ * documentation for denalloc.                                            *
+ *                                                                        *
+ *------------------------------------------------------------------------*
+ * LICENSE                                                                *
+ *------------------------------------------------------------------------*
+ * Copyright (c) 2002, The Regents of the University of California.       *
+ * Produced at the Lawrence Livermore National Laboratory.                *
+ * Written by S.D. Cohen, A.C. Hindmarsh, R. Serban,                      *
+ *            D. Shumaker, and A.G. Taylor.                               *
+ * UCRL-CODE-155951    (CVODE)                                            *
+ * UCRL-CODE-155950    (CVODES)                                           *
+ * UCRL-CODE-155952    (IDA)                                              *
+ * UCRL-CODE-237203    (IDAS)                                             *
+ * UCRL-CODE-155953    (KINSOL)                                           *
+ * All rights reserved.                                                   *
+ *                                                                        *
+ * This file is part of SUNDIALS.                                         *
+ *                                                                        *
+ * Redistribution and use in source and binary forms, with or without     *
+ * modification, are permitted provided that the following conditions     *
+ * are met:                                                               *
+ *                                                                        *
+ * 1. Redistributions of source code must retain the above copyright      *
+ * notice, this list of conditions and the disclaimer below.              *
+ *                                                                        *
+ * 2. Redistributions in binary form must reproduce the above copyright   *
+ * notice, this list of conditions and the disclaimer (as noted below)    *
+ * in the documentation and/or other materials provided with the          *
+ * distribution.                                                          *
+ *                                                                        *
+ * 3. Neither the name of the UC/LLNL nor the names of its contributors   *
+ * may be used to endorse or promote products derived from this software  *
+ * without specific prior written permission.                             *
+ *                                                                        *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS    *
+ * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT      *
+ * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS      *
+ * FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE         *
+ * REGENTS OF THE UNIVERSITY OF CALIFORNIA, THE U.S. DEPARTMENT OF ENERGY *
+ * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,        *
+ * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT       *
+ * LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,  *
+ * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY  *
+ * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT    *
+ * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE  *
+ * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.   *
+ **************************************************************************/
+#ifndef _smalldense_h
+#define _smalldense_h
+
+#include "sundialstypes.h"
+
+
+/******************************************************************
+ *                                                                *
+ * Function : denalloc                                            *
+ * Usage    : realtype **a;                                       *
+ *            a = denalloc(n);                                    *
+ *            if (a == NULL) ... memory request failed            *
+ *----------------------------------------------------------------*
+ * denalloc(n) allocates storage for an n by n dense matrix. It   *
+ * returns a pointer to the newly allocated storage if            *
+ * successful. If the memory request cannot be satisfied, then    *
+ * denalloc returns NULL. The underlying type of the dense matrix *
+ * returned is realtype **. If we allocate a dense matrix         *
+ * realtype **a by a = denalloc(n), then a[j][i] references the   *
+ * (i,j)th element of the matrix a, 0 <= i,j <= n-1, and a[j] is  *
+ * a pointer to the first element in the jth column of a.         *
+ * The location a[0] contains a pointer to n^2 contiguous         *
+ * locations which contain the elements of a.                     *
+ *                                                                *
+ ******************************************************************/
+
+	realtype **denalloc(integertype n);
+
+
+/******************************************************************
+ *                                                                *
+ * Function : denallocpiv                                         *
+ * Usage    : integertype *pivot;                                 *
+ *            pivot = denallocpiv(n);                             *
+ *            if (pivot == NULL) ... memory request failed        *
+ *----------------------------------------------------------------*
+ * denallocpiv(n) allocates an array of n integertype. It returns *
+ * a pointer to the first element in the array if successful.     *
+ * It returns NULL if the memory request could not be satisfied.  *
+ *                                                                *
+ ******************************************************************/
+
+	integertype *denallocpiv(integertype n);
+
+
+/******************************************************************
+ *                                                                *
+ * Function : gefa                                                *
+ * Usage    : integertype ier;                                    *
+ *            ier = gefa(a,n,p);                                  *
+ *            if (ier > 0) ... zero element encountered during    *
+ *                             the factorization                  *
+ *----------------------------------------------------------------*
+ * gefa(a,n,p) factors the n by n dense matrix a. It overwrites   *
+ * the elements of a with its LU factors and keeps track of the   *
+ * pivot rows chosen in the pivot array p.                        *
+ *                                                                *
+ * A successful LU factorization leaves the matrix a and the      *
+ * pivot array p with the following information:                  *
+ *                                                                *
+ * (1) p[k] contains the row number of the pivot element chosen   *
+ *     at the beginning of elimination step k, k=0, 1, ..., n-1.  *
+ *                                                                *
+ * (2) If the unique LU factorization of a is given by Pa = LU,   *
+ *     where P is a permutation matrix, L is a lower triangular   *
+ *     matrix with all 1's on the diagonal, and U is an upper     *
+ *     triangular matrix, then the upper triangular part of a     *
+ *     (including its diagonal) contains U and the strictly lower *
+ *     triangular part of a contains the multipliers, I-L.        *
+ *                                                                *
+ * gefa returns 0 if successful. Otherwise it encountered a zero  *
+ * diagonal element during the factorization. In this case it     *
+ * returns the column index (numbered from one) at which it       *
+ * encountered the zero.                                          *
+ *                                                                *
+ ******************************************************************/
+
+	integertype gefa(realtype ** a, integertype n, integertype * p);
+
+
+/******************************************************************
+ *                                                                *
+ * Function : gesl                                                *
+ * Usage    : realtype *b;                                        *
+ *            ier = gefa(a,n,p);                                  *
+ *            if (ier == 0) gesl(a,n,p,b);                        *
+ *----------------------------------------------------------------*
+ * gesl(a,n,p,b) solves the n by n linear system ax = b. It       *
+ * assumes that a has been LU factored and the pivot array p has  *
+ * been set by a successful call to gefa(a,n,p). The solution x   *
+ * is written into the b array.                                   *
+ *                                                                *
+ ******************************************************************/
+
+	void gesl(realtype ** a, integertype n, integertype * p, realtype * b);
+
+
+/******************************************************************
+ *                                                                *
+ * Function : denzero                                             *
+ * Usage    : denzero(a,n);                                       *
+ *----------------------------------------------------------------*
+ * denzero(a,n) sets all the elements of the n by n dense matrix  *
+ * a to be 0.0.                                                   *
+ *                                                                *
+ ******************************************************************/
+
+	void denzero(realtype ** a, integertype n);
+
+
+/******************************************************************
+ *                                                                *
+ * Function : dencopy                                             *
+ * Usage    : dencopy(a,b,n);                                     *
+ *----------------------------------------------------------------*
+ * dencopy(a,b,n) copies the n by n dense matrix a into the       *
+ * n by n dense matrix b.                                         *
+ *                                                                *
+ ******************************************************************/
+
+	void dencopy(realtype ** a, realtype ** b, integertype n);
+
+
+/******************************************************************
+ *                                                                *
+ * Function : denscale                                            *
+ * Usage    : denscale(c,a,n);                                    *
+ *----------------------------------------------------------------*
+ * denscale(c,a,n) scales every element in the n by n dense       *
+ * matrix a by c.                                                 *
+ *                                                                *
+ ******************************************************************/
+
+	void denscale(realtype c, realtype ** a, integertype n);
+
+
+/******************************************************************
+ *                                                                *
+ * Function : denaddI                                             *
+ * Usage    : denaddI(a,n);                                       *
+ *----------------------------------------------------------------*
+ * denaddI(a,n) increments the n by n dense matrix a by the       *
+ * identity matrix.                                               *
+ *                                                                *
+ ******************************************************************/
+
+	void denaddI(realtype ** a, integertype n);
+
+
+/******************************************************************
+ *                                                                *
+ * Function : denfreepiv                                          *
+ * Usage    : denfreepiv(p);                                      *
+ *----------------------------------------------------------------*
+ * denfreepiv(p) frees the pivot array p allocated by             *
+ * denallocpiv.                                                   *
+ *                                                                *
+ ******************************************************************/
+
+	void denfreepiv(integertype * p);
+
+
+/******************************************************************
+ *                                                                *
+ * Function : denfree                                             *
+ * Usage    : denfree(a);                                         *
+ *----------------------------------------------------------------*
+ * denfree(a) frees the dense matrix a allocated by denalloc.     *
+ *                                                                *
+ ******************************************************************/
+
+	void denfree(realtype ** a);
+
+
+/******************************************************************
+ *                                                                *
+ * Function : denprint                                            *
+ * Usage    : denprint(a,n);                                      *
+ *----------------------------------------------------------------*
+ * denprint(a,n) prints the n by n dense matrix a to standard     *
+ * output as it would normally appear on paper. It is intended as *
+ * a debugging tool with small values of n. The elements are      *
+ * printed using the %g option. A blank line is printed before    *
+ * and after the matrix.                                          *
+ *                                                                *
+ ******************************************************************/
+
+	void denprint(realtype ** a, integertype n);
+
+
+#endif
+/*
+#ifdef __cplusplus
+}
+#endif
+*/