int solver2(
int m, /* number of constraints */
int N, /* number of variables */
int nz, /* number of nonzeros in sparse constraint matrix */
int *ia, /* array row indices */
int *ka, /* array of indices into ia and a */
double *a, /* array of nonzeros in the constraint matrix */
double *b, /* right-hand side */
double *c, /* objective coefficients */
double *c2, /* objective coefficients */
double f, /* objective function shift */
int *basics,
int *nonbasics,
int *basicflag,
int *freevars,
int d1,
int d2,
double **BETAhat
)
{
double *x_B; /* primal basics */
double *y_N; /* dual nonbasics */
double *xbar_B; /* primal basic perturbation */
double *ybar_N; /* dual nonbasic perturbation */
double *dy_N; /* dual basics step direction - values (sparse) */
int *idy_N; /* dual basics step direction - row indices */
int ndy_N; /* number of nonz in dy_N */
double *dx_B; /* primal basics step direction - values (sparse) */
int *idx_B; /* primal basics step direction - row indices */
int ndx_B; /* number of nonz in dx_B */
double *at; /* sparse data structure for A^T */
int *iat;
int *kat;
int col_in; /* entering column; index in 'nonbasics' */
int col_out; /* leaving column; index in 'basics' */
int iter = 0; /* number of iterations */
int i,j,k,n,v=0, j1,j2,ii;
double s, t, sbar, tbar, mu=HUGE_VAL, old_mu, primal_obj;
double *vec;
int *ivec;
int nvec;
int status=0;
int from_scratch;
/*******************************************************************
* For convenience, we put...
*******************************************************************/
int n0 = d1*d2;
n = N-m;
/*******************************************************************
* Read in the Data and initialize the common memory sites.
*******************************************************************/
CALLOC( x_B, m, double );
CALLOC( xbar_B, m, double );
CALLOC( dx_B, m, double );
CALLOC( y_N, n, double );
CALLOC( ybar_N, n, double );
CALLOC( dy_N, n, double );
CALLOC( vec, N, double );
CALLOC( idx_B, m, int );
CALLOC( idy_N, n, int );
CALLOC( ivec, N, int );
CALLOC( at, nz, double );
CALLOC( iat, nz, int );
CALLOC( kat, m+1, int );
/****************************************************************
* Initialization. *
****************************************************************/
atnum(m,N,ka,ia,a,kat,iat,at);
lufac( m, ka, ia, a, basics, 0);
for (j=0; j<n; j++) {
y_N[j] = 0;
}
nvec = 0;
for (i=0; i<m; i++) {
if (c[basics[i]] != 0.0) {
vec[nvec] = c[basics[i]];
ivec[nvec] = i;
nvec++;
}
}
btsolve( m, vec, ivec, &nvec );
Nt_times_y( N, at, iat, kat, basicflag, vec, ivec, nvec,
dy_N, idy_N, &ndy_N );
for (k=0; k<ndy_N; k++) {
y_N[idy_N[k]] = dy_N[k];
}
for (j=0; j<n; j++) {
y_N[j] -= c[nonbasics[j]];
}
for (j=0; j<n; j++) {
ybar_N[j] = 0;
}
nvec = 0;
for (i=0; i<m; i++) {
if (c2[basics[i]] != 0.0) {
vec[nvec] = c2[basics[i]];
ivec[nvec] = i;
nvec++;
}
}
btsolve( m, vec, ivec, &nvec );
Nt_times_y( N, at, iat, kat, basicflag, vec, ivec, nvec,
dy_N, idy_N, &ndy_N );
for (k=0; k<ndy_N; k++) {
ybar_N[idy_N[k]] = dy_N[k];
}
for (j=0; j<n; j++) {
ybar_N[j] -= c2[nonbasics[j]];
if (ybar_N[j] < 0) printf("error: ybar_N[%d] = %e \n", j, ybar_N[j]);
}
for (i=0; i<m; i++) {
x_B[i] = 0;
xbar_B[i] = 0;
}
nvec = 0;
for (i=0; i<m; i++) {
if ( b[i] != 0.0 ) {
vec[nvec] = b[i];
ivec[nvec] = i;
nvec++;
}
}
bsolve( m, vec, ivec, &nvec );
for (i=0; i<nvec; i++) {
x_B[ivec[i]] = vec[i];
if (vec[i] < 0) printf("error: x_B[%d] = %e \n", i, vec[i]);
}
/*
printf ("m = %d,n = %d,nz = %d\n",m,N,nz);
printf(
"---------------------------------------------------------------------------\n"
" | Primal | | arithmetic \n"
" Iter | Obj Value | mu | nonz(L) nonz(U) operations \n"
"- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -\n"
);*/
/****************************************************************
* Main loop *
****************************************************************/
for (iter=0; iter<MAX_ITER; iter++) {
/*************************************************************
* STEP 1: Find mu *
*************************************************************/
old_mu = mu;
mu = -HUGE_VAL;
col_in = -1;
for (j=0; j<n; j++) {
if (ybar_N[j] > EPS2) {
if ( mu < -y_N[j]/ybar_N[j] ) {
mu = -y_N[j]/ybar_N[j];
col_in = j;
}
}
}
col_out = -1;
for (i=0; i<m; i++) {
if (freevars[basics[i]] == 0) {
if (xbar_B[i] > EPS2) {
if ( mu < -x_B[i]/xbar_B[i] ) {
mu = -x_B[i]/xbar_B[i];
col_out = i;
col_in = -1;
}
}
}
}
/*************************************************************
* STEP 0: Record current portfolio *
*************************************************************/
primal_obj = sdotprod(c,x_B,basics,m) + f;
if ( mu <= EPS3 || primal_obj > -EPS0) { /* OPTIMAL */
for (j1=0; j1<d1; j1++) {
for (j2=0; j2<d2; j2++) {
BETAhat[j1][j2] = 0;
}
}
for (i=0; i<m; i++) {
if (basics[i] < n0 && x_B[i] > EPS0) {
ii = basics[i];
j1 = ii%d1;
j2 = ii/d1;
BETAhat[j1][j2] = x_B[i];
}
else if (basics[i] < 2*n0 && x_B[i] > EPS0) {
ii = basics[i]-n0;
j1 = ii%d1;
j2 = ii/d1;
BETAhat[j1][j2] = -x_B[i];
}
}
for (j1=0; j1<d1; j1++) {
for (j2=0; j2<d2; j2++) {
if (ABS(BETAhat[j1][j2]) > 1e-5) {
}
}
}
status = 0;
break;
}
if ( col_out >= 0 ) {
/*************************************************************
* -1 T *
* STEP 2: Compute dy = -(B N) e *
* N i *
* where i = col_out *
*************************************************************/
vec[0] = -1.0;
ivec[0] = col_out;
nvec = 1;
btsolve( m, vec, ivec, &nvec );
Nt_times_y( N, at, iat, kat, basicflag, vec, ivec, nvec,
dy_N, idy_N, &ndy_N );
/*************************************************************
* STEP 3: Ratio test to find entering column *
*************************************************************/
col_in = ratio_test2( dy_N, idy_N, ndy_N, y_N, ybar_N, mu );
if (col_in == -1) { /* INFEASIBLE*/
status = 2;
printf("infeasible \n");
break;
}
/*************************************************************
* -1 *
* STEP 4: Compute dx = B N e *
* B j *
* *
*************************************************************/
j = nonbasics[col_in];
for (i=0, k=ka[j]; k<ka[j+1]; i++, k++) {
dx_B[i] = a[k];
idx_B[i] = ia[k];
}
ndx_B = i;
bsolve( m, dx_B, idx_B, &ndx_B );
} else {
/*************************************************************
* -1 *
* STEP 2: Compute dx = B N e *
* B j *
*************************************************************/
j = nonbasics[col_in];
for (i=0, k=ka[j]; k<ka[j+1]; i++, k++) {
dx_B[i] = a[k];
idx_B[i] = ia[k];
}
ndx_B = i;
bsolve( m, dx_B, idx_B, &ndx_B );
/*************************************************************
* STEP 3: Ratio test to find leaving column *
*************************************************************/
col_out = ratio_test( dx_B, idx_B, ndx_B, x_B, xbar_B, basics, freevars, mu );
if (col_out == -1) { /* UNBOUNDED */
status = 1;
printf("unbounded \n");
break;
}
/*************************************************************
* -1 T *
* STEP 4: Compute dy = -(B N) e *
* N i *
* *
*************************************************************/
vec[0] = -1.0;
ivec[0] = col_out;
nvec = 1;
btsolve( m, vec, ivec, &nvec );
Nt_times_y( N, at, iat, kat, basicflag, vec, ivec, nvec,
dy_N, idy_N, &ndy_N );
}
/*************************************************************
* *
* STEP 5: Put t = x /dx *
* i i *
* _ _ *
* t = x /dx *
* i i *
* s = y /dy *
* j j *
* _ _ *
* s = y /dy *
* j j *
*************************************************************/
for (k=0; k<ndx_B; k++) if (idx_B[k] == col_out) break;
t = x_B[col_out]/dx_B[k];
tbar = xbar_B[col_out]/dx_B[k];
for (k=0; k<ndy_N; k++) if (idy_N[k] == col_in) break;
s = y_N[col_in]/dy_N[k];
sbar = ybar_N[col_in]/dy_N[k];
/*************************************************************
* _ _ _ *
* STEP 7: Set y = y - s dy y = y - s dy *
* N N N N N N *
* _ _ *
* y = s y = s *
* i i *
* _ _ _ *
* x = x - t dx x = x - t dx *
* B B B B B B *
* _ _ *
* x = t x = t *
* j j *
*************************************************************/
for (k=0; k<ndy_N; k++) {
j = idy_N[k];
y_N[j] -= s *dy_N[k];
ybar_N[j] -= sbar*dy_N[k];
}
y_N[col_in] = s;
ybar_N[col_in] = sbar;
for (k=0; k<ndx_B; k++) {
i = idx_B[k];
x_B[i] -= t *dx_B[k];
xbar_B[i] -= tbar*dx_B[k];
}
x_B[col_out] = t;
xbar_B[col_out] = tbar;
/*************************************************************
* STEP 8: Update basis *
*************************************************************/
i = basics[col_out];
j = nonbasics[col_in];
basics[col_out] = j;
nonbasics[col_in] = i;
basicflag[i] = -col_in-1;
basicflag[j] = col_out;
/*************************************************************
* STEP 9: Refactor basis and print statistics *
*************************************************************/
from_scratch = refactor( m, ka, ia, a, basics, col_out, v);
if (from_scratch) {
primal_obj = sdotprod(c,x_B,basics,m) + f;
/* printf("%8d %14.7e %9.2e \n", iter, high(primal_obj), high(mu));
fflush(stdout);*/
}
}
primal_obj = sdotprod(c,x_B,basics,m) + f;
/****************************************************************
* Transcribe solution to x vector and dual solution to y *
****************************************************************/
/****************************************************************
* Split out slack variables and shift dual variables.
****************************************************************/
/****************************************************************
* Free work space *
****************************************************************/
Nt_times_y(-1, at, iat, kat, basicflag, vec, ivec, nvec, dy_N, idy_N, &ndy_N);
FREE(at);
FREE(iat);
FREE(xbar_B);
FREE(kat);
FREE(ybar_N);
lu_clo();
btsolve(0, vec, ivec, &nvec);
bsolve(0, vec, ivec, &nvec);
FREE( vec );
FREE( ivec );
FREE( x_B );
FREE( y_N );
FREE( dx_B );
FREE(idx_B );
FREE( dy_N );
FREE(idy_N );
FREE( nonbasics );
FREE( basics );
return status;
} /* End of solver */
/* Report the traditional tableau corresponding to the current basis */
MYBOOL REPORT_tableau(lprec *lp)
{
int j, row_nr, *coltarget;
LPSREAL *prow = NULL;
FILE *stream = lp->outstream;
if(lp->outstream == NULL)
return(FALSE);
if(!lp->model_is_valid || !has_BFP(lp) ||
(get_total_iter(lp) == 0) || (lp->spx_status == NOTRUN)) {
lp->spx_status = NOTRUN;
return(FALSE);
}
if(!allocREAL(lp, &prow,lp->sum + 1, TRUE)) {
lp->spx_status = NOMEMORY;
return(FALSE);
}
fprintf(stream, "\n");
fprintf(stream, "Tableau at iter %.0f:\n", (double) get_total_iter(lp));
for(j = 1; j <= lp->sum; j++)
if (!lp->is_basic[j])
fprintf(stream, "%15d", (j <= lp->rows ?
(j + lp->columns) * ((lp->orig_upbo[j] == 0) ||
(is_chsign(lp, j)) ? 1 : -1) : j - lp->rows) *
(lp->is_lower[j] ? 1 : -1));
fprintf(stream, "\n");
coltarget = (int *) mempool_obtainVector(lp->workarrays, lp->columns+1, sizeof(*coltarget));
if(!get_colIndexA(lp, SCAN_USERVARS+USE_NONBASICVARS, coltarget, FALSE)) {
mempool_releaseVector(lp->workarrays, (char *) coltarget, FALSE);
return(FALSE);
}
for(row_nr = 1; (row_nr <= lp->rows + 1); row_nr++) {
if (row_nr <= lp->rows)
fprintf(stream, "%3d", (lp->var_basic[row_nr] <= lp->rows ?
(lp->var_basic[row_nr] + lp->columns) * ((lp->orig_upbo[lp->var_basic [row_nr]] == 0) ||
(is_chsign(lp, lp->var_basic[row_nr])) ? 1 : -1) : lp->var_basic[row_nr] - lp->rows) *
(lp->is_lower[lp->var_basic [row_nr]] ? 1 : -1));
else
fprintf(stream, " ");
bsolve(lp, row_nr <= lp->rows ? row_nr : 0, prow, NULL, lp->epsmachine*DOUBLEROUND, 1.0);
prod_xA(lp, coltarget, prow, NULL, lp->epsmachine, 1.0,
prow, NULL, MAT_ROUNDDEFAULT);
for(j = 1; j <= lp->rows + lp->columns; j++)
if (!lp->is_basic[j])
fprintf(stream, "%15.7f", prow[j] * (lp->is_lower[j] ? 1 : -1) *
(row_nr <= lp->rows ? 1 : -1));
fprintf(stream, "%15.7f", lp->rhs[row_nr <= lp->rows ? row_nr : 0] *
(double) ((row_nr <= lp->rows) || (is_maxim(lp)) ? 1 : -1));
fprintf(stream, "\n");
}
fflush(stream);
mempool_releaseVector(lp->workarrays, (char *) coltarget, FALSE);
FREE(prow);
return(TRUE);
}
STATIC void updatePricer(lprec *lp, int rownr, int colnr, REAL *pcol, REAL *prow, int *nzprow)
{
REAL *vEdge = NULL, cEdge, hold, *newEdge, *w = NULL;
int i, m, n, exitcol, errlevel = DETAILED;
MYBOOL forceRefresh = FALSE, isDual, isDEVEX;
if(!applyPricer(lp))
return;
/* Make sure we have something to update */
hold = lp->edgeVector[0];
if(hold < 0)
return;
isDual = (MYBOOL) (hold > 0);
/* Do common initializations and computations */
m = lp->rows;
n = lp->sum;
isDEVEX = is_piv_rule(lp, PRICER_DEVEX);
exitcol = lp->var_basic[rownr];
/* Solve/copy Bw = a */
/* formWeights(lp, colnr, NULL, &w); Experimental */
formWeights(lp, colnr, pcol, &w);
/* Price norms for the dual simplex - the basic columns */
if(isDual) {
REAL rw;
int targetcol;
/* Don't need to compute cross-products with DEVEX */
if(!isDEVEX) {
allocREAL(lp, &vEdge, m+1, FALSE);
/* Extract the row of the inverse containing the leaving variable
and then form the dot products against the other variables, i.e. "Tau" */
#if 0 /* Extract row explicitly */
bsolve(lp, rownr, vEdge, 0, 0.0);
#else /* Reuse previously extracted row data */
MEMCOPY(vEdge, prow, m+1);
vEdge[0] = 0;
#endif
lp->bfp_ftran_normal(lp, vEdge, NULL);
}
/* Deal with the variable entering the basis to become a new leaving candidate */
cEdge = lp->edgeVector[exitcol];
rw = w[rownr];
hold = 1 / rw;
lp->edgeVector[colnr] = (hold*hold) * cEdge;
/* Possibly adjust initial value in case of Devex */
if(isDEVEX && !DEVEX_ENHANCED && (lp->edgeVector[colnr] < DEVEX_MINVALUE))
lp->edgeVector[colnr] = DEVEX_MINVALUE;
#ifdef Paranoia
if(lp->edgeVector[colnr] <= lp->epsmachine)
report(lp, errlevel, "updatePricer: Invalid dual norm %g at entering index %d - iteration %d\n",
lp->edgeVector[colnr], rownr, lp->total_iter+lp->current_iter);
#endif
/* Then loop over all basic variables, but skip the leaving row */
for(i = 1; i <= m; i++) {
if(i == rownr)
continue;
targetcol = lp->var_basic[i];
hold = w[i];
if(hold == 0)
continue;
hold /= rw;
if(fabs(hold) < lp->epsmachine)
continue;
newEdge = &(lp->edgeVector[targetcol]);
*newEdge += (hold*hold) * cEdge;
if(isDEVEX) {
if((*newEdge) > DEVEX_RESTARTLIMIT) {
forceRefresh = TRUE;
break;
}
}
else {
*newEdge -= 2*hold*vEdge[i];
#ifdef xxApplySteepestEdgeMinimum
*newEdge = my_max(*newEdge, hold*hold+1); /* Kludge; use the primal lower bound */
#else
if(*newEdge <= 0) {
report(lp, errlevel, "updatePricer: Invalid dual norm %g at index %d - iteration %d\n",
*newEdge, i, lp->total_iter+lp->current_iter);
forceRefresh = TRUE;
break;
}
#endif
}
}
}
/* Price norms for the primal simplex - the non-basic columns */
else {
REAL *vTemp, *vAlpha, cAlpha;
int *coltarget;
allocREAL(lp, &vTemp, m+1, TRUE);
allocREAL(lp, &vAlpha, n+1, TRUE);
/* Check if we have strategy fallback for the primal */
if(!isDEVEX)
isDEVEX = is_piv_mode(lp, PRICE_PRIMALFALLBACK);
/* Initialize column target array */
coltarget = (int *) mempool_obtainVector(lp->workarrays, lp->sum+1, sizeof(*coltarget));
if(!get_colIndexA(lp, SCAN_ALLVARS+USE_NONBASICVARS, coltarget, FALSE)) {
mempool_releaseVector(lp->workarrays, (char *) coltarget, FALSE);
return;
}
/* Don't need to compute cross-products with DEVEX */
if(!isDEVEX) {
vEdge = (REAL *) calloc((n + 1), sizeof(*vEdge));
/* Compute v and then N'v */
MEMCOPY(vTemp, w, m+1);
bsolve(lp, -1, vTemp, NULL, lp->epsmachine*DOUBLEROUND, 0.0);
vTemp[0] = 0;
prod_xA(lp, coltarget, vTemp, NULL, XRESULT_FREE, lp->epsmachine, 0.0,
vEdge, NULL);
}
/* Compute Sigma and then Alpha */
bsolve(lp, rownr, vTemp, NULL, 0*DOUBLEROUND, 0.0);
vTemp[0] = 0;
prod_xA(lp, coltarget, vTemp, NULL, XRESULT_FREE, lp->epsmachine, 0.0,
vAlpha, NULL);
mempool_releaseVector(lp->workarrays, (char *) coltarget, FALSE);
/* Update the squared steepest edge norms; first store some constants */
cEdge = lp->edgeVector[colnr];
cAlpha = vAlpha[colnr];
/* Deal with the variable leaving the basis to become a new entry candidate */
hold = 1 / cAlpha;
lp->edgeVector[exitcol] = (hold*hold) * cEdge;
/* Possibly adjust initial value in case of Devex */
if(isDEVEX && !DEVEX_ENHANCED && (lp->edgeVector[exitcol] < DEVEX_MINVALUE))
lp->edgeVector[exitcol] = DEVEX_MINVALUE;
#ifdef Paranoia
if(lp->edgeVector[exitcol] <= lp->epsmachine)
report(lp, errlevel, "updatePricer: Invalid primal norm %g at leaving index %d - iteration %d\n",
lp->edgeVector[exitcol], exitcol, lp->total_iter+lp->current_iter);
#endif
/* Then loop over all non-basic variables, but skip the entering column */
for(i = 1; i <= lp->sum; i++) {
if(lp->is_basic[i] || (i == colnr))
continue;
hold = vAlpha[i];
if(hold == 0)
continue;
hold /= cAlpha;
if(fabs(hold) < lp->epsmachine)
continue;
newEdge = &(lp->edgeVector[i]);
*newEdge += (hold*hold) * cEdge;
if(isDEVEX) {
if((*newEdge) > DEVEX_RESTARTLIMIT) {
forceRefresh = TRUE;
break;
}
}
else {
*newEdge -= 2*hold*vEdge[i];
#ifdef ApplySteepestEdgeMinimum
*newEdge = my_max(*newEdge, hold*hold+1);
#else
if(*newEdge < 0) {
report(lp, errlevel, "updatePricer: Invalid primal norm %g at index %d - iteration %d\n",
*newEdge, i, lp->total_iter+lp->current_iter);
if(lp->spx_trace)
report(lp, errlevel, "Error detail: (RelAlpha=%g, vEdge=%g, cEdge=%g)\n", hold, vEdge[i], cEdge);
forceRefresh = TRUE;
break;
}
#endif
}
}
FREE(vAlpha);
FREE(vTemp);
}
if(vEdge != NULL)
FREE(vEdge);
freeWeights(w);
if(forceRefresh)
restartPricer(lp, AUTOMATIC);
}
STATIC void restartPricer(lprec *lp, MYBOOL isdual)
{
REAL *sEdge, seNorm, hold;
int i, j, m;
MYBOOL isDEVEX;
if(!applyPricer(lp))
return;
/* Store the active/current pricing type */
if(isdual == AUTOMATIC)
isdual = (MYBOOL) lp->edgeVector[0];
else
lp->edgeVector[0] = isdual;
m = lp->rows;
/* Determine strategy and check if we have strategy fallback for the primal */
isDEVEX = is_piv_rule(lp, PRICER_DEVEX);
if(!isDEVEX && !isdual)
isDEVEX = is_piv_mode(lp, PRICE_PRIMALFALLBACK);
/* Check if we only need to do the simple DEVEX initialization */
if(isDEVEX && !DEVEX_ENHANCED) {
if(isdual) {
for(i = 1; i <= m; i++)
lp->edgeVector[lp->var_basic[i]] = 1.0;
}
else {
for(i = 1; i <= lp->sum; i++)
if(!lp->is_basic[i])
lp->edgeVector[i] = 1.0;
}
return;
}
/* Otherwise do the full Steepest Edge norm initialization */
sEdge = (REAL *) malloc((m + 1) * sizeof(*sEdge));
if(isdual) {
/* Extract the rows of the basis inverse and compute their squared norms */
for(i = 1; i <= m; i++) {
bsolve(lp, i, sEdge, NULL, 0, 0.0);
/* Compute the edge norm */
seNorm = 0;
for(j = 1; j <= m; j++) {
hold = sEdge[j];
seNorm += hold*hold;
}
j = lp->var_basic[i];
lp->edgeVector[j] = seNorm;
}
}
else {
/* Solve a=Bb for b over all non-basic variables and compute their squared norms */
for(i = 1; i <= lp->sum; i++) {
if(lp->is_basic[i])
continue;
fsolve(lp, i, sEdge, NULL, 0, 0.0, FALSE);
/* Compute the edge norm */
seNorm = 1;
for(j = 1; j <= m; j++) {
hold = sEdge[j];
seNorm += hold*hold;
}
lp->edgeVector[i] = seNorm;
}
}
free(sEdge);
}
/* project when (Kx,Kz) != (0,0) */
void increproject(int count, int k, int z, int x0,
func_force_tt force)
{
/* External Variables */
extern int qpts, dimR, dimQ, Nx;
extern double dt, re;
extern double *Kx, *Kz, **K2;
extern mcomplex **IFa, **IFb, **ITM;
extern double **Q, **Qp, **Qpp, **R, **Rp, **Qw, **Qpw, **Rw, **Qs,
**Qps, **Qpps, **Rs, **Rps;
extern double ***M;
extern mcomplex ****IU, ****IC;
extern mcomplex *****MIC;
/* Local variables */
int i, j, x;
double s, t[2];
/* static double a[3] = {29./96., -3./40., 1./6.};
static double b[3] = {37./160., 5./24., 1./6.};
static double c[3] = { 8./15., 5./12., 3./4.};
static double d[3] = { 0., -17./60., -5./12.}; */
static double a[3] = { 1. / 3., -1. / 2, 1. / 3. };
static double b[3] = { 1. / 6, 2. / 3, 0. };
static double c[3] = { 1. / 2, 1. / 3., 1., };
static double d[3] = { 0., -1. / 6, -2. / 3 };
/*static double e[4] = { 4. / 3., -4. / 15., -4. / 15., 4. / 35. };
static double r[8] =
{ -16. / 15., 16. / 35., 32. / 105., -32. / 105., -16. / 315.,
16. / 231., 0., 0. };
static double xx[8] =
{ 8. / 35., -8. / 315., -8. / 105., 8. / 385., 8. / 385.,
-8. / 1001., -8. / 3003., 8. / 6435. };*/
// static double h[3] = { 0., 1./2., 2./3.};
// static double h[3] = { 0., 8./15., 2./3.};
// mcomplex tmp[Nx / 2][dimR], tmp2[Nx / 2][dimQ];
//
// if (force != NULL) {
// force(n, k, z, tmp[0], tmp2[0]);
// }
/* Apply Forcing */
if ((force != NULL)&&(k==0)) {
memset(IFa[0], 0, dimQ * (Nx / 2) * sizeof(mcomplex));
memset(IFb[0], 0, dimR * (Nx / 2) * sizeof(mcomplex));
force(count, k, z, IFa, IFb);
/* form mass matrix, solve for forcing contribution to da/dt */
/* Left hand side M = Mv */
memset(M[0][0], 0, dimR * 9 * (Nx / 2) * sizeof(double));
for (i = 0; i < dimQ; ++i) {
for (j = 0; j < T_QSDIAG; ++j) {
for (x = x0; x < Nx / 2; ++x) {
M[i][j][x] = -(K2[z][x] * Qs[i][j] + Qps[i][j]);
}
}
}
bsolve(M, IFa, QSDIAG - 1, QSDIAG - 1, dimQ, Nx / 2, x0);
/* form mass matrix, solve for forcing contribution to db/dt */
/* Left hand side M = Mv */
memset(M[0][0], 0, dimR * 9 * (Nx / 2) * sizeof(double));
for (i = 0; i < dimR; ++i) {
for (j = 0; j < T_RSDIAG; ++j) {
for (x = x0; x < Nx / 2; ++x) {
M[i][j][x] = Rs[i][j];
}
}
}
bsolve(M, IFb, RSDIAG - 1, RSDIAG - 1, dimR, Nx / 2, x0);
for (x = x0; x < Nx / 2; ++x) {
for (i = 0; i < dimQ; ++i) {
Re(IC[z][ALPHA][i][x]) += dt * Re(IFa[i][x]);
Im(IC[z][ALPHA][i][x]) += dt * Im(IFa[i][x]);
}
for (i = 0; i < dimR; ++i) {
Re(IC[z][BETA][i][x]) += dt * Re(IFb[i][x]);
Im(IC[z][BETA][i][x]) += dt * Im(IFb[i][x]);
}
}
}
memset(IFa[0], 0, dimQ * (Nx / 2) * sizeof(mcomplex));
memset(IFb[0], 0, dimR * (Nx / 2) * sizeof(mcomplex));
/* FIRST COMPUTE ALPHAS */
/* Create matrices for solving linear system.
Right hand side of system: If this is the first step in the Runge-Kutta
scheme, compute
[Mv + (1/RE)a[k]dt*Dv]*C[z][ALPHA] + dt*c[k]Fv.
Otherwise, compute C[z][ALPHA] + dt*c[k]Fv.
Lhs matrix: Mv - (1/RE)b[k]dt*Dv */
if (k == 0) { /* first step */
memset(M[0][0], 0, dimR * 9 * (Nx / 2) * sizeof(double));
for (i = 0; i < dimQ; ++i) { /* M = Mv + (1/RE)a[k]dt*Dv */
for (j = 0; j < T_QSDIAG; ++j) {
for (x = x0; x < Nx / 2; ++x) {
s = K2[z][x] * K2[z][x];
M[i][j][x] = -(K2[z][x] * Qs[i][j] + Qps[i][j]) +
re * a[0] * dt * (s * Qs[i][j] +
2. * K2[z][x] * Qps[i][j] +
Qpps[i][j]);
}
}
}
/* compute [Mv + (1/RE)a[k]dt*Dv]*IC[z][ALPHA] and store the result
in TM. Then transfer the result back to IC[z][ALPHA]. */
smMult(M, IC[z][ALPHA], ITM, QSDIAG - 1, QSDIAG - 1, dimQ, Nx / 2,
x0);
for (i = 0; i < dimQ; ++i) {
memcpy(&IC[z][ALPHA][i][x0], &ITM[i][x0],
(Nx / 2 - x0) * sizeof(mcomplex));
}
}
/* Left hand side M = Mv - (1/RE)b[k]dt*Dv */
memset(M[0][0], 0, dimR * 9 * (Nx / 2) * sizeof(double));
for (i = 0; i < dimQ; ++i) {
for (j = 0; j < T_QSDIAG; ++j) {
for (x = x0; x < Nx / 2; ++x) {
s = K2[z][x] * K2[z][x];
M[i][j][x] = -(K2[z][x] * Qs[i][j] + Qps[i][j]) -
re * b[k] * dt * (s * Qs[i][j] +
2. * K2[z][x] * Qps[i][j] +
Qpps[i][j]);
}
}
}
/* Finish computing the right hand size */
/* array IFa */
//memset(IFa[0], 0, dimR * (Nx / 2) * sizeof(mcomplex));
for (i = 0; i < dimQ; ++i) {
for (j = 0; j < qpts; ++j) {
for (x = x0; x < Nx / 2; ++x) {
Re(IFa[i][x]) += (Qpw[i][j] *
(-Kx[x] * Im(IU[z][HXEL][j][x]) -
Kz[z] * Im(IU[z][HZEL][j][x])) -
K2[z][x] * (Qw[i][j] *
Re(IU[z][HYEL][j][x])));
Im(IFa[i][x]) +=
(Qpw[i][j] *
(Kx[x] * Re(IU[z][HXEL][j][x]) +
Kz[z] * Re(IU[z][HZEL][j][x])) -
K2[z][x] * (Qw[i][j] * Im(IU[z][HYEL][j][x])));
}
}
}
//if (force != NULL) {
// for (x = x0; x < Nx / 2; ++x) {
// for (i = 0; i < dimQ; ++i) {
// Im(IFa[i][x]) += Im(tmp[x][i]);
// Re(IFa[i][x]) += Re(tmp[x][i]);
// }
// }
//}
for (i = 0; i < dimQ; ++i) {
for (x = x0; x < Nx / 2; ++x) {
Re(IC[z][ALPHA][i][x]) += dt * c[k] * Re(IFa[i][x]);
Im(IC[z][ALPHA][i][x]) += dt * c[k] * Im(IFa[i][x]);
}
}
/* Boundary conditions enforced here (note presence of Uzbt */
/* for (x = x0; x < Nx / 2; ++x) {
for (i = 0; i < 8 && i < dimQ; ++i) {
Re(IC[z][ALPHA][i][x]) +=
(r[i] / 2. - K2[z][x] * xx[i]) * (Re(Uzbt[z][x]) -
Re(Uzb[z][x])) +
dt * re * (a[k] * Re(Uzbt[z][x]) +
b[k] * Re(Uzb[z][x])) * (-K2[z][x] * r[i] +
K2[z][x] * K2[z][x] *
xx[i]);
Im(IC[z][ALPHA][i][x]) +=
(r[i] / 2. - K2[z][x] * xx[i]) * (Im(Uzbt[z][x]) -
Im(Uzb[z][x])) +
dt * re * (a[k] * Im(Uzbt[z][x]) +
b[k] * Im(Uzb[z][x])) * (-K2[z][x] * r[i] +
K2[z][x] * K2[z][x] *
xx[i]);
}
}
*/
/* Compute alphas */
bsolve(M, IC[z][ALPHA], QSDIAG - 1, QSDIAG - 1, dimQ, Nx / 2, x0);
/* NOW COMPUTE BETAS */
/* Create matrices for solving linear system.
Right hand side of system: If this is the first step in the Runge-Kutta
scheme, compute
[Mg + (1/RE)a[k]dt*Dg]*C[z][BETA] + dt*c[k]Fg.
Otherwise, compute C[z][BETA] + dt*c[k]Fg.
Lhs matrix: Mg - (1/RE)b[k]dt*Dg */
if (k == 0) { /* first step */
/* M = Mg + (1/RE)a[k]dt*Dg */
memset(M[0][0], 0, dimR * 9 * (Nx / 2) * sizeof(double));
for (i = 0; i < dimR; ++i) {
for (j = 0; j < T_RSDIAG; ++j) {
for (x = x0; x < Nx / 2; ++x) {
M[i][j][x] = Rs[i][j] -
re * a[0] * dt * (Rps[i][j] + K2[z][x] * Rs[i][j]);
}
}
}
/* compute [Mv + (1/RE)a[k]dt*Dv]*IC[z][BETA] and store the result
in TM. Then transfer the result back to IC[z][ALPHA]. */
smMult(M, IC[z][BETA], ITM, RSDIAG - 1, RSDIAG - 1, dimR, Nx / 2,
x0);
for (i = 0; i < dimR; ++i) {
memcpy(&IC[z][BETA][i][x0], &ITM[i][x0],
(Nx / 2 - x0) * sizeof(mcomplex));
}
}
/* left hand side M = Mg - (1/RE)b[k]dt*Dg */
memset(M[0][0], 0, dimR * 9 * (Nx / 2) * sizeof(double));
for (i = 0; i < dimR; ++i) { /* M = Mg - (1/RE)b[k]dt*Dg */
for (j = 0; j < T_RSDIAG; ++j) {
for (x = x0; x < Nx / 2; ++x) {
M[i][j][x] = Rs[i][j] +
re * b[k] * dt * (Rps[i][j] + K2[z][x] * Rs[i][j]);
}
}
}
/* Finish computing the right hand size */
/* array Fb */
//memset(IFb[0], 0, dimR * (Nx / 2) * sizeof(mcomplex));
for (i = 0; i < dimR; ++i) {
for (j = 0; j < qpts; ++j) {
for (x = x0; x < Nx / 2; ++x) {
Re(IFb[i][x]) += Rw[i][j] *
(-Kz[z] * Im(IU[z][HXEL][j][x]) +
Kx[x] * Im(IU[z][HZEL][j][x]));
Im(IFb[i][x]) +=
Rw[i][j] * (Kz[z] * Re(IU[z][HXEL][j][x]) -
Kx[x] * Re(IU[z][HZEL][j][x]));
}
}
}
// if (force != NULL) {
// for (x = x0; x < Nx / 2; ++x) {
// for (i = 0; i < dimR; ++i) {
// Im(IFb[i][x]) += Im(tmp2[x][i]);
// Re(IFb[i][x]) += Re(tmp2[x][i]);
// }
// }
// }
for (i = 0; i < dimR; ++i) {
for (x = x0; x < Nx / 2; ++x) {
Re(IC[z][BETA][i][x]) += dt * c[k] * Re(IFb[i][x]);
Im(IC[z][BETA][i][x]) += dt * c[k] * Im(IFb[i][x]);
}
}
/* Boundary conditions here: */
/* for (x = x0; x < Nx / 2; ++x) {
for (i = 0; i < 4 && i < dimR; ++i) {
Re(IC[z][BETA][i][x]) +=
e[i] / 2. * (Re(Uxbt[z][x]) - Re(Uxb[z][x])) +
dt * re * (a[k] * Re(Uxbt[z][x]) +
b[k] * Re(Uxb[z][x])) * (-K2[z][x] * e[i] / 2.);
Im(IC[z][BETA][i][x]) +=
e[i] / 2. * (Im(Uxbt[z][x]) - Im(Uxb[z][x])) +
dt * re * (a[k] * Im(Uxbt[z][x]) +
b[k] * Im(Uxb[z][x])) * (-K2[z][x] * e[i] / 2.);
}
}
*/
/* Compute betas */
bsolve(M, IC[z][BETA], RSDIAG - 1, RSDIAG - 1, dimR, Nx / 2, x0);
/* NOW COMPUTE IU HATS */
/* v = uy_hat+c2/4*(1-y)^2*(1+y). */
for (i = 0; i < qpts; ++i) {
memset(&IU[z][YEL][i][x0], 0, (Nx / 2 - x0) * sizeof(mcomplex));
}
for (i = 0; i < qpts; ++i) {
for (x = x0; x < Nx / 2; ++x) {
for (j = 0; j < dimQ; ++j) {
Re(IU[z][YEL][i][x]) += Q[i][j] * Re(IC[z][ALPHA][j][x]);
Im(IU[z][YEL][i][x]) += Q[i][j] * Im(IC[z][ALPHA][j][x]);
}
//Re(IU[z][YEL][i][x]) += Re(Uzb[z][x]) * Vadd[i] / 4.;
//Im(IU[z][YEL][i][x]) += Im(Uzb[z][x]) * Vadd[i] / 4.;
}
}
/* f = -dv/dy and store temporarily in XEL position of array U. */
/*f=-dv/dy-c2/4*(3y^2-2y-1) */
for (i = 0; i < qpts; ++i) {
memset(&IU[z][XEL][i][x0], 0, (Nx / 2 - x0) * sizeof(mcomplex));
}
for (i = 0; i < qpts; ++i) {
for (x = x0; x < Nx / 2; ++x) {
for (j = 0; j < dimQ; ++j) {
Re(IU[z][XEL][i][x]) -= Qp[i][j] * Re(IC[z][ALPHA][j][x]);
Im(IU[z][XEL][i][x]) -= Qp[i][j] * Im(IC[z][ALPHA][j][x]);
}
//Re(IU[z][XEL][i][x]) -= Re(Uzb[z][x]) * Vpadd[i] / 4.;
//Im(IU[z][XEL][i][x]) -= Im(Uzb[z][x]) * Vpadd[i] / 4.;
}
}
/* sum(Q''alpha) and store in DXEL position. */
/*df/dy=d^2 v/dy^2+c2/4*(6y-2)=d^2 v/dy^2+c2/2*(-3+3y+2) */
for (i = 0; i < qpts; ++i) {
memset(&IU[z][DXEL][i][x0], 0, (Nx / 2 - x0) * sizeof(mcomplex));
}
for (i = 0; i < qpts; ++i) {
for (x = x0; x < Nx / 2; ++x) {
for (j = 0; j < dimQ; ++j) {
Re(IU[z][DXEL][i][x]) +=
Qpp[i][j] * Re(IC[z][ALPHA][j][x]);
Im(IU[z][DXEL][i][x]) +=
Qpp[i][j] * Im(IC[z][ALPHA][j][x]);
}
//Re(IU[z][DXEL][i][x]) +=
// Re(Uzb[z][x]) * (-3 * Uadd[i] + 2) / 2.;
//Im(IU[z][DXEL][i][x]) +=
// Im(Uzb[z][x]) * (-3 * Uadd[i] + 2) / 2.;
}
}
/* Compute g = sum(beta*R) and store temporarily in ZEL position of
array U. */
for (i = 0; i < qpts; ++i) {
memset(&IU[z][ZEL][i][x0], 0, (Nx / 2 - x0) * sizeof(mcomplex));
}
for (i = 0; i < qpts; ++i) {
for (x = x0; x < Nx / 2; ++x) {
for (j = 0; j < dimR; ++j) {
Re(IU[z][ZEL][i][x]) += R[i][j] * Re(IC[z][BETA][j][x]);
Im(IU[z][ZEL][i][x]) += R[i][j] * Im(IC[z][BETA][j][x]);
}
//Re(IU[z][ZEL][i][x]) += Re(Uxb[z][x]) * Uadd[i] / 2.;
//Im(IU[z][ZEL][i][x]) += Im(Uxb[z][x]) * Uadd[i] / 2.;
}
}
/* Compute sum(beta*R') and store temporarily in DZEL position of
array IU. */
for (i = 0; i < qpts; ++i) {
memset(&IU[z][DZEL][i][x0], 0, (Nx / 2 - x0) * sizeof(mcomplex));
}
for (i = 0; i < qpts; ++i) {
for (x = x0; x < Nx / 2; ++x) {
for (j = 0; j < dimR; ++j) {
Re(IU[z][DZEL][i][x]) += Rp[i][j] * Re(IC[z][BETA][j][x]);
Im(IU[z][DZEL][i][x]) += Rp[i][j] * Im(IC[z][BETA][j][x]);
}
//Re(IU[z][DZEL][i][x]) += -Re(Uxb[z][x]) / 2.;
//Im(IU[z][DZEL][i][x]) += -Im(Uxb[z][x]) / 2.;
}
}
/* now compute Iux hat, Iuz hat */
for (i = 0; i < qpts; ++i) {
for (x = x0; x < Nx / 2; ++x) {
t[0] = Re(IU[z][XEL][i][x]); /* real part of f */
t[1] = Re(IU[z][ZEL][i][x]); /* real part of g */
Re(IU[z][XEL][i][x]) = (Kx[x] * Im(IU[z][XEL][i][x]) +
Kz[z] * Im(IU[z][ZEL][i][x])) / K2[z][x];
Re(IU[z][ZEL][i][x]) = (-Kx[x] * Im(IU[z][ZEL][i][x]) +
Kz[z] * Im(IU[z][XEL][i][x])) / K2[z][x];
Im(IU[z][XEL][i][x]) =
-(Kx[x] * t[0] + Kz[z] * t[1]) / K2[z][x];
Im(IU[z][ZEL][i][x]) =
(Kx[x] * t[1] - Kz[z] * t[0]) / K2[z][x];
}
}
/* dux hat, duz hat */
for (i = 0; i < qpts; ++i) {
for (x = x0; x < Nx / 2; ++x) {
t[0] = Re(IU[z][DXEL][i][x]); /* real part of Q''alpha */
t[1] = Re(IU[z][DZEL][i][x]); /* real part of R'beta */
Re(IU[z][DXEL][i][x]) = (-Kx[x] * Im(IU[z][DXEL][i][x]) +
Kz[z] * Im(IU[z][DZEL][i][x])) /
K2[z][x];
Re(IU[z][DZEL][i][x]) =
-(Kx[x] * Im(IU[z][DZEL][i][x]) +
Kz[z] * Im(IU[z][DXEL][i][x])) / K2[z][x];
Im(IU[z][DXEL][i][x]) =
(Kx[x] * t[0] - Kz[z] * t[1]) / K2[z][x];
Im(IU[z][DZEL][i][x]) =
(Kx[x] * t[1] + Kz[z] * t[0]) / K2[z][x];
}
}
if (count >= 0) {
for (i = 0; i < dimR; i++) {
for (x = x0; x < Nx / 2; x++) {
Re(MIC[count][z][ALPHA][i][x]) = Re(IC[z][ALPHA][i][x]);
Im(MIC[count][z][ALPHA][i][x]) = Im(IC[z][ALPHA][i][x]);
}
}
for (i = 0; i < dimR; i++) {
for (x = x0; x < Nx / 2; x++) {
Re(MIC[count][z][BETA][i][x]) = Re(IC[z][BETA][i][x]);
Im(MIC[count][z][BETA][i][x]) = Im(IC[z][BETA][i][x]);
}
}
}
/* UPDATE RHS FOR NEXT TIME */
if (k != 2) { /* not last step */
/* first alphas */
memset(M[0][0], 0, dimR * 9 * (Nx / 2) * sizeof(double));
for (i = 0; i < dimQ; ++i) { /* M = Mv + (1/RE)a[k+1]dt*Dv */
for (j = 0; j < T_QSDIAG; ++j) {
for (x = x0; x < Nx / 2; ++x) {
s = K2[z][x] * K2[z][x];
M[i][j][x] = -(K2[z][x] * Qs[i][j] + Qps[i][j]) +
re * a[k + 1] * dt * (s * Qs[i][j] +
2. * K2[z][x] * Qps[i][j] +
Qpps[i][j]);
}
}
}
/* compute [Mv + (1/RE)a[k]dt*Dv]*C[z][ALPHA]. Then update
C[z][ALPHA] */
smMult(M, IC[z][ALPHA], ITM, QSDIAG - 1, QSDIAG - 1, dimQ, Nx / 2,
x0);
for (i = 0; i < dimQ; ++i) {
for (x = x0; x < Nx / 2; ++x) {
Re(IC[z][ALPHA][i][x]) =
Re(ITM[i][x]) + dt * d[k + 1] * Re(IFa[i][x]);
Im(IC[z][ALPHA][i][x]) =
Im(ITM[i][x]) + dt * d[k + 1] * Im(IFa[i][x]);
}
}
/* now betas */
memset(M[0][0], 0, dimR * 9 * (Nx / 2) * sizeof(double));
for (i = 0; i < dimR; ++i) { /* M = Mg + (1/RE)a[k+1]dt*Dg */
for (j = 0; j < T_RSDIAG; ++j) {
for (x = x0; x < Nx / 2; ++x) {
M[i][j][x] = Rs[i][j] -
re * a[k + 1] * dt * (Rps[i][j] +
K2[z][x] * Rs[i][j]);
}
}
}
/* compute [Mg + (1/RE)a[k+1]dt*Dg]*C[z][BETA] and then
update C[z][BETA] */
smMult(M, IC[z][BETA], ITM, RSDIAG - 1, RSDIAG - 1, dimR, Nx / 2,
x0);
for (i = 0; i < dimR; ++i) {
for (x = x0; x < Nx / 2; ++x) {
Re(IC[z][BETA][i][x]) =
Re(ITM[i][x]) + dt * d[k + 1] * Re(IFb[i][x]);
Im(IC[z][BETA][i][x]) =
Im(ITM[i][x]) + dt * d[k + 1] * Im(IFb[i][x]);
}
}
}
}
STATIC MYBOOL restartPricer(lprec *lp, MYBOOL isdual)
{
REAL *sEdge = NULL, seNorm, hold;
int i, j, m;
MYBOOL isDEVEX, ok = applyPricer(lp);
/* Correction from V6, apparently, via Kjell Eikland and the
** lpSolve mailing list 2014-06-18 2:57 p.m. */
if (ok && (lp->edgeVector[0] < 0) && (isdual == AUTOMATIC))
ok = FALSE;
if(!ok)
return( ok );
/* Store the active/current pricing type */
if(isdual == AUTOMATIC)
isdual = (MYBOOL) lp->edgeVector[0];
else
lp->edgeVector[0] = isdual;
m = lp->rows;
/* Determine strategy and check if we have strategy fallback for the primal */
isDEVEX = is_piv_rule(lp, PRICER_DEVEX);
if(!isDEVEX && !isdual)
isDEVEX = is_piv_mode(lp, PRICE_PRIMALFALLBACK);
/* Check if we only need to do the simple DEVEX initialization */
if(!is_piv_mode(lp, PRICE_TRUENORMINIT)) {
if(isdual) {
for(i = 1; i <= m; i++)
lp->edgeVector[lp->var_basic[i]] = 1.0;
}
else {
for(i = 1; i <= lp->sum; i++)
if(!lp->is_basic[i])
lp->edgeVector[i] = 1.0;
}
return( ok );
}
/* Otherwise do the full Steepest Edge norm initialization */
ok = allocREAL(lp, &sEdge, m+1, FALSE);
if(!ok)
return( ok );
if(isdual) {
/* Extract the rows of the basis inverse and compute their squared norms */
for(i = 1; i <= m; i++) {
bsolve(lp, i, sEdge, NULL, 0, 0.0);
/* Compute the edge norm */
seNorm = 0;
for(j = 1; j <= m; j++) {
hold = sEdge[j];
seNorm += hold*hold;
}
j = lp->var_basic[i];
lp->edgeVector[j] = seNorm;
}
}
else {
/* Solve a=Bb for b over all non-basic variables and compute their squared norms */
for(i = 1; i <= lp->sum; i++) {
if(lp->is_basic[i])
continue;
fsolve(lp, i, sEdge, NULL, 0, 0.0, FALSE);
/* Compute the edge norm */
seNorm = 1;
for(j = 1; j <= m; j++) {
hold = sEdge[j];
seNorm += hold*hold;
}
lp->edgeVector[i] = seNorm;
}
}
FREE(sEdge);
return( ok );
}
void solver20(
int m, /* number of constraints */
int n, /* number of variables */
int nz, /* number of nonzeros in sparse constraint matrix */
int *ia, /* array row indices */
int *ka, /* array of indices into ia and a */
double *a, /* array of nonzeros in the constraint matrix */
double *b, /* right-hand side */
double *c /* objective coefficients */
)
{
/*structure of the solver*/
int *basics;
int *nonbasics;
int *basicflag;
double *x_B; /* primal basics */
double *y_N; /* dual nonbasics */
double *xbar_B; /* primal basic perturbation */
double *ybar_N; /* dual nonbasic perturbation*/
double *dy_N; /* dual basics step direction - values (sparse) */
int *idy_N; /* dual basics step direction - row indices */
int ndy_N=0; /* number of nonz in dy_N */
double *dx_B; /* primal basics step direction - values (sparse) */
int *idx_B; /* primal basics step direction - row indices */
int ndx_B; /* number of nonz in dx_B */
double *at; /* sparse data structure for a^t */
int *iat;
int *kat;
int col_in; /* entering column; index in 'nonbasics' */
int col_out; /* leaving column; index in 'basics' */
int iter = 0; /* number of iterations */
int i,j,k,v=0;
double s, t, sbar, tbar, mu=HUGE_VAL;
double *vec;
int *ivec;
int nvec;
int N;
N=m+n;
/*******************************************************************
* read in the data and initialize the common memory sites.
*******************************************************************/
//add the slack variables
i = 0;
k = ka[n];
for (j=n; j<N; j++) {
a[k] = 1.0;
ia[k] = i;
i++;
k++;
ka[j+1] = k;
}
nz = k;
MALLOC( x_B, m, double );
MALLOC( xbar_B, m, double );
MALLOC( dx_B, m, double );
MALLOC( y_N, n, double );
MALLOC( ybar_N, n, double );
MALLOC( dy_N, n, double );
MALLOC( vec, N, double );
MALLOC( ivec, N, int );
MALLOC( idx_B, m, int );
MALLOC( idy_N, n, int );
MALLOC( at, nz, double );
MALLOC( iat, nz, int );
MALLOC( kat, m+1, int );
MALLOC( basics, m, int );
MALLOC( nonbasics, n, int );
MALLOC( basicflag, N, int );
CALLOC( x, N, double );
/****************************************************************
* initialization. *
****************************************************************/
atnum(m,N,ka,ia,a,kat,iat,at);
for (j=0; j<n; j++) {
nonbasics[j] = j;
basicflag[j] = -j-1;
y_N[j] = -c[j];
ybar_N[j] = 1;
}
for (i=0; i<m; i++) {
basics[i] = n+i;
basicflag[n+i] = i;
x_B[i] = b[i];
xbar_B[i] = 1;
}
lufac( m, ka, ia, a, basics, 0 );
for (iter=0; iter<MAX_ITER; iter++) {
/*************************************************************
* step 1: find mu *
*************************************************************/
mu = -HUGE_VAL;
col_in = -1;
for (j=0; j<n; j++) {
if (ybar_N[j] > EPS2) {
if ( mu < -y_N[j]/ybar_N[j] ) {
mu = -y_N[j]/ybar_N[j];
col_in = j;
}
}
}
col_out = -1;
for (i=0; i<m; i++) {
if (xbar_B[i] > EPS2) {
if ( mu < -x_B[i]/xbar_B[i] ) {
mu = -x_B[i]/xbar_B[i];
col_out = i;
col_in = -1;
}
}
}
if ( mu <= lambda0 ) { /* optimal */
status0=0;
break;
}
/*************************************************************
* -1 t *
* step 2: compute dy = -(b n) e *
* n i *
* where i = col_out *
*************************************************************/
if ( col_out >= 0 ) {
vec[0] = -1.0;
ivec[0] = col_out;
nvec = 1;
btsolve( m, vec, ivec, &nvec );
Nt_times_y( N, at, iat, kat, basicflag, vec, ivec, nvec,
dy_N, idy_N, &ndy_N );
col_in = ratio_test0( dy_N, idy_N, ndy_N, y_N, ybar_N,mu );
/*************************************************************
* STEP 3: Ratio test to find entering column *
*************************************************************/
if (col_in == -1) { /* infeasible */
status0 = 1;
break;
}
/*************************************************************
* -1 *
* step 4: compute dx = b n e *
* b j *
* *
*************************************************************/
j = nonbasics[col_in];
for (i=0, k=ka[j]; k<ka[j+1]; i++, k++) {
dx_B[i] = a[k];
idx_B[i] = ia[k];
}
ndx_B = i;
bsolve( m, dx_B, idx_B, &ndx_B );
}
else {
/*************************************************************
* -1 *
* STEP 2: Compute dx = B N e *
* B j *
*************************************************************/
j = nonbasics[col_in];
for (i=0, k=ka[j]; k<ka[j+1]; i++, k++) {
dx_B[i] = a[k];
idx_B[i] = ia[k];
}
ndx_B = i;
bsolve( m, dx_B, idx_B, &ndx_B );
/*************************************************************
* STEP 3: Ratio test to find leaving column *
*************************************************************/
col_out = ratio_test0( dx_B, idx_B, ndx_B, x_B, xbar_B, mu );
if (col_out == -1) { /* UNBOUNDED */
status0 = 2;
break;
}
/*************************************************************
* -1 T *
* STEP 4: Compute dy = -(B N) e *
* N i *
* *
*************************************************************/
vec[0] = -1.0;
ivec[0] = col_out;
nvec = 1;
btsolve( m, vec, ivec, &nvec );
Nt_times_y( N, at, iat, kat, basicflag, vec, ivec, nvec,
dy_N, idy_N, &ndy_N );
}
/*************************************************************
* *
* step 5: put t = x /dx *
* i i *
* _ _ *
* t = x /dx *
* i i *
* s = y /dy *
* j j *
* _ _ *
* s = y /dy *
* j j *
*************************************************************/
for (k=0; k<ndx_B; k++) if (idx_B[k] == col_out) break;
t = x_B[col_out]/dx_B[k];
tbar = xbar_B[col_out]/dx_B[k];
for (k=0; k<ndy_N; k++) if (idy_N[k] == col_in) break;
s = y_N[col_in]/dy_N[k];
sbar = ybar_N[col_in]/dy_N[k];
/*************************************************************
* _ _ _ *
* step 7: set y = y - s dy y = y - s dy *
* n n n n n n *
* _ _ *
* y = s y = s *
* i i *
* _ _ _ *
* x = x - t dx x = x - t dx *
* b b b b b b *
* _ _ *
* x = t x = t *
* j j *
*************************************************************/
for (k=0; k<ndy_N; k++) {
j = idy_N[k];
y_N[j] -= s *dy_N[k];
ybar_N[j] -= sbar*dy_N[k];
}
y_N[col_in] = s;
ybar_N[col_in] = sbar;
for (k=0; k<ndx_B; k++) {
i = idx_B[k];
x_B[i] -= t *dx_B[k];
xbar_B[i] -= tbar*dx_B[k];
}
x_B[col_out] = t;
xbar_B[col_out] = tbar;
/*************************************************************
* step 8: update basis *
*************************************************************/
i = basics[col_out];
j = nonbasics[col_in];
basics[col_out] = j;
nonbasics[col_in] = i;
basicflag[i] = -col_in-1;
basicflag[j] = col_out;
/*************************************************************
* step 9: refactor basis and print statistics *
*************************************************************/
refactor( m, ka, ia, a, basics, col_out, v );
}
for (i=0; i<m; i++) {
x[basics[i]] = x_B[i];
}
if(iter>=1){
Nt_times_y( -1, at, iat, kat, basicflag, vec, ivec, nvec,
dy_N, idy_N, &ndy_N );
}
/****************************************************************
* free work space *
****************************************************************/
FREE( vec );
FREE( ivec );
FREE( x_B );
FREE( y_N );
FREE( dx_B );
FREE(idx_B );
FREE( dy_N );
FREE(idy_N );
FREE(xbar_B);
FREE(ybar_N);
FREE( nonbasics );
FREE( basics );
FREE(at);
FREE(iat);
FREE(basicflag);
FREE(kat);
if(iter>=1){
lu_clo();
btsolve(0, vec, ivec, &nvec);
bsolve(0, vec, ivec, &nvec);
}
}
