pyEQL 1.4.0rc9__cp310-cp310-win_amd64.whl

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

@@ -0,0 +1,881 @@
+#include <stdio.h>
+#include <string.h>
+#include <cmath>
+#include <stdlib.h>
+#include "Phreeqc.h"
+#include "phqalloc.h"
+
+/* debug
+#define DEBUG_CL1
+#define CHECK_ERRORS
+ */
+
+#if defined(PHREEQCI_GUI)
+#ifdef _DEBUG
+#define new DEBUG_NEW
+#undef THIS_FILE
+static char THIS_FILE[] = __FILE__;
+#endif
+#endif
+
+int Phreeqc::
+cl1(int k, int l, int m, int n,
+	int l_nklmd, int l_n2d,
+	LDBLE * q,
+	int *l_kode, LDBLE l_toler,
+	int *l_iter, LDBLE * l_x, LDBLE * l_res, LDBLE * l_error,
+	LDBLE * l_cu, int *l_iu, int *l_s, int check)
+{
+	/* System generated locals */
+	union double_or_int
+	{
+		int ival;
+		LDBLE dval;
+	} *q2;
+
+	/* Local variables */
+	int nklm;
+	LDBLE xmin, xmax;
+	int iout = 0;
+	// static i runs faster on windows
+	int i, j;
+	LDBLE l_z;
+	int maxit, n1, n2;
+	LDBLE pivot;
+	int ia, ii, kk, nk, js;
+	int in = 0;
+	LDBLE sn;
+	int iphase, kforce;
+	LDBLE zu, zv;
+	LDBLE tpivot;
+	int klm, jmn, nkl, jpn;
+	LDBLE cuv;
+	long double sum;
+	int klm1;
+	int q_dim, cu_dim;
+	int kode_arg;
+	LDBLE check_toler;
+#ifdef CHECK_ERRORS
+	char **col_name, **row_name;
+	int *row_back, *col_back;
+#endif
+/* THIS SUBROUTINE USES A MODIFICATION OF THE SIMPLEX */
+/* METHOD OF LINEAR PROGRAMMING TO CALCULATE AN L1 SOLUTION */
+/* TO A K BY N SYSTEM OF LINEAR EQUATIONS */
+/*             AX=B */
+/* SUBJECT TO L LINEAR EQUALITY CONSTRAINTS */
+/*             CX=D */
+/* AND M LINEAR INEQUALITY CONSTRAINTS */
+/*             EX.LE.F. */
+/* DESCRIPTION OF PARAMETERS */
+/* K      NUMBER OF ROWS OF THE MATRIX A (K.GE.1). */
+/* L      NUMBER OF ROWS OF THE MATRIX C (L.GE.0). */
+/* M      NUMBER OF ROWS OF THE MATRIX E (M.GE.0). */
+/* N      NUMBER OF COLUMNS OF THE MATRICES A,C,E (N.GE.1). */
+/* KLMD   SET TO AT LEAST K+L+M FOR ADJUSTABLE DIMENSIONS. */
+/* KLM2D  SET TO AT LEAST K+L+M+2 FOR ADJUSTABLE DIMENSIONS. */
+/* NKLMD  SET TO AT LEAST N+K+L+M FOR ADJUSTABLE DIMENSIONS. */
+/* N2D    SET TO AT LEAST N+2 FOR ADJUSTABLE DIMENSIONS */
+/* Q      TWO DIMENSIONAL REAL ARRAY WITH KLM2D ROWS AND */
+/*        AT LEAST N2D COLUMNS. */
+/*        ON ENTRY THE MATRICES A,C AND E, AND THE VECTORS */
+/*        B,D AND F MUST BE STORED IN THE FIRST K+L+M ROWS */
+/*        AND N+1 COLUMNS OF Q AS FOLLOWS */
+/*             A B */
+/*         Q = C D */
+/*             E F */
+/*        THESE VALUES ARE DESTROYED BY THE SUBROUTINE. */
+/* KODE   A CODE USED ON ENTRY TO, AND EXIT */
+/*        FROM, THE SUBROUTINE. */
+/*        ON ENTRY, THIS SHOULD NORMALLY BE SET TO 0. */
+/*        HOWEVER, IF CERTAIN NONNEGATIVITY CONSTRAINTS */
+/*        ARE TO BE INCLUDED IMPLICITLY, RATHER THAN */
+/*        EXPLICITLY IN THE CONSTRAINTS EX.LE.F, THEN KODE */
+/*        SHOULD BE SET TO 1, AND THE NONNEGATIVITY */
+/*        CONSTRAINTS INCLUDED IN THE ARRAYS X AND */
+/*        RES (SEE BELOW). */
+/*        ON EXIT, KODE HAS ONE OF THE */
+/*        FOLLOWING VALUES */
+/*             0- OPTIMAL SOLUTION FOUND, */
+/*             1- NO FEASIBLE SOLUTION TO THE */
+/*                CONSTRAINTS, */
+/*             2- CALCULATIONS TERMINATED */
+/*                PREMATURELY DUE TO ROUNDING ERRORS, */
+/*             3- MAXIMUM NUMBER OF ITERATIONS REACHED. */
+/* TOLER  A SMALL POSITIVE TOLERANCE. EMPIRICAL */
+/*        EVIDENCE SUGGESTS TOLER = 10**(-D*2/3), */
+/*        WHERE D REPRESENTS THE NUMBER OF DECIMAL */
+/*        DIGITS OF ACCURACY AVAILABLE. ESSENTIALLY, */
+/*        THE SUBROUTINE CANNOT DISTINGUISH BETWEEN ZERO */
+/*        AND ANY QUANTITY WHOSE MAGNITUDE DOES NOT EXCEED */
+/*        TOLER. IN PARTICULAR, IT WILL NOT PIVOT ON ANY */
+/*        NUMBER WHOSE MAGNITUDE DOES NOT EXCEED TOLER. */
+/* ITER   ON ENTRY ITER MUST CONTAIN AN UPPER BOUND ON */
+/*        THE MAXIMUM NUMBER OF ITERATIONS ALLOWED. */
+/*        A SUGGESTED VALUE IS 10*(K+L+M). ON EXIT ITER */
+/*        GIVES THE NUMBER OF SIMPLEX ITERATIONS. */
+/* X      ONE DIMENSIONAL REAL ARRAY OF SIZE AT LEAST N2D. */
+/*        ON EXIT THIS ARRAY CONTAINS A */
+/*        SOLUTION TO THE L1 PROBLEM. IF KODE=1 */
+/*        ON ENTRY, THIS ARRAY IS ALSO USED TO INCLUDE */
+/*        SIMPLE NONNEGATIVITY CONSTRAINTS ON THE */
+/*        VARIABLES. THE VALUES -1, 0, OR 1 */
+/*        FOR X(J) INDICATE THAT THE J-TH VARIABLE */
+/*        IS RESTRICTED TO BE .LE.0, UNRESTRICTED, */
+/*        OR .GE.0 RESPECTIVELY. */
+/* RES    ONE DIMENSIONAL REAL ARRAY OF SIZE AT LEAST KLMD. */
+/*        ON EXIT THIS CONTAINS THE RESIDUALS B-AX */
+/*        IN THE FIRST K COMPONENTS, D-CX IN THE */
+/*        NEXT L COMPONENTS (THESE WILL BE =0),AND */
+/*        F-EX IN THE NEXT M COMPONENTS. IF KODE=1 ON */
+/*        ENTRY, THIS ARRAY IS ALSO USED TO INCLUDE SIMPLE */
+/*        NONNEGATIVITY CONSTRAINTS ON THE RESIDUALS */
+/*        B-AX. THE VALUES -1, 0, OR 1 FOR RES(I) */
+/*        INDICATE THAT THE I-TH RESIDUAL (1.LE.I.LE.K) IS */
+/*        RESTRICTED TO BE .LE.0, UNRESTRICTED, OR .GE.0 */
+/*        RESPECTIVELY. */
+/* ERROR  ON EXIT, THIS GIVES THE MINIMUM SUM OF */
+/*        ABSOLUTE VALUES OF THE RESIDUALS. */
+/* CU     A TWO DIMENSIONAL REAL ARRAY WITH TWO ROWS AND */
+/*        AT LEAST NKLMD COLUMNS USED FOR WORKSPACE. */
+/* IU     A TWO DIMENSIONAL INTEGER ARRAY WITH TWO ROWS AND */
+/*        AT LEAST NKLMD COLUMNS USED FOR WORKSPACE. */
+/* S      INTEGER ARRAY OF SIZE AT LEAST KLMD, USED FOR */
+/*        WORKSPACE. */
+/*      real(kind=8) DBLE */
+/*      REAL */
+
+/* INITIALIZATION. */
+
+	zv = 0;
+	kode_arg = *l_kode;
+	cl1_space(check, l_n2d, k + l + m, l_nklmd);
+
+/* Parameter adjustments */
+	q_dim = l_n2d;
+	q2 = (union double_or_int *) q;
+	cu_dim = l_nklmd;
+
+/* Function Body */
+	maxit = *l_iter;
+	n1 = n + 1;
+	n2 = n + 2;
+	nk = n + k;
+	nkl = nk + l;
+	klm = k + l + m;
+	klm1 = klm + 1;
+	nklm = n + klm;
+	kforce = 1;
+	*l_iter = 0;
+	js = 0;
+	ia = -1;
+
+/* SET UP LABELS IN Q. */
+	for (j = 0; j < n; ++j)
+	{
+		q2[klm1 * q_dim + j].ival = j + 1;
+	}
+/* L10: */
+	for (i = 0; i < klm; ++i)
+	{
+		q2[i * q_dim + n1].ival = n + i + 1;
+		if (q2[i * q_dim + n].dval < 0.)
+		{
+			for (j = 0; j < n1; ++j)
+			{
+				q2[i * q_dim + j].dval = -q2[i * q_dim + j].dval;
+			}
+			q2[i * q_dim + n1].ival = -q2[i * q_dim + n1].ival;
+/* L20: */
+		}
+	}
+/* L30: */
+/* SET UP PHASE 1 COSTS. */
+	iphase = 2;
+#ifdef DEBUG_CL1
+	output_msg(sformatf( "Set up phase 1 costs\n"));
+#endif
+/* Zero first row of cu and iu */
+	memset(&l_cu[0], 0, (size_t)nklm * sizeof(LDBLE));
+	memset(&l_iu[0], 0, (size_t)nklm * sizeof(int));
+/* L40: */
+#ifdef DEBUG_CL1
+	output_msg(sformatf( "L40\n"));
+#endif
+	if (l != 0)
+	{
+		for (j = nk; j < nkl; ++j)
+		{
+			l_cu[j] = 1.;
+			l_iu[j] = 1;
+		}
+/* L50: */
+		iphase = 1;
+	}
+
+/* Copy first row of cu and iu to second row */
+	memcpy((void *) &(l_cu[cu_dim]), (void *) &(l_cu[0]),
+		   (size_t) nklm * sizeof(LDBLE));
+	memcpy((void *) &(l_iu[cu_dim]), (void *) &(l_iu[0]),
+		   (size_t) nklm * sizeof(int));
+
+/* L60: */
+#ifdef DEBUG_CL1
+	output_msg(sformatf( "L60\n"));
+#endif
+	if (m != 0)
+	{
+		for (j = nkl; j < nklm; ++j)
+		{
+			l_cu[cu_dim + j] = 1.;
+			l_iu[cu_dim + j] = 1;
+			jmn = j - n;
+			if (q2[jmn * q_dim + n1].ival < 0)
+			{
+				iphase = 1;
+			}
+		}
+/* L70: */
+	}
+/* L80: */
+#ifdef DEBUG_CL1
+	output_msg(sformatf( "L80\n"));
+#endif
+	if (*l_kode != 0)
+	{
+		for (j = 0; j < n; ++j)
+		{
+			if (l_x[j] < 0.)
+			{
+/* L90: */
+				l_cu[j] = 1.;
+				l_iu[j] = 1;
+			}
+			else if (l_x[j] > 0.)
+			{
+				l_cu[cu_dim + j] = 1.;
+				l_iu[cu_dim + j] = 1;
+			}
+		}
+/* L110: */
+#ifdef DEBUG_CL1
+		output_msg(sformatf( "L110\n"));
+#endif
+		for (j = 0; j < k; ++j)
+		{
+			jpn = j + n;
+			if (l_res[j] < 0.)
+			{
+/* L120: */
+				l_cu[jpn] = 1.;
+				l_iu[jpn] = 1;
+				if (q2[j * q_dim + n1].ival > 0)
+				{
+					iphase = 1;
+				}
+			}
+			else if (l_res[j] > 0.)
+			{
+/* L130: */
+				l_cu[cu_dim + jpn] = 1.;
+				l_iu[cu_dim + jpn] = 1;
+				if (q2[j * q_dim + n1].ival < 0)
+				{
+					iphase = 1;
+				}
+			}
+		}
+/* L140: */
+	}
+/* L150: */
+#ifdef DEBUG_CL1
+	output_msg(sformatf( "L150\n"));
+#endif
+	if (iphase == 2)
+	{
+		goto L500;
+	}
+/* COMPUTE THE MARGINAL COSTS. */
+  L160:
+#ifdef DEBUG_CL1
+	output_msg(sformatf( "L160\n"));
+#endif
+	for (j = js; j < n1; ++j)
+	{
+	sum = 0.;
+		for (i = 0; i < klm; ++i)
+		{
+			ii = q2[i * q_dim + n1].ival;
+			if (ii < 0)
+			{
+				l_z = l_cu[cu_dim - ii - 1];
+			}
+			else
+			{
+				l_z = l_cu[ii - 1];
+			}
+			sum += (long double) q2[i * q_dim + j].dval * (long double) l_z;
+		}
+		q2[klm * q_dim + j].dval = (double)sum;
+	}
+	for (j = js; j < n; ++j)
+	{
+		ii = q2[klm1 * q_dim + j].ival;
+		if (ii < 0)
+		{
+			l_z = l_cu[cu_dim - ii - 1];
+		}
+		else
+		{
+			l_z = l_cu[ii - 1];
+		}
+		q2[klm * q_dim + j].dval -= l_z;
+	}
+/* DETERMINE THE VECTOR TO ENTER THE BASIS. */
+  L240:
+#ifdef DEBUG_CL1
+	output_msg(sformatf( "L240, xmax %e\n", xmax));
+#endif
+	xmax = 0.;
+	if (js >= n)
+	{
+		goto L490;				/* test for optimality */
+	}
+	for (j = js; j < n; ++j)
+	{
+		zu = q2[klm * q_dim + j].dval;
+		ii = q2[klm1 * q_dim + j].ival;
+		if (ii > 0)
+		{
+			zv = -zu - l_cu[ii - 1] - l_cu[cu_dim + ii - 1];
+		}
+		else
+		{
+			ii = -ii;
+			zv = zu;
+			zu = -zu - l_cu[ii - 1] - l_cu[cu_dim + ii - 1];
+		}
+/* L260 */
+		if (kforce == 1 && ii > n)
+		{
+			continue;
+		}
+		if (l_iu[ii - 1] != 1 && zu > xmax)
+		{
+			xmax = zu;
+			in = j;
+		}
+/* L270 */
+		if (l_iu[cu_dim + ii - 1] != 1 && zv > xmax)
+		{
+			xmax = zv;
+			in = j;
+		}
+	}
+/* L280 */
+#ifdef DEBUG_CL1
+	output_msg(sformatf( "L280 xmax %e, toler %e\n", xmax, l_toler));
+#endif
+	if (xmax <= l_toler)
+	{
+#ifdef DEBUG_CL1
+		output_msg(sformatf( "xmax before optimality test %e\n", xmax));
+#endif
+		goto L490;				/* test for optimality */
+	}
+	if (q2[klm * q_dim + in].dval != xmax)
+	{
+		for (i = 0; i < klm1; ++i)
+		{
+			q2[i * q_dim + in].dval = -q2[i * q_dim + in].dval;
+		}
+		q2[klm1 * q_dim + in].ival = -q2[klm1 * q_dim + in].ival;
+/* L290: */
+		q2[klm * q_dim + in].dval = xmax;
+	}
+/* DETERMINE THE VECTOR TO LEAVE THE BASIS. */
+	if (iphase != 1 && ia != -1)
+	{
+		xmax = 0.;
+/* find maximum absolute value in column "in" */
+		for (i = 0; i <= ia; ++i)
+		{
+			l_z = fabs(q2[i * q_dim + in].dval);
+			if (l_z > xmax)
+			{
+				xmax = l_z;
+				iout = i;
+			}
+		}
+/* L310: */
+#ifdef DEBUG_CL1
+		output_msg(sformatf( "L310, xmax %e\n", xmax));
+#endif
+/* switch row ia with row iout, use memcpy */
+		if (xmax > l_toler)
+		{
+			if (ia != iout)
+			{
+				memcpy((void *) &(scratch[0]), (void *) &(q2[ia * q_dim]),
+					   (size_t) n2 * sizeof(LDBLE));
+				memcpy((void *) &(q2[ia * q_dim]), (void *) &(q2[iout * q_dim]),
+					   (size_t) n2 * sizeof(LDBLE));
+				memcpy((void *) &(q2[iout * q_dim]), (void *) &(scratch[0]),
+					   (size_t) n2 * sizeof(LDBLE));
+			}
+/* L320: */
+/* set pivot to row ia, column in */
+			iout = ia;
+			--ia;
+			pivot = q2[iout * q_dim + in].dval;
+			goto L420;			/* Gauss Jordan */
+		}
+	}
+/* L330: */
+#ifdef DEBUG_CL1
+	output_msg(sformatf( "L330, xmax %e\n", xmax));
+#endif
+	kk = -1;
+/* divide column n1 by positive value in column "in" greater than toler */
+	for (i = 0; i < klm; ++i)
+	{
+		l_z = q2[i * q_dim + in].dval;
+		if (l_z > l_toler)
+		{
+			++kk;
+			l_res[kk] = q2[i * q_dim + n].dval / l_z;
+			l_s[kk] = i;
+		}
+	}
+/* L340: */
+#ifdef DEBUG_CL1
+	if (kk < 0)
+	{
+		output_msg(sformatf( "kode = 2 in loop 340.\n"));
+	}
+#endif
+  L350:
+#ifdef DEBUG_CL1
+	output_msg(sformatf( "L350, xmax %e\n", xmax));
+#endif
+	if (kk < 0)
+	{
+/* no positive value found in L340 or bypass intermediate vertices */
+		*l_kode = 2;
+		goto L590;
+	}
+/* L360: */
+#ifdef DEBUG_CL1
+	output_msg(sformatf( "L360, xmax %e\n", xmax));
+#endif
+/* find minimum residual */
+	xmin = l_res[0];
+	iout = l_s[0];
+	j = 0;
+	if (kk != 0)
+	{
+		for (i = 1; i <= kk; ++i)
+		{
+			if (l_res[i] < xmin)
+			{
+				j = i;
+				xmin = l_res[i];
+				iout = l_s[i];
+			}
+		}
+/* L370: */
+/* put kk in position j */
+		l_res[j] = l_res[kk];
+		l_s[j] = l_s[kk];
+	}
+/* L380: */
+#ifdef DEBUG_CL1
+	output_msg(sformatf( "L380 iout %d, xmin %e, xmax %e\n", iout,
+			   xmin, xmax));
+#endif
+	--kk;
+	pivot = q2[iout * q_dim + in].dval;
+	ii = q2[iout * q_dim + n1].ival;
+	if (iphase != 1)
+	{
+		if (ii < 0)
+		{
+/* L390: */
+			if (l_iu[-ii - 1] == 1)
+			{
+				goto L420;
+			}
+		}
+		else
+		{
+			if (l_iu[cu_dim + ii - 1] == 1)
+			{
+				goto L420;
+			}
+		}
+	}
+/* L400: */
+#ifdef DEBUG_CL1
+	output_msg(sformatf( "L400\n"));
+#endif
+	ii = abs(ii);
+	cuv = l_cu[ii - 1] + l_cu[cu_dim + ii - 1];
+	if (q2[klm * q_dim + in].dval - pivot * cuv > l_toler)
+	{
+
+/* BYPASS INTERMEDIATE VERTICES. */
+		for (j = js; j < n1; ++j)
+		{
+			l_z = q2[iout * q_dim + j].dval;
+			q2[klm * q_dim + j].dval -= l_z * cuv;
+			q2[iout * q_dim + j].dval = -l_z;
+		}
+/* L410: */
+		q2[iout * q_dim + n1].ival = -q2[iout * q_dim + n1].ival;
+		goto L350;
+	}
+/* GAUSS-JORDAN ELIMINATION. */
+  L420:
+#ifdef DEBUG_CL1
+	output_msg(sformatf( "Gauss Jordon %d\n", *l_iter));
+#endif
+	if (*l_iter >= maxit)
+	{
+		*l_kode = 3;
+		goto L590;
+	}
+/* L430: */
+#ifdef DEBUG_CL1
+	output_msg(sformatf( "L430\n"));
+#endif
+	++(*l_iter);
+	for (j = js; j < n1; ++j)
+	{
+		if (j != in)
+		{
+			q2[iout * q_dim + j].dval /= pivot;
+		}
+	}
+/* L440: */
+	for (j = js; j < n1; ++j)
+	{
+		if (j != in)
+		{
+			l_z = -q2[iout * q_dim + j].dval;
+			for (i = 0; i < klm1; ++i)
+			{
+				if (i != iout)
+				{
+					q2[i * q_dim + j].dval += l_z * q2[i * q_dim + in].dval;
+				}
+			}
+/* L450: */
+		}
+	}
+/* L460: */
+#ifdef DEBUG_CL1
+	output_msg(sformatf( "L460\n"));
+#endif
+	tpivot = -pivot;
+	for (i = 0; i < klm1; ++i)
+	{
+		if (i != iout)
+		{
+			q2[i * q_dim + in].dval /= tpivot;
+		}
+	}
+/* L470: */
+	q2[iout * q_dim + in].dval = 1. / pivot;
+	ii = q2[iout * q_dim + n1].ival;
+	q2[iout * q_dim + n1].ival = q2[klm1 * q_dim + in].ival;
+	q2[klm1 * q_dim + in].ival = ii;
+	ii = abs(ii);
+	if (l_iu[ii - 1] == 0 || l_iu[cu_dim + ii - 1] == 0)
+	{
+		goto L240;
+	}
+/* switch column */
+	for (i = 0; i < klm1; ++i)
+	{
+		l_z = q2[i * q_dim + in].dval;
+		q2[i * q_dim + in].dval = q2[i * q_dim + js].dval;
+		q2[i * q_dim + js].dval = l_z;
+	}
+	i = q2[klm1 * q_dim + in].ival;
+	q2[klm1 * q_dim + in].ival = q2[klm1 * q_dim + js].ival;
+	q2[klm1 * q_dim + js].ival = i;
+/* L480: */
+	++js;
+	goto L240;
+/* TEST FOR OPTIMALITY. */
+  L490:
+#ifdef DEBUG_CL1
+	output_msg(sformatf( "L490\n"));
+#endif
+	if (kforce == 0)
+	{
+		if (iphase == 1)
+		{
+			if (q2[klm * q_dim + n].dval <= l_toler)
+			{
+				goto L500;
+			}
+#ifdef DEBUG_CL1
+			output_msg(sformatf( "q2[klm1-1, n1-1] > *toler. %e\n",
+					   q2[(klm1 - 1) * q_dim + n1 - 1].dval));
+#endif
+			*l_kode = 1;
+			goto L590;
+		}
+		*l_kode = 0;
+		goto L590;
+	}
+	if (iphase != 1 || q2[klm * q_dim + n].dval > l_toler)
+	{
+		kforce = 0;
+		goto L240;
+	}
+/* SET UP PHASE 2 COSTS. */
+  L500:
+#ifdef DEBUG_CL1
+	output_msg(sformatf( "Set up phase 2 costs %d\n", *l_iter));
+#endif
+	iphase = 2;
+	for (j = 0; j < nklm; ++j)
+	{
+		l_cu[j] = 0.;
+	}
+/* L510: */
+	for (j = n; j < nk; ++j)
+	{
+		l_cu[j] = 1.;
+	}
+	memcpy((void *) &(l_cu[cu_dim]), (void *) &(l_cu[0]),
+		   (size_t) nklm * sizeof(LDBLE));
+/* L520: */
+	for (i = 0; i < klm; ++i)
+	{
+		ii = q2[i * q_dim + n1].ival;
+		if (ii <= 0)
+		{
+			if (l_iu[cu_dim - ii - 1] == 0)
+			{
+				continue;
+			}
+			l_cu[cu_dim - ii - 1] = 0.;
+		}
+		else
+		{
+/* L530: */
+			if (l_iu[ii - 1] == 0)
+			{
+				continue;
+			}
+			l_cu[ii - 1] = 0.;
+		}
+/* L540: */
+		++ia;
+/* switch row */
+		if (ia != i)
+		{
+			memcpy((void *) &(scratch[0]), (void *) &(q2[ia * q_dim]),
+				   (size_t) n2 * sizeof(LDBLE));
+			memcpy((void *) &(q2[ia * q_dim]), (void *) &(q2[i * q_dim]),
+				   (size_t) n2 * sizeof(LDBLE));
+			memcpy((void *) &(q2[i * q_dim]), (void *) &(scratch[0]),
+				   (size_t) n2 * sizeof(LDBLE));
+		}
+/* L550: */
+	}
+/* L560: */
+	goto L160;
+
+
+/* PREPARE OUTPUT. */
+  L590:
+#ifdef DEBUG_CL1
+	output_msg(sformatf( "L590\n"));
+#endif
+	sum = 0.;
+	for (j = 0; j < n; ++j)
+	{
+		l_x[j] = 0.;
+	}
+/* L600: */
+	for (i = 0; i < klm; ++i)
+	{
+		l_res[i] = 0.;
+	}
+/* L610: */
+	for (i = 0; i < klm; ++i)
+	{
+		ii = q2[i * q_dim + n1].ival;
+		sn = 1.;
+		if (ii < 0)
+		{
+			ii = -ii;
+			sn = -1.;
+		}
+		if (ii <= n)
+		{
+/* L620: */
+			l_x[ii - 1] = sn * q2[i * q_dim + n].dval;
+		}
+		else
+		{
+/* L630: */
+			l_res[ii - n - 1] = sn * q2[i * q_dim + n].dval;
+			if (ii >= n1 && ii <= nk)
+			{
+/*     *    DBLE(Q(I,N1)) */
+			  sum += (long double) q2[i * q_dim + n].dval;
+			}
+		}
+	}
+/* L640: */
+#ifdef DEBUG_CL1
+	output_msg(sformatf( "L640\n"));
+#endif
+	*l_error = (double)sum;
+	/*
+	 *  Check calculation
+	 */
+	if ((check == 1) && (*l_kode == 0))
+	{
+		check_toler = 10. * l_toler;
+		/*
+		 *  Check optimization constraints
+		 */
+		if (kode_arg == 1)
+		{
+			for (i = 0; i < k; ++i)
+			{
+				if (res_arg[i] < 0.0)
+				{
+					if (l_res[i] > check_toler)
+					{
+#ifdef CHECK_ERRORS
+						output_msg(sformatf(
+								   "\tCL1: optimization constraint not satisfied row %d, res %s, constraint %f.\n",
+								   row_name[row_back[i]], l_res[i], res_arg[i]));
+#endif
+						*l_kode = 1;
+					}
+				}
+				else if (res_arg[i] > 0.0)
+				{
+					if (l_res[i] < -check_toler)
+					{
+#ifdef CHECK_ERRORS
+						output_msg(sformatf(
+								   "\tCL1: optimization constraint not satisfied row %s, res %e, constraint %f.\n",
+								   row_name[row_back[i]], l_res[i], res_arg[i]));
+#endif
+						*l_kode = 1;
+					}
+				}
+			}
+		}
+		/*
+		 *  Check equalities
+		 */
+		for (i = k; i < k + l; ++i)
+		{
+			if (fabs(l_res[i]) > check_toler)
+			{
+#ifdef CHECK_ERRORS
+				output_msg(sformatf(
+						   "\tCL1: equality constraint not satisfied row %s, res %e, tolerance %e.\n",
+						   row_name[row_back[i]], l_res[i], check_toler));
+#endif
+				*l_kode = 1;
+			}
+		}
+		/*
+		 *  Check inequalities
+		 */
+		for (i = k + l; i < k + l + m; ++i)
+		{
+			if (l_res[i] < -check_toler)
+			{
+#ifdef CHECK_ERRORS
+				output_msg(sformatf(
+						   "\tCL1: inequality constraint not satisfied row %s, res %e, tolerance %e.\n",
+						   row_name[row_back[i]], l_res[i], check_toler));
+#endif
+				*l_kode = 1;
+			}
+		}
+		/*
+		 *   Check dissolution/precipitation constraints
+		 */
+		if (kode_arg == 1)
+		{
+			for (i = 0; i < n; ++i)
+			{
+				if (x_arg[i] < 0.0)
+				{
+					if (l_x[i] > check_toler)
+					{
+#ifdef CHECK_ERRORS
+						output_msg(sformatf(
+								   "\tCL1: dis/pre constraint not satisfied column %s, x %e, constraint %f.\n",
+								   col_name[col_back[i]], l_x[i], x_arg[i]));
+#endif
+						*l_kode = 1;
+					}
+				}
+				else if (x_arg[i] > 0.0)
+				{
+					if (l_x[i] < -check_toler)
+					{
+#ifdef CHECK_ERRORS
+						output_msg(sformatf(
+								   "\tCL1: dis/pre constraint not satisfied column %s, x %e, constraint %f.\n",
+								   col_name[col_back[i]], l_x[i], x_arg[i]));
+#endif
+						*l_kode = 1;
+					}
+				}
+			}
+		}
+		if (*l_kode == 1)
+		{
+			output_msg(sformatf(
+					   "\n\tCL1: Roundoff errors in optimization.\n\t     Try using -multiple_precision in INVERSE_MODELING\n"));
+		}
+	}
+	return 0;
+}
+
+void Phreeqc::
+cl1_space(int check, int l_n2d, int klm, int l_nklmd)
+{
+	if (check == 1)
+	{
+		if ((size_t)l_n2d > x_arg.size())
+		{
+			x_arg.resize((size_t)l_n2d);
+		}
+		memset(&x_arg[0], 0, sizeof(double) * (size_t)l_n2d);
+
+		if ((size_t)klm > res_arg.size())
+		{
+			res_arg.resize((size_t)klm);
+		}
+		memset(&res_arg[0], 0, sizeof(double) * (size_t)klm);
+	}
+	if (l_nklmd > 0)
+	{
+		if ((size_t)l_nklmd > scratch.size())
+		{
+			scratch.resize(l_nklmd);
+		}
+		memset(&scratch[0], 0, sizeof(double) * (size_t)l_nklmd);
+	}
+	else if (scratch.size() == 0)
+	{
+		scratch.resize(1);
+		memset(&scratch[0], 0, sizeof(double));
+	}
+}