//------------------------------------------------------------------------------
// Name:
//------------------------------------------------------------------------------s
knumber_base *knumber_float::acos() {
if(mpf_cmp_d(mpf_, 1.0) > 0 || mpf_cmp_d(mpf_, -1.0) < 0) {
delete this;
return new knumber_error(knumber_error::ERROR_UNDEFINED);
}
#ifdef KNUMBER_USE_MPFR
mpfr_t mpfr;
mpfr_init_set_f(mpfr, mpf_, rounding_mode);
mpfr_acos(mpfr, mpfr, rounding_mode);
mpfr_get_f(mpf_, mpfr, rounding_mode);
mpfr_clear(mpfr);
return this;
#else
const double x = mpf_get_d(mpf_);
if(isinf(x)) {
delete this;
return new knumber_error(knumber_error::ERROR_POS_INFINITY);
} else {
return execute_libc_func< ::acos>(x);
}
#endif
}
void
check_one (const char *name, mpf_srcptr x, double y, int cmp)
{
int got;
got = mpf_cmp_d (x, y);
if (SGN(got) != cmp)
{
int i;
printf ("mpf_cmp_d wrong (from %s)\n", name);
printf (" got %d\n", got);
printf (" want %d\n", cmp);
mpf_trace (" x", x);
printf (" y %g\n", y);
mp_trace_base=-16;
mpf_trace (" x", x);
printf (" y %g\n", y);
printf (" y");
for (i = 0; i < sizeof(y); i++)
printf (" %02X", (unsigned) ((unsigned char *) &y)[i]);
printf ("\n");
abort ();
}
}
int
cl1mp (int k, int l, int m, int n,
int nklmd, int n2d,
LDBLE * q_arg,
int *kode_arg, LDBLE toler_arg,
int *iter, LDBLE * x_arg, LDBLE * res_arg, LDBLE * error_arg,
LDBLE * cu_arg, int *iu, int *s, int check, LDBLE censor_arg)
{
/* System generated locals */
union double_or_int
{
int ival;
mpf_t dval;
} *q2;
/* Local variables */
static int nklm;
static int iout, i, j;
static int maxit, n1, n2;
static int ia, ii, kk, in, nk, js;
static int iphase, kforce;
static int klm, jmn, nkl, jpn;
static int klm1;
static int *kode;
int q_dim, cu_dim;
int iswitch;
mpf_t *q;
mpf_t *x;
mpf_t *res;
mpf_t error;
mpf_t *cu;
mpf_t dummy, dummy1, sum, z, zu, zv, xmax, minus_one, toler, check_toler;
/*mpf_t *scratch; */
mpf_t pivot, xmin, cuv, tpivot, sn;
mpf_t zero;
int censor;
mpf_t censor_tol;
/* 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. */
/* DOUBLE PRECISION DBLE */
/* REAL */
/* INITIALIZATION. */
if (svnid == NULL)
fprintf (stderr, " ");
/*
* mp variables
*/
censor = 1;
if (censor_arg == 0.0)
censor = 0;
mpf_set_default_prec (96);
mpf_init (zero);
mpf_init (dummy);
mpf_init (dummy1);
mpf_init_set_d (censor_tol, censor_arg);
q =
(mpf_t *)
PHRQ_malloc ((size_t)
(max_row_count * max_column_count * sizeof (mpf_t)));
if (q == NULL)
malloc_error ();
for (i = 0; i < max_row_count * max_column_count; i++)
{
mpf_init_set_d (q[i], q_arg[i]);
if (censor == 1)
{
if (mpf_cmp (q[i], zero) != 0)
{
mpf_abs (dummy1, q[i]);
if (mpf_cmp (dummy1, censor_tol) <= 0)
{
mpf_set_si (q[i], 0);
}
}
}
}
x = (mpf_t *) PHRQ_malloc ((size_t) (n2d * sizeof (mpf_t)));
if (x == NULL)
malloc_error ();
for (i = 0; i < n2d; i++)
{
mpf_init_set_d (x[i], x_arg[i]);
}
res = (mpf_t *) PHRQ_malloc ((size_t) ((k + l + m) * sizeof (mpf_t)));
if (res == NULL)
malloc_error ();
for (i = 0; i < k + l + m; i++)
{
mpf_init_set_d (res[i], res_arg[i]);
}
cu = (mpf_t *) PHRQ_malloc ((size_t) (2 * nklmd * sizeof (mpf_t)));
if (cu == NULL)
malloc_error ();
for (i = 0; i < 2 * nklmd; i++)
{
mpf_init_set_d (cu[i], cu_arg[i]);
}
kode = (int *) PHRQ_malloc (sizeof (int));
if (kode == NULL)
malloc_error ();
*kode = *kode_arg;
mpf_init (sum);
mpf_init (error);
mpf_init (z);
mpf_init (zu);
mpf_init (zv);
mpf_init (xmax);
mpf_init_set_si (minus_one, -1);
mpf_init_set_d (toler, toler_arg);
mpf_init_set_d (check_toler, toler_arg);
mpf_init (pivot);
mpf_init (xmin);
mpf_init (cuv);
mpf_init (tpivot);
mpf_init (sn);
/* Parameter adjustments */
q_dim = n2d;
q2 = (union double_or_int *) q;
cu_dim = nklmd;
/* Function Body */
maxit = *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;
*iter = 0;
js = 0;
ia = -1;
/* Make scratch space */
/*
scratch = (LDBLE *) PHRQ_malloc( (size_t) nklmd * sizeof(LDBLE));
if (scratch == NULL) malloc_error();
for (i=0; i < nklmd; i++) {
scratch[i] = 0.0;
}
*/
/*
scratch = (mpf_t *) PHRQ_malloc( (size_t) nklmd * sizeof(mpf_t));
if (scratch == NULL) malloc_error();
for (i=0; i < nklmd; i++) {
mpf_init(scratch[i]);
}
*/
/* 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 (mpf_cmp_d (q2[i * q_dim + n].dval, 0.0) < 0)
{
for (j = 0; j < n1; ++j)
{
/* q2[ i * q_dim + j ].dval = -q2[ i * q_dim + j ].dval; */
mpf_neg (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 (OUTPUT_MESSAGE, "Set up phase 1 costs\n");
#endif
/* Zero first row of cu and iu */
/*memcpy( (void *) &(cu[0]), (void *) &(scratch[0]), (size_t) nklm * sizeof(mpf_t) ); */
for (j = 0; j < nklm; ++j)
{
mpf_set_si (cu[j], 0);
iu[j] = 0;
}
/* L40: */
#ifdef DEBUG_CL1
output_msg (OUTPUT_MESSAGE, "L40\n");
#endif
if (l != 0)
{
for (j = nk; j < nkl; ++j)
{
mpf_set_si (cu[j], 1);
/*cu[ j ] = 1.; */
iu[j] = 1;
}
/* L50: */
iphase = 1;
}
/* Copy first row of cu and iu to second row */
/*memcpy( (void *) &(cu[cu_dim]), (void *) &(cu[0]), (size_t) nklm * sizeof(mpf_t) ); */
for (i = 0; i < nklm; i++)
{
mpf_set (cu[cu_dim + i], cu[i]);
}
memcpy ((void *) &(iu[cu_dim]), (void *) &(iu[0]),
(size_t) nklm * sizeof (int));
/* L60: */
#ifdef DEBUG_CL1
output_msg (OUTPUT_MESSAGE, "L60\n");
#endif
if (m != 0)
{
for (j = nkl; j < nklm; ++j)
{
/* cu[ cu_dim + j ] = 1.; */
mpf_set_si (cu[cu_dim + j], 1);
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 (OUTPUT_MESSAGE, "L80\n");
#endif
if (*kode != 0)
{
for (j = 0; j < n; ++j)
{
/* if ( x[j] < 0.) { */
if (mpf_cmp_si (x[j], 0) < 0)
{
/* L90: */
/* cu[ j ] = 1.; */
mpf_set_si (cu[j], 1);
iu[j] = 1;
/* } else if (x[j] > 0.) { */
}
else if (mpf_cmp_si (x[j], 0) > 0)
{
/* cu[ cu_dim + j ] = 1.; */
mpf_set_si (cu[cu_dim + j], 1);
iu[cu_dim + j] = 1;
}
}
/* L110: */
#ifdef DEBUG_CL1
output_msg (OUTPUT_MESSAGE, "L110\n");
#endif
for (j = 0; j < k; ++j)
{
jpn = j + n;
/* if (res[j] < 0.) { */
if (mpf_cmp_si (res[j], 0) < 0)
{
/* L120: */
/* cu[ jpn ] = 1.; */
mpf_set_si (cu[jpn], 1);
iu[jpn] = 1;
if (q2[j * q_dim + n1].ival > 0)
{
iphase = 1;
}
/* } else if (res[j] > 0.) { */
}
else if (mpf_cmp_si (res[j], 0) > 0)
{
/* L130: */
/* cu[ cu_dim + jpn ] = 1.; */
mpf_set_si (cu[cu_dim + jpn], 1);
iu[cu_dim + jpn] = 1;
if (q2[j * q_dim + n1].ival < 0)
{
iphase = 1;
}
}
}
/* L140: */
}
/* L150: */
#ifdef DEBUG_CL1
output_msg (OUTPUT_MESSAGE, "L150\n");
#endif
if (iphase == 2)
{
goto L500;
}
/* COMPUTE THE MARGINAL COSTS. */
L160:
#ifdef DEBUG_CL1
output_msg (OUTPUT_MESSAGE, "L160\n");
#endif
for (j = js; j < n1; ++j)
{
mpf_set_si (sum, 0);
for (i = 0; i < klm; ++i)
{
ii = q2[i * q_dim + n1].ival;
if (ii < 0)
{
/* z = cu[ cu_dim - ii - 1 ]; */
mpf_set (z, cu[cu_dim - ii - 1]);
}
else
{
/*z = cu[ ii - 1 ]; */
mpf_set (z, cu[ii - 1]);
}
/*sum += q2[ i * q_dim + j ].dval * z; */
mpf_mul (dummy, q2[i * q_dim + j].dval, z);
mpf_add (sum, sum, dummy);
}
/*q2[ klm * q_dim + j ].dval = sum; */
mpf_set (q2[klm * q_dim + j].dval, sum);
}
for (j = js; j < n; ++j)
{
ii = q2[klm1 * q_dim + j].ival;
if (ii < 0)
{
/*z = cu[ cu_dim - ii - 1 ]; */
mpf_set (z, cu[cu_dim - ii - 1]);
}
else
{
/*z = cu[ ii - 1 ]; */
mpf_set (z, cu[ii - 1]);
}
/*q2[ klm * q_dim + j ].dval -= z; */
mpf_sub (q2[klm * q_dim + j].dval, q2[klm * q_dim + j].dval, z);
}
/* DETERMINE THE VECTOR TO ENTER THE BASIS. */
L240:
#ifdef DEBUG_CL1
output_msg (OUTPUT_MESSAGE, "L240, xmax %e\n", mpf_get_d (xmax));
#endif
/*xmax = 0.; */
mpf_set_si (xmax, 0);
if (js >= n)
{
goto L490; /* test for optimality */
}
for (j = js; j < n; ++j)
{
/*zu = q2[ klm * q_dim + j ].dval; */
mpf_set (zu, q2[klm * q_dim + j].dval);
ii = q2[klm1 * q_dim + j].ival;
if (ii > 0)
{
/*zv = -zu - cu[ ii - 1 ] - cu[ cu_dim + ii - 1 ]; */
mpf_mul (dummy, cu[cu_dim + ii - 1], minus_one);
mpf_sub (dummy, dummy, cu[ii - 1]);
mpf_sub (zv, dummy, zu);
}
else
{
ii = -ii;
/* zv = zu; */
mpf_set (zv, zu);
/* zu = -zu - cu[ ii - 1 ] - cu[ cu_dim + ii - 1 ]; */
mpf_mul (dummy, cu[cu_dim + ii - 1], minus_one);
mpf_sub (dummy, dummy, cu[ii - 1]);
mpf_sub (zu, dummy, zu);
}
/* L260 */
if (kforce == 1 && ii > n)
{
continue;
}
/*if (iu[ ii - 1 ] != 1 && zu > xmax){ */
if ((iu[ii - 1] != 1) && (mpf_cmp (zu, xmax) > 0))
{
/*xmax = zu; */
mpf_set (xmax, zu);
in = j;
}
/* L270 */
/*if (iu[ cu_dim + ii - 1 ] != 1 && zv > xmax ) { */
if ((iu[cu_dim + ii - 1] != 1) && (mpf_cmp (zv, xmax) > 0))
{
/*xmax = zv; */
mpf_set (xmax, zv);
in = j;
}
}
/* L280 */
#ifdef DEBUG_CL1
output_msg (OUTPUT_MESSAGE, "L280 xmax %e, toler %e\n", mpf_get_d (xmax),
mpf_get_d (toler));
#endif
/*if (xmax <= toler) { */
if (mpf_cmp (xmax, toler) <= 0)
{
#ifdef DEBUG_CL1
output_msg (OUTPUT_MESSAGE, "xmax before optimality test %e\n",
mpf_get_d (xmax));
#endif
goto L490; /* test for optimality */
}
/*if (q2[ klm * q_dim + in ].dval != xmax) { */
if (mpf_cmp (q2[klm * q_dim + in].dval, xmax) != 0)
{
for (i = 0; i < klm1; ++i)
{
/*q2[ i * q_dim + in ].dval = -q2[ i * q_dim + in ].dval; */
mpf_neg (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; */
mpf_set (q2[klm * q_dim + in].dval, xmax);
}
/* DETERMINE THE VECTOR TO LEAVE THE BASIS. */
if (iphase != 1 && ia != -1)
{
/*xmax = 0.; */
mpf_set_si (xmax, 0);
/* find maximum absolute value in column "in" */
for (i = 0; i <= ia; ++i)
{
/*z = fabs(q2[ i * q_dim + in ].dval); */
mpf_abs (z, q2[i * q_dim + in].dval);
/*if (z > xmax) { */
if (mpf_cmp (z, xmax) > 0)
{
/*xmax = z; */
mpf_set (xmax, z);
iout = i;
}
}
/* L310: */
#ifdef DEBUG_CL1
output_msg (OUTPUT_MESSAGE, "L310, xmax %e\n", mpf_get_d (xmax));
#endif
/* switch row ia with row iout, use memcpy */
/*if (xmax > toler) { */
if (mpf_cmp (xmax, toler) > 0)
{
/*
memcpy( (void *) &(scratch[0]), (void *) &(q2[ ia * q_dim]),
(size_t) n2 * sizeof(mpf_t) );
memcpy( (void *) &(q2[ ia * q_dim ]), (void *) &(q2[ iout * q_dim]),
(size_t) n2 * sizeof(mpf_t) );
memcpy( (void *) &(q2[ iout * q_dim ]), (void *) &(scratch[ 0 ]),
(size_t) n2 * sizeof(mpf_t) );
*/
for (i = 0; i < n1; i++)
{
mpf_set (dummy, q2[ia * q_dim + i].dval);
mpf_set (q2[ia * q_dim + i].dval, q2[iout * q_dim + i].dval);
mpf_set (q2[iout * q_dim + i].dval, dummy);
}
j = q2[ia * q_dim + n1].ival;
q2[ia * q_dim + n1].ival = q2[iout * q_dim + n1].ival;
q2[iout * q_dim + n1].ival = j;
/* L320: */
/* set pivot to row ia, column in */
iout = ia;
--ia;
/*pivot = q2[ iout * q_dim + in ].dval; */
mpf_set (pivot, q2[iout * q_dim + in].dval);
goto L420; /* Gauss Jordan */
}
}
/* L330: */
#ifdef DEBUG_CL1
output_msg (OUTPUT_MESSAGE, "L330, xmax %e\n", mpf_get_d (xmax));
#endif
kk = -1;
/* divide column n1 by positive value in column "in" greater than toler */
for (i = 0; i < klm; ++i)
{
/*z = q2[ i * q_dim + in ].dval; */
mpf_set (z, q2[i * q_dim + in].dval);
/*if (z > toler) { */
if (mpf_cmp (z, toler) > 0)
{
++kk;
/*res[kk] = q2[ i * q_dim + n ].dval / z; */
mpf_div (res[kk], q2[i * q_dim + n].dval, z);
s[kk] = i;
}
}
/* L340: */
if (kk < 0)
{
output_msg (OUTPUT_MESSAGE, "kode = 2 in loop 340.\n");
}
L350:
#ifdef DEBUG_CL1
output_msg (OUTPUT_MESSAGE, "L350, xmax %e\n", mpf_get_d (xmax));
#endif
if (kk < 0)
{
/* no positive value found in L340 or bypass intermediate verticies */
*kode = 2;
goto L590;
}
/* L360: */
#ifdef DEBUG_CL1
output_msg (OUTPUT_MESSAGE, "L360, xmax %e\n", mpf_get_d (xmax));
#endif
/* find minimum residual */
/*xmin = res[ 0 ]; */
mpf_set (xmin, res[0]);
iout = s[0];
j = 0;
if (kk != 0)
{
for (i = 1; i <= kk; ++i)
{
/*if (res[i] < xmin) { */
if (mpf_cmp (res[i], xmin) < 0)
{
j = i;
/*xmin = res[i]; */
mpf_set (xmin, res[i]);
iout = s[i];
}
}
/* L370: */
/* put kk in position j */
/*res[j] = res[kk]; */
mpf_set (res[j], res[kk]);
s[j] = s[kk];
}
/* L380: */
#ifdef DEBUG_CL1
output_msg (OUTPUT_MESSAGE, "L380 iout %d, xmin %e, xmax %e\n", iout,
mpf_get_d (xmin), mpf_get_d (xmax));
#endif
--kk;
/*pivot = q2[ iout * q_dim + in ].dval; */
mpf_set (pivot, q2[iout * q_dim + in].dval);
ii = q2[iout * q_dim + n1].ival;
if (iphase != 1)
{
if (ii < 0)
{
/* L390: */
if (iu[-ii - 1] == 1)
{
goto L420;
}
}
else
{
if (iu[cu_dim + ii - 1] == 1)
{
goto L420;
}
}
}
/* L400: */
#ifdef DEBUG_CL1
output_msg (OUTPUT_MESSAGE, "L400\n");
#endif
ii = abs (ii);
/*cuv = cu[ ii - 1 ] + cu[ cu_dim + ii - 1]; */
mpf_add (cuv, cu[ii - 1], cu[cu_dim + ii - 1]);
/*if (q2[ klm * q_dim + in ].dval - pivot * cuv > toler) { */
mpf_mul (dummy, pivot, cuv);
mpf_sub (dummy, q2[klm * q_dim + in].dval, dummy);
if (mpf_cmp (dummy, toler) > 0)
{
/* BYPASS INTERMEDIATE VERTICES. */
for (j = js; j < n1; ++j)
{
/*z = q2[ iout * q_dim + j ].dval; */
mpf_set (z, q2[iout * q_dim + j].dval);
/*q2[ klm * q_dim + j ].dval -= z * cuv; */
mpf_mul (dummy1, z, cuv);
mpf_sub (q2[klm * q_dim + j].dval, q2[klm * q_dim + j].dval, dummy1);
if (censor == 1)
{
if (mpf_cmp (q2[klm * q_dim + j].dval, zero) != 0)
{
mpf_abs (dummy1, q2[klm * q_dim + j].dval);
if (mpf_cmp (dummy1, censor_tol) <= 0)
{
mpf_set_si (q2[klm * q_dim + j].dval, 0);
}
}
}
/*q2[ iout * q_dim + j ].dval = -z; */
mpf_neg (q2[iout * q_dim + j].dval, 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 (OUTPUT_MESSAGE, "Gauss Jordon %d\n", *iter);
#endif
if (*iter >= maxit)
{
*kode = 3;
goto L590;
}
/* L430: */
#ifdef DEBUG_CL1
output_msg (OUTPUT_MESSAGE, "L430\n");
#endif
++(*iter);
for (j = js; j < n1; ++j)
{
if (j != in)
{
/*q2[ iout * q_dim + j ].dval /= pivot; */
mpf_div (q2[iout * q_dim + j].dval, q2[iout * q_dim + j].dval, pivot);
}
}
/* L440: */
for (j = js; j < n1; ++j)
{
if (j != in)
{
/*z = -q2[ iout * q_dim + j ].dval; */
mpf_neg (z, q2[iout * q_dim + j].dval);
for (i = 0; i < klm1; ++i)
{
if (i != iout)
{
/*q2[ i * q_dim + j ].dval += z * q2[ i * q_dim + in ].dval; */
mpf_mul (dummy, z, q2[i * q_dim + in].dval);
mpf_add (q2[i * q_dim + j].dval, q2[i * q_dim + j].dval, dummy);
if (censor == 1)
{
if (mpf_cmp (q2[i * q_dim + j].dval, zero) != 0)
{
mpf_abs (dummy1, q2[i * q_dim + j].dval);
if (mpf_cmp (dummy1, censor_tol) <= 0)
{
mpf_set_si (q2[i * q_dim + j].dval, 0);
}
}
}
}
}
/* L450: */
}
}
/* L460: */
#ifdef DEBUG_CL1
output_msg (OUTPUT_MESSAGE, "L460\n");
#endif
/*tpivot = -pivot; */
mpf_neg (tpivot, pivot);
for (i = 0; i < klm1; ++i)
{
if (i != iout)
{
/*q2[ i * q_dim + in ].dval /= tpivot; */
mpf_div (q2[i * q_dim + in].dval, q2[i * q_dim + in].dval, tpivot);
}
}
/* L470: */
/*q2[ iout * q_dim + in ].dval = 1. / pivot; */
mpf_set_si (dummy, 1);
mpf_div (q2[iout * q_dim + in].dval, dummy, 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 (iu[ii - 1] == 0 || iu[cu_dim + ii - 1] == 0)
{
goto L240;
}
/* switch column */
for (i = 0; i < klm1; ++i)
{
/*z = q2[ i * q_dim + in ].dval; */
mpf_set (z, q2[i * q_dim + in].dval);
/*q2[ i * q_dim + in ].dval = q2[ i * q_dim + js ].dval; */
mpf_set (q2[i * q_dim + in].dval, q2[i * q_dim + js].dval);
/*q2[ i * q_dim + js ].dval = z; */
mpf_set (q2[i * q_dim + js].dval, 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 (OUTPUT_MESSAGE, "L490\n");
#endif
if (kforce == 0)
{
if (iphase == 1)
{
/*if (q2[ klm * q_dim + n ].dval <= toler) { */
if (mpf_cmp (q2[klm * q_dim + n].dval, toler) <= 0)
{
goto L500;
}
#ifdef DEBUG_CL1
output_msg (OUTPUT_MESSAGE, "q2[klm1-1, n1-1] > *toler. %e\n",
mpf_get_d (q2[(klm1 - 1) * q_dim + n1 - 1].dval));
#endif
*kode = 1;
goto L590;
}
*kode = 0;
goto L590;
}
/*if (iphase != 1 || q2[ klm * q_dim + n ].dval > toler) { */
if ((iphase != 1) || (mpf_cmp (q2[klm * q_dim + n].dval, toler) > 0))
{
kforce = 0;
goto L240;
}
/* SET UP PHASE 2 COSTS. */
L500:
#ifdef DEBUG_CL1
output_msg (OUTPUT_MESSAGE, "Set up phase 2 costs %d\n", *iter);
#endif
iphase = 2;
for (j = 0; j < nklm; ++j)
{
/*cu[ j ] = 0.; */
mpf_set_si (cu[j], 0);
}
/* L510: */
for (j = n; j < nk; ++j)
{
/*cu[ j ] = 1.; */
mpf_set_si (cu[j], 1);
}
/*
memcpy( (void *) &(cu[cu_dim]), (void *) &(cu[0]), (size_t) nklm * sizeof(LDBLE) );
*/
for (i = 0; i < nklm; i++)
{
mpf_set (cu[cu_dim + i], cu[i]);
}
/* L520: */
for (i = 0; i < klm; ++i)
{
ii = q2[i * q_dim + n1].ival;
if (ii <= 0)
{
if (iu[cu_dim - ii - 1] == 0)
{
continue;
}
/*cu[ cu_dim - ii - 1 ] = 0.; */
mpf_set_si (cu[cu_dim - ii - 1], 0);
}
else
{
/* L530: */
if (iu[ii - 1] == 0)
{
continue;
}
/*cu[ ii - 1 ] = 0.; */
mpf_set_si (cu[ii - 1], 0);
}
/* L540: */
++ia;
/* switch row */
/*
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) );
*/
for (iswitch = 0; iswitch < n1; iswitch++)
{
mpf_set (dummy, q2[ia * q_dim + iswitch].dval);
mpf_set (q2[ia * q_dim + iswitch].dval, q2[i * q_dim + iswitch].dval);
mpf_set (q2[i * q_dim + iswitch].dval, dummy);
}
iswitch = q2[ia * q_dim + n1].ival;
q2[ia * q_dim + n1].ival = q2[i * q_dim + n1].ival;
q2[i * q_dim + n1].ival = iswitch;
/* L550: */
}
/* L560: */
goto L160;
/* PREPARE OUTPUT. */
L590:
#ifdef DEBUG_CL1
output_msg (OUTPUT_MESSAGE, "L590\n");
#endif
/*sum = 0.; */
mpf_set_si (sum, 0);
for (j = 0; j < n; ++j)
{
/*x[j] = 0.; */
mpf_set_si (x[j], 0);
}
/* L600: */
for (i = 0; i < klm; ++i)
{
/*res[i] = 0.; */
mpf_set_si (res[i], 0);
}
/* L610: */
for (i = 0; i < klm; ++i)
{
ii = q2[i * q_dim + n1].ival;
/*sn = 1.; */
mpf_set_si (sn, 1);
if (ii < 0)
{
ii = -ii;
/*sn = -1.; */
mpf_set_si (sn, -1);
}
if (ii <= n)
{
/* L620: */
/*x[ii - 1] = sn * q2[ i * q_dim + n ].dval; */
mpf_mul (x[ii - 1], sn, q2[i * q_dim + n].dval);
}
else
{
/* L630: */
/*res[ii - n - 1] = sn * q2[ i * q_dim + n ].dval; */
mpf_mul (res[ii - n - 1], sn, q2[i * q_dim + n].dval);
if (ii >= n1 && ii <= nk)
{
/* * DBLE(Q(I,N1)) */
/*sum += q2[ i * q_dim + n ].dval; */
mpf_add (sum, sum, q2[i * q_dim + n].dval);
}
}
}
/* L640: */
#ifdef DEBUG_CL1
output_msg (OUTPUT_MESSAGE, "L640\n");
#endif
/*
* Check calculation
*/
mpf_set_si (dummy, 100);
mpf_mul (check_toler, toler, dummy);
if (check && *kode == 0)
{
/*
* Check optimization constraints
*/
if (*kode_arg == 1)
{
for (i = 0; i < k; i++)
{
if (res_arg[i] < 0.0)
{
mpf_sub (dummy, res[i], check_toler);
mpf_set_si (dummy1, 0);
if (mpf_cmp (dummy, dummy1) > 0)
{
#ifdef CHECK_ERRORS
output_msg (OUTPUT_MESSAGE,
"\tCL1MP: optimization constraint not satisfied row %d, res %e, constraint %f.\n",
i, mpf_get_d (res[i]), res_arg[i]);
#endif
*kode = 1;
}
}
else if (res_arg[i] > 0.0)
{
mpf_add (dummy, res[i], check_toler);
mpf_set_si (dummy1, 0);
if (mpf_cmp (dummy, dummy1) < 0)
{
#ifdef CHECK_ERRORS
output_msg (OUTPUT_MESSAGE,
"\tCL1MP: optimization constraint not satisfied row %d, res %e, constraint %f.\n",
i, mpf_get_d (res[i]), res_arg[i]);
#endif
*kode = 1;
}
}
}
}
/*
* Check equalities
*/
for (i = k; i < k + l; i++)
{
mpf_abs (dummy, res[i]);
if (mpf_cmp (dummy, check_toler) > 0)
{
#ifdef CHECK_ERRORS
output_msg (OUTPUT_MESSAGE,
"\tCL1MP: equality constraint not satisfied row %d, res %e, tolerance %e.\n",
i, mpf_get_d (res[i]), mpf_get_d (check_toler));
#endif
*kode = 1;
}
}
/*
* Check inequalities
*/
for (i = k + l; i < k + l + m; i++)
{
mpf_neg (dummy, check_toler);
if (mpf_cmp (res[i], dummy) < 0)
{
#ifdef CHECK_ERRORS
output_msg (OUTPUT_MESSAGE,
"\tCL1MP: inequality constraint not satisfied row %d, res %e, tolerance %e.\n",
i, mpf_get_d (res[i]), mpf_get_d (check_toler));
#endif
*kode = 1;
}
}
/*
* Check dissolution/precipitation constraints
*/
if (*kode_arg == 1)
{
for (i = 0; i < n; i++)
{
if (x_arg[i] < 0.0)
{
mpf_sub (dummy, x[i], check_toler);
mpf_set_si (dummy1, 0);
if (mpf_cmp (dummy, dummy1) > 0)
{
#ifdef CHECK_ERRORS
output_msg (OUTPUT_MESSAGE,
"\tCL1MP: dis/pre constraint not satisfied column %d, x %e, constraint %f.\n",
i, mpf_get_d (x[i]), x_arg[i]);
#endif
*kode = 1;
}
}
else if (x_arg[i] > 0.0)
{
mpf_add (dummy, x[i], check_toler);
mpf_set_si (dummy1, 0);
if (mpf_cmp (dummy, dummy1) < 0)
{
#ifdef CHECK_ERRORS
output_msg (OUTPUT_MESSAGE,
"\tCL1MP: dis/pre constraint not satisfied column %d, x %e, constraint %f.\n",
i, mpf_get_d (x[i]), x_arg[i]);
#endif
*kode = 1;
}
}
}
}
if (*kode == 1)
{
output_msg (OUTPUT_MESSAGE,
"\n\tCL1MP: Roundoff errors in optimization.\n\t Deleting model.\n");
}
}
/*
* set return variables
*/
/**error = sum;*/
mpf_set (error, sum);
*error_arg = mpf_get_d (error);
*kode_arg = *kode;
for (i = 0; i < n2d; i++)
{
x_arg[i] = mpf_get_d (x[i]);
}
for (i = 0; i < k + l + m; i++)
{
res_arg[i] = mpf_get_d (res[i]);
}
/*scratch = free_check_null (scratch); */
for (i = 0; i < max_row_count * max_column_count; i++)
{
mpf_clear (q[i]);
}
q = (mpf_t *) free_check_null (q);
for (i = 0; i < n2d; i++)
{
mpf_clear (x[i]);
}
x = (mpf_t *) free_check_null (x);
for (i = 0; i < k + l + m; i++)
{
mpf_clear (res[i]);
}
res = (mpf_t *) free_check_null (res);
for (i = 0; i < 2 * nklmd; i++)
{
mpf_clear (cu[i]);
}
cu = (mpf_t *) free_check_null (cu);
mpf_clear (dummy);
mpf_clear (dummy1);
mpf_clear (sum);
mpf_clear (error);
mpf_clear (z);
mpf_clear (zu);
mpf_clear (zv);
mpf_clear (xmax);
mpf_clear (minus_one);
mpf_clear (toler);
mpf_clear (check_toler);
mpf_clear (pivot);
mpf_clear (xmin);
mpf_clear (cuv);
mpf_clear (tpivot);
mpf_clear (sn);
mpf_clear (censor_tol);
kode = (int *) free_check_null (kode);
return 0;
}
long int julia(const mpf_t x, const mpf_t xr, long int xres, const mpf_t y, const mpf_t yr, long int yres, mpf_t *c, int flag, long int max_iteration,
float *iterations, int my_rank, int p, MPI_Comm comm)
{
double t0 = MPI_Wtime();
int i,j;
//------------julia gmp
const double maxRadius = 4.0;
// double xi, yi, savex, savex2, savey, radius;
mpf_t xi, yi, x_min, x_max, y_min, y_max, savex, savex2, savey, radius, xgap, ygap, savex_a, savex_b, savey_a, savey_b, tmp, tmp1;
mpf_init(xi);
mpf_init(yi);
mpf_init(x_min);
mpf_init(x_max);
mpf_init(y_min);
mpf_init(y_max);
mpf_init(savex);
mpf_init(savex2);
mpf_init(savey);
mpf_init(radius);
mpf_init(xgap);
mpf_init(ygap);
mpf_init(savex_a);
mpf_init(savex_b);
mpf_init(savey_a);
mpf_init(savey_b);
mpf_init(tmp);
mpf_init(tmp1);
//double x_min = x - xr;
mpf_sub(x_min, x, xr);
//double x_max = x + xr;
mpf_add(x_max, x, xr);
//double y_min = y - yr;
mpf_sub(y_min, y, yr);
//double y_max = y + yr;
mpf_add(y_max, y, yr);
// spaceing between x and y points
//double xgap = (x_max - x_min) / xres;
mpf_sub(xgap, x_max, x_min);
mpf_div_ui(xgap, xgap, xres);
//double ygap = (y_max - y_min) / yres;
mpf_sub(ygap, y_max, y_min);
mpf_div_ui(ygap, ygap, yres);
//----------------------------
long long int iteration;
long long int total_number_iterations = 0;
int k = 0;
for (j = 0; j < yres; j++){
for (i = 0; i < xres; i++){
//xi = x_min + i * xgap;
mpf_mul_ui(tmp, xgap, i);
mpf_add(xi, x_min, tmp);
//yi = y_min + j * ygap;
mpf_mul_ui(tmp, ygap, j);
mpf_add(yi, y_min, tmp);
//flag betwee[n julia or mandelbrot
//savex = flag * c[0] + (1 - flag) * xi;
mpf_mul_ui(savex_a, c[0], flag);
mpf_mul_ui(savex_b, xi, (1-flag));
mpf_add(savex, savex_a, savex_b);
//savey = flag * c[1] + (1 - flag) * yi;
mpf_mul_ui(savey_a, c[1], flag);
mpf_mul_ui(savey_b, yi, (1-flag));
mpf_add(savey, savey_a, savey_b);
//radius = 0;
mpf_set_ui(radius, 0);
iteration = 0;
//while ((radius <= maxRadius) && (iteration < max_iteration)){
while ((mpf_cmp_d(radius, maxRadius)<=0) && (iteration < max_iteration)){
//savex2 = xi;
mpf_add_ui(savex2, xi, 0);
//xi = xi * xi - yi * yi + savex;
mpf_mul(xi, xi, xi);
mpf_mul(tmp, yi, yi);
mpf_sub(xi, xi, tmp);
mpf_add(xi, xi, savex);
//yi = 2.0f * savex2 * yi + savey;
mpf_mul_ui(tmp, savex2, 2);
mpf_mul(yi, yi, tmp);
mpf_add(yi, yi, savey);
//radius = xi * xi + yi * yi;
mpf_mul(tmp, xi, xi);
mpf_mul(tmp1, yi, yi);
mpf_add(radius, tmp, tmp1);
iteration++;
}
total_number_iterations += iteration;
float *p = iterations + k*xres + i;
//if (radius > maxRadius){
if (mpf_cmp_d(radius, maxRadius)>0){
//float zn = sqrt(xi*xi + yi*yi);
mpf_t zn;
mpf_init(zn);
mpf_mul(tmp, xi, xi);
mpf_mul(tmp1, yi, yi);
mpf_add(zn, tmp, tmp1);
mpf_sqrt(zn, zn);
double n = mpf_get_d(zn);
//float nu = log(log(zn) / log(2))/log(2);
double nu = log(log(n) / log(2))/log(2);
//the point has escaped at iteration at any of the iterations 0,1,2,3...
*p = iteration + 1 - nu;
}
else
// zij stays within the region up to max_iteration
{
assert(iteration==max_iteration);
*p = -1;
}
}
k++;
}
//reduce max iteration count
long long int total_reduced_iterations = -1;
//printf("rank: %i, total_reduced_iterations: %i\n", my_rank, total_number_iterations);
MPI_Reduce(&total_number_iterations, &total_reduced_iterations, 1, MPI_LONG_LONG_INT, MPI_SUM, 0, comm);
double t4 = MPI_Wtime();
double max_reduced_time = -1;
double total_time = t4 - t0;
MPI_Reduce(&total_time, &max_reduced_time, 1, MPI_DOUBLE, MPI_MAX, 0, comm);
printf("np: %i, time: %f , iterations: %lld\n",p, max_reduced_time, total_reduced_iterations);
//clear
//printf("proc: %i, total time: %lf sec, init: %lf sec, calc: %lf sec, collect: %lf\n", my_rank, t4-t0, t1-t0, t2-t1, t3-t2);
return total_reduced_iterations;
}
long int julia(const mpf_t x, const mpf_t xr, long int xres, const mpf_t y, const mpf_t yr, long int yres, mpf_t *c, int flag, long int max_iteration,
float *iterations, int my_rank, int p, MPI_Comm comm)
{
double t0 = MPI_Wtime();
int i,j;
// Find how many rows per process.
int *rows;
rows = (int*)malloc(sizeof(int)*p);
for (i=0; i < p; i++)
rows[i] = yres/p;
for (i=0; i < yres % p; i++)
rows[i]++;
//allocate memory for each processor
if(my_rank > 0){
iterations = (float*)malloc( sizeof(float) * xres * rows[my_rank]);
assert(iterations);
}
//------------julia gmp
const double maxRadius = 4.0;
mpf_t xi, yi, x_min, x_max, y_min, y_max, savex, savex2, savey, radius, xgap, ygap, savex_a, savex_b, savey_a, savey_b, tmp, tmp1;
mpf_init(xi);
mpf_init(yi);
mpf_init(x_min);
mpf_init(x_max);
mpf_init(y_min);
mpf_init(y_max);
mpf_init(savex);
mpf_init(savex2);
mpf_init(savey);
mpf_init(radius);
mpf_init(xgap);
mpf_init(ygap);
mpf_init(savex_a);
mpf_init(savex_b);
mpf_init(savey_a);
mpf_init(savey_b);
mpf_init(tmp);
mpf_init(tmp1);
//double x_min = x - xr;
mpf_sub(x_min, x, xr);
//double x_max = x + xr;
mpf_add(x_max, x, xr);
//double y_min = y - yr;
mpf_sub(y_min, y, yr);
//double y_max = y + yr;
mpf_add(y_max, y, yr);
// spaceing between x and y points
//double xgap = (x_max - x_min) / xres;
mpf_sub(xgap, x_max, x_min);
mpf_div_ui(xgap, xgap, xres);
//double ygap = (y_max - y_min) / yres;
mpf_sub(ygap, y_max, y_min);
mpf_div_ui(ygap, ygap, yres);
//----------------------------
long long int iteration;
long long int total_number_iterations = 0;
int k = 0;
for (j = my_rank; j < yres; j+=p){
if(my_rank==0)
k = j; //needed for root
for (i = 0; i < xres; i++){
//xi = x_min + i * xgap;
mpf_mul_ui(tmp, xgap, i);
mpf_add(xi, x_min, tmp);
//yi = y_min + j * ygap;
mpf_mul_ui(tmp, ygap, j);
mpf_add(yi, y_min, tmp);
//flag betwee[n julia or mandelbrot
//savex = flag * c[0] + (1 - flag) * xi;
mpf_mul_ui(savex_a, c[0], flag);
mpf_mul_ui(savex_b, xi, (1-flag));
mpf_add(savex, savex_a, savex_b);
//savey = flag * c[1] + (1 - flag) * yi;
mpf_mul_ui(savey_a, c[1], flag);
mpf_mul_ui(savey_b, yi, (1-flag));
mpf_add(savey, savey_a, savey_b);
//radius = 0;
mpf_set_ui(radius, 0);
iteration = 0;
//while ((radius <= maxRadius) && (iteration < max_iteration)){
while ((mpf_cmp_d(radius, maxRadius)<=0) && (iteration < max_iteration)){
//savex2 = xi;
mpf_add_ui(savex2, xi, 0);
//xi = xi * xi - yi * yi + savex;
mpf_mul(xi, xi, xi);
mpf_mul(tmp, yi, yi);
mpf_sub(xi, xi, tmp);
mpf_add(xi, xi, savex);
//yi = 2.0f * savex2 * yi + savey;
mpf_mul_ui(tmp, savex2, 2);
mpf_mul(yi, yi, tmp);
mpf_add(yi, yi, savey);
//radius = xi * xi + yi * yi;
mpf_mul(tmp, xi, xi);
mpf_mul(tmp1, yi, yi);
mpf_add(radius, tmp, tmp1);
iteration++;
}
total_number_iterations += iteration;
float *p = iterations + k*xres + i;
//if (radius > maxRadius){
if (mpf_cmp_d(radius, maxRadius)>0){
//float zn = sqrt(xi*xi + yi*yi);
mpf_t zn;
mpf_init(zn);
mpf_mul(tmp, xi, xi);
mpf_mul(tmp1, yi, yi);
mpf_add(zn, tmp, tmp1);
mpf_sqrt(zn, zn);
double n = mpf_get_d(zn);
//float nu = log(log(zn) / log(2))/log(2);
double nu = log(log(n) / log(2))/log(2);
//the point has escaped at iteration at any of the iterations 0,1,2,3...
*p = iteration + 1 - nu;
}
else
// zij stays within the region up to max_iteration
{
assert(iteration==max_iteration);
*p = -1;
}
}
k++;
}
//collect various data
MPI_Status status;
if(my_rank == 0){
int i,j;
for(i = 1; i < p; i++){
for(j = 0; j < rows[i]; j++){
MPI_Recv((iterations + (i + j * p) * xres), xres, MPI_FLOAT, i, 0, comm, &status);
//MPI_Irecv((iterations + (i + j * p) * xres), xres, MPI_FLOAT, i, 0, comm, NULL);
}
}
}
else{
int i;
for(i = 0; i < rows[my_rank]; i++)
MPI_Send((iterations + i *xres), xres, MPI_FLOAT, 0, 0, comm);
}
//reduce max iteration count
long long int total_reduced_iterations = -1;
//printf("rank: %i, total_reduced_iterations: %i\n", my_rank, total_number_iterations);
MPI_Reduce(&total_number_iterations, &total_reduced_iterations, 1, MPI_LONG_LONG_INT, MPI_SUM, 0, comm);
double t4 = MPI_Wtime();
double max_reduced_time = -1;
double total_time = t4 - t0;
MPI_Reduce(&total_time, &max_reduced_time, 1, MPI_DOUBLE, MPI_MAX, 0, comm);
if(my_rank == 0){
printf("np: %i, time: %f , iterations: %lld\n",p, max_reduced_time, total_reduced_iterations);
//printf("%i\t%.2e\n", p, max_reduced_time);
}
//clear
//printf("proc: %i, total time: %lf sec, init: %lf sec, calc: %lf sec, collect: %lf\n", my_rank, t4-t0, t1-t0, t2-t1, t3-t2);
return total_reduced_iterations;
}
void
check_f (void)
{
static const struct {
const char *fmt;
const char *f;
const char *want;
} data[] = {
{ "%Ff", "0", "0.000000" },
{ "%Ff", "123", "123.000000" },
{ "%Ff", "-123", "-123.000000" },
{ "%+Ff", "0", "+0.000000" },
{ "%+Ff", "123", "+123.000000" },
{ "%+Ff", "-123", "-123.000000" },
{ "%.0Ff", "0", "0" },
{ "%.0Ff", "123", "123" },
{ "%.0Ff", "-123", "-123" },
{ "%8.0Ff", "0", " 0" },
{ "%8.0Ff", "123", " 123" },
{ "%8.0Ff", "-123", " -123" },
{ "%08.0Ff", "0", "00000000" },
{ "%08.0Ff", "123", "00000123" },
{ "%08.0Ff", "-123", "-0000123" },
{ "%10.2Ff", "0", " 0.00" },
{ "%10.2Ff", "0.25", " 0.25" },
{ "%10.2Ff", "123.25", " 123.25" },
{ "%10.2Ff", "-123.25", " -123.25" },
{ "%-10.2Ff", "0", "0.00 " },
{ "%-10.2Ff", "0.25", "0.25 " },
{ "%-10.2Ff", "123.25", "123.25 " },
{ "%-10.2Ff", "-123.25", "-123.25 " },
{ "%.2Ff", "0.00000000000001", "0.00" },
{ "%.2Ff", "0.002", "0.00" },
{ "%.2Ff", "0.008", "0.01" },
{ "%.0Ff", "123.00000000000001", "123" },
{ "%.0Ff", "123.2", "123" },
{ "%.0Ff", "123.8", "124" },
{ "%.0Ff", "999999.9", "1000000" },
{ "%.0Ff", "3999999.9", "4000000" },
{ "%Fe", "0", "0.000000e+00" },
{ "%Fe", "1", "1.000000e+00" },
{ "%Fe", "123", "1.230000e+02" },
{ "%FE", "0", "0.000000E+00" },
{ "%FE", "1", "1.000000E+00" },
{ "%FE", "123", "1.230000E+02" },
{ "%Fe", "0", "0.000000e+00" },
{ "%Fe", "1", "1.000000e+00" },
{ "%.0Fe", "10000000000", "1e+10" },
{ "%.0Fe", "-10000000000", "-1e+10" },
{ "%.2Fe", "10000000000", "1.00e+10" },
{ "%.2Fe", "-10000000000", "-1.00e+10" },
{ "%8.0Fe", "10000000000", " 1e+10" },
{ "%8.0Fe", "-10000000000", " -1e+10" },
{ "%-8.0Fe", "10000000000", "1e+10 " },
{ "%-8.0Fe", "-10000000000", "-1e+10 " },
{ "%12.2Fe", "10000000000", " 1.00e+10" },
{ "%12.2Fe", "-10000000000", " -1.00e+10" },
{ "%012.2Fe", "10000000000", "00001.00e+10" },
{ "%012.2Fe", "-10000000000", "-0001.00e+10" },
{ "%Fg", "0", "0" },
{ "%Fg", "1", "1" },
{ "%Fg", "-1", "-1" },
{ "%.0Fg", "0", "0" },
{ "%.0Fg", "1", "1" },
{ "%.0Fg", "-1", "-1" },
{ "%.1Fg", "100", "1e+02" },
{ "%.2Fg", "100", "1e+02" },
{ "%.3Fg", "100", "100" },
{ "%.4Fg", "100", "100" },
{ "%Fg", "0.001", "0.001" },
{ "%Fg", "0.0001", "0.0001" },
{ "%Fg", "0.00001", "1e-05" },
{ "%Fg", "0.000001", "1e-06" },
{ "%.4Fg", "1.00000000000001", "1" },
{ "%.4Fg", "100000000000001", "1e+14" },
{ "%.4Fg", "12345678", "1.235e+07" },
{ "%Fa", "0","0x0p+0" },
{ "%FA", "0","0X0P+0" },
{ "%Fa", "1","0x1p+0" },
{ "%Fa", "65535","0xf.fffp+12" },
{ "%Fa", "65536","0x1p+16" },
{ "%F.10a", "65536","0x1.0000000000p+16" },
{ "%F.1a", "65535","0x1.0p+16" },
{ "%F.0a", "65535","0x1p+16" },
{ "%.2Ff", "0.99609375", "1.00" },
{ "%.Ff", "0.99609375", "0.99609375" },
{ "%.Fe", "0.99609375", "9.9609375e-01" },
{ "%.Fg", "0.99609375", "0.99609375" },
{ "%.20Fg", "1000000", "1000000" },
{ "%.Fg", "1000000", "1000000" },
{ "%#.0Ff", "1", "1." },
{ "%#.0Fe", "1", "1.e+00" },
{ "%#.0Fg", "1", "1." },
{ "%#.1Ff", "1", "1.0" },
{ "%#.1Fe", "1", "1.0e+00" },
{ "%#.1Fg", "1", "1." },
{ "%#.4Ff", "1234", "1234.0000" },
{ "%#.4Fe", "1234", "1.2340e+03" },
{ "%#.4Fg", "1234", "1234." },
{ "%#.8Ff", "1234", "1234.00000000" },
{ "%#.8Fe", "1234", "1.23400000e+03" },
{ "%#.8Fg", "1234", "1234.0000" },
};
int i;
mpf_t f;
double d;
mpf_init2 (f, 256L);
for (i = 0; i < numberof (data); i++)
{
if (data[i].f[0] == '0' && data[i].f[1] == 'x')
mpf_set_str_or_abort (f, data[i].f, 16);
else
mpf_set_str_or_abort (f, data[i].f, 10);
/* if mpf->double doesn't truncate, then expect same result */
d = mpf_get_d (f);
if (mpf_cmp_d (f, d) == 0)
check_plain (data[i].want, data[i].fmt, d);
check_one (data[i].want, data[i].fmt, f);
}
mpf_clear (f);
}
void jarvis_hypercube_approximation
(int C, /* Number of types of customers*/
int N, /* Number of servers */
mpf_t *lambda, /* arrive rate according to a Poisson process per type */
mpf_t **Tao, /* expected service time for service i and customer of node m */
int **a, /* for customers of type m, the list of preferred servers */
mpf_t **f) {
mpf_t Lambda;
mpf_t Rho;
mpf_t tao;
mpf_t *rho;
mpf_t *new_rho;
mpf_t *Q_N_rho;
mpf_t max_change;
mpf_t tmp;
mpf_init(Lambda);
rho = new mpf_t [N];
for (int i = 0; i < N;i++)
mpf_init(rho[i]);
mpf_init(tao);
mpf_init_set_ui(P__0,1);
mpf_init_set_ui(P__N,1);
Q_N_rho = new mpf_t [N];
for (int i = 0;i < N;i++)
mpf_init(Q_N_rho[i]);
new_rho = new mpf_t [N];
for (int i = 0;i < N;i++)
mpf_init(new_rho[i]);
mpf_init(Rho);
mpf_init(max_change);
mpf_init(tmp);
/* INITIALIZE: */
for (int m = 0;m < C;m++)
mpf_add(Lambda,Lambda,lambda[m]);
/* Busy probability rho_i */
for (int i = 0; i < N;i++) {
for (int m = 0; m < C;m++) {
if (a[m][0] == i) {
mpf_mul(tmp,lambda[m],Tao[i][m]);
mpf_add(rho[i],rho[i],tmp);
}
}
}
/* mean service time 'tao' */
for (int m = 0;m < C;m++) {
mpf_mul(tmp,lambda[m],Tao[a[m][0]][m]);
mpf_add(tao,tao,tmp);
}
mpf_div(tao,tao,Lambda);
/* Define intial values for P__0 and P__N */
for (int i = 0;i < N;i++) {
mpf_ui_sub(tmp,1,rho[i]);
mpf_mul(P__0,P__0,tmp);
}
for (int i = 0;i < N;i++)
mpf_mul(P__N,P__N,rho[i]);
/* ITERATION: */
do {
/*
cout << "'rho_i':";
for (int i = 0;i < N;i++) cout << " " << mpf_get_d(rho[i]);
cout << endl;
*/
/* traffic intensity */
mpf_mul(Rho,Lambda,tao);
mpf_div_ui(Rho,Rho,N);
/* Compute Q(N,'rho',k) */
for (int k = 0;k < N;k++)
correction_factor_Q(Q_N_rho[k],N,Rho,k);
/* Compute f_{im} */
mpf_t rho_a_ml;
mpf_init(rho_a_ml);
for (int i = 0;i < N;i++) {
for (int m = 0;m < C;m++) {
mpf_set_ui(rho_a_ml,1);
for (int k = 0;k < N;k++) {
if (a[m][k] == i) {
mpf_ui_sub(tmp,1,rho[i]);
mpf_mul(tmp,tmp,rho_a_ml);
mpf_mul(f[i][m],tmp,Q_N_rho[k]);
break;
}
mpf_mul(rho_a_ml,rho_a_ml,rho[a[m][k]]);
}
}
}
mpf_clear(rho_a_ml);
/* Aproximation of 'rho'_i */
mpf_t Vi;
mpf_init(Vi);
mpf_init(rho_a_ml);
for (int i = 0;i < N;i++) {
mpf_set_ui(Vi,0);
for (int m = 0;m < C;m++) {
mpf_set_ui(rho_a_ml,1);
for (int k = 0;k < N;k++) {
if (a[m][k] == i) {
mpf_mul(tmp,lambda[m],Tao[i][m]);
mpf_mul(tmp,tmp,Q_N_rho[k]);
mpf_mul(tmp,tmp,rho_a_ml);
mpf_add(Vi,Vi,tmp);
/* Vi += lambda[m] * Tao[i][m] * Q_N_rho[k] * rho_a_ml */
break;
}
mpf_mul(rho_a_ml,rho_a_ml,rho[a[m][k]]);
}
}
mpf_add_ui(tmp,Vi,1);
mpf_div(new_rho[i],Vi,tmp);
}
mpf_clear(rho_a_ml);
mpf_clear(Vi);
/* Convergence criterion */
mpf_set_ui(max_change,0);
for (int i = 0;i < N;i++) {
mpf_sub(tmp,rho[i],new_rho[i]);
mpf_abs(tmp,tmp);
if (mpf_cmp(tmp,max_change) > 0)
mpf_set(max_change,tmp);
}
/*
cout << "max change = " << mpf_get_d(max_change);
if (mpf_cmp_d(max_change,JARVIS_EPSILON) < 0)
cout << " **STOP**" << endl;
else
cout << "\r";
*/
if (mpf_cmp_d(max_change,JARVIS_EPSILON) < 0) break; /* STOP */
for (int i = 0;i < N;i++)
mpf_set(rho[i],new_rho[i]);
/* Compute P__0 */
mpf_set_ui(P__0,1);
for (int i = 0;i < N;i++) {
mpf_ui_sub(tmp,1,rho[i]);
mpf_mul(P__0,P__0,tmp);
}
/* Compute P__N */
mpf_t s_rho;
mpf_init(s_rho);
for (int i = 0;i < N;i++)
mpf_add(s_rho,s_rho,rho[i]);
mpf_div_ui(tmp,s_rho,N);
mpf_div(tmp,tmp,Rho);
mpf_ui_sub(P__N,1,tmp);
/* Compute mean service time 'tao' */
mpf_t aux;
mpf_set_ui(tao,0);
mpf_init(aux);
for (int m = 0;m < C;m++) {
mpf_set_ui(tmp,0);
for (int i = 0;i < N;i++) {
mpf_mul(aux,Tao[i][m],f[i][m]);
mpf_add(tmp,tmp,aux);
}
mpf_mul(tmp,lambda[m],tmp);
mpf_add(tao,tao,tmp);
}
mpf_div(tao,tao,Lambda); // / Lambda
mpf_ui_sub(aux,1,P__N); // 1 - P__N
mpf_div(tao,tao,aux); // / (1 - P__N)
mpf_clear(aux);
} while (1);
/*
cout << "finsh jarvis" << endl;
for (int i = 0;i < N;i++) {
for (int m = 0;m < C;m++) {
cout << mpf_get_d(f[i][m]) << " ";
}
cout << endl;
}
*/
mpf_clear(tmp);
mpf_clear(max_change);
mpf_clear(Rho);
for (int i = 0;i < N;i++)
mpf_clear(new_rho[i]);
delete [] new_rho;
for (int i = 0;i < N;i++)
mpf_clear(Q_N_rho[i]);
delete [] Q_N_rho;
mpf_clear(P__N);
mpf_clear(P__0);
mpf_clear(tao);
for (int i = 0;i < N;i++)
mpf_clear(rho[i]);
delete [] rho;
mpf_clear(Lambda);
}
void
check_input (void)
{
static const char *point[] = {
".", ",", "WU", "STR", "ZTV***"
};
static const struct {
const char *str;
double d;
} data[] = {
{ "1%s", 1.0 },
{ "1%s0", 1.0 },
{ "1%s00", 1.0 },
{ "%s5", 0.5 },
{ "0%s5", 0.5 },
{ "00%s5", 0.5 },
{ "00%s50", 0.5 },
{ "1%s5", 1.5 },
{ "1%s5e1", 15.0 },
};
int i, j, neg, ret;
char str[128];
mpf_t f;
double d;
mpf_init (f);
for (i = 0; i < numberof (point); i++)
{
decimal_point = (const char *) point[i];
for (neg = 0; neg <= 1; neg++)
{
for (j = 0; j < numberof (data); j++)
{
strcpy (str, neg ? "-" : "");
sprintf (str+strlen(str), data[j].str, decimal_point);
d = data[j].d;
if (neg)
d = -d;
mpf_set_d (f, 123.0);
if (mpf_set_str (f, str, 10) != 0)
{
printf ("mpf_set_str error\n");
printf (" point %s\n", decimal_point);
printf (" str %s\n", str);
abort ();
}
if (mpf_cmp_d (f, d) != 0)
{
printf ("mpf_set_str wrong result\n");
printf (" point %s\n", decimal_point);
printf (" str %s\n", str);
mpf_trace (" f", f);
printf (" d=%g\n", d);
abort ();
}
mpf_set_d (f, 123.0);
ret = gmp_sscanf (str, "%Ff", f);
if (ret != 1)
{
printf ("gmp_sscanf wrong return value\n");
printf (" point %s\n", decimal_point);
printf (" str %s\n", str);
printf (" ret %d\n", ret);
abort ();
}
if (mpf_cmp_d (f, d) != 0)
{
printf ("gmp_sscanf wrong result\n");
printf (" point %s\n", decimal_point);
printf (" str %s\n", str);
mpf_trace (" f", f);
printf (" d=%g\n", d);
abort ();
}
}
}
}
mpf_clear (f);
}
