static double sprow_ip(const SPROW *row1, const SPROW *row2, int lim)
#endif
{
int idx1, idx2, len1, len2, tmp;
register row_elt *elts1, *elts2;
register Real sum;
elts1 = row1->elt; elts2 = row2->elt;
len1 = row1->len; len2 = row2->len;
sum = 0.0;
if ( len1 <= 0 || len2 <= 0 )
return 0.0;
if ( elts1->col >= lim || elts2->col >= lim )
return 0.0;
/* use sprow_idx() to speed up inner product where one row is
much longer than the other */
idx1 = idx2 = 0;
if ( len1 > 2*len2 )
{
idx1 = sprow_idx(row1,elts2->col);
idx1 = (idx1 < 0) ? -(idx1+2) : idx1;
if ( idx1 < 0 )
error(E_UNKNOWN,"sprow_ip");
len1 -= idx1;
}
else if ( len2 > 2*len1 )
{
idx2 = sprow_idx(row2,elts1->col);
idx2 = (idx2 < 0) ? -(idx2+2) : idx2;
if ( idx2 < 0 )
error(E_UNKNOWN,"sprow_ip");
len2 -= idx2;
}
if ( len1 <= 0 || len2 <= 0 )
return 0.0;
elts1 = &(elts1[idx1]); elts2 = &(elts2[idx2]);
for ( ; ; ) /* forever do... */
{
if ( (tmp=elts1->col-elts2->col) < 0 )
{
len1--; elts1++;
if ( ! len1 || elts1->col >= lim )
break;
}
else if ( tmp > 0 )
{
len2--; elts2++;
if ( ! len2 || elts2->col >= lim )
break;
}
else
{
sum += elts1->val * elts2->val;
len1--; elts1++;
len2--; elts2++;
if ( ! len1 || ! len2 ||
elts1->col >= lim || elts2->col >= lim )
break;
}
}
return sum;
}
SPMAT *spLUfactor(SPMAT *A, PERM *px, double alpha)
#endif
{
int i, best_i, k, idx, len, best_len, m, n;
SPROW *r, *r_piv, tmp_row;
STATIC SPROW *merge = (SPROW *)NULL;
Real max_val, tmp;
STATIC VEC *col_vals=VNULL;
if ( ! A || ! px )
error(E_NULL,"spLUfctr");
if ( alpha <= 0.0 || alpha > 1.0 )
error(E_RANGE,"alpha in spLUfctr");
if ( px->size <= A->m )
px = px_resize(px,A->m);
px_ident(px);
col_vals = v_resize(col_vals,A->m);
MEM_STAT_REG(col_vals,TYPE_VEC);
m = A->m; n = A->n;
if ( ! A->flag_col )
sp_col_access(A);
if ( ! A->flag_diag )
sp_diag_access(A);
A->flag_col = A->flag_diag = FALSE;
if ( ! merge ) {
merge = sprow_get(20);
MEM_STAT_REG(merge,TYPE_SPROW);
}
for ( k = 0; k < n; k++ )
{
/* find pivot row/element for partial pivoting */
/* get first row with a non-zero entry in the k-th column */
max_val = 0.0;
for ( i = k; i < m; i++ )
{
r = &(A->row[i]);
idx = sprow_idx(r,k);
if ( idx < 0 )
tmp = 0.0;
else
tmp = r->elt[idx].val;
if ( fabs(tmp) > max_val )
max_val = fabs(tmp);
col_vals->ve[i] = tmp;
}
if ( max_val == 0.0 )
continue;
best_len = n+1; /* only if no possibilities */
best_i = -1;
for ( i = k; i < m; i++ )
{
tmp = fabs(col_vals->ve[i]);
if ( tmp == 0.0 )
continue;
if ( tmp >= alpha*max_val )
{
r = &(A->row[i]);
idx = sprow_idx(r,k);
len = (r->len) - idx;
if ( len < best_len )
{
best_len = len;
best_i = i;
}
}
}
/* swap row #best_i with row #k */
MEM_COPY(&(A->row[best_i]),&tmp_row,sizeof(SPROW));
MEM_COPY(&(A->row[k]),&(A->row[best_i]),sizeof(SPROW));
MEM_COPY(&tmp_row,&(A->row[k]),sizeof(SPROW));
/* swap col_vals entries */
tmp = col_vals->ve[best_i];
col_vals->ve[best_i] = col_vals->ve[k];
col_vals->ve[k] = tmp;
px_transp(px,k,best_i);
r_piv = &(A->row[k]);
for ( i = k+1; i < n; i++ )
{
/* compute and set multiplier */
tmp = col_vals->ve[i]/col_vals->ve[k];
if ( tmp != 0.0 )
sp_set_val(A,i,k,tmp);
else
continue;
/* perform row operations */
merge->len = 0;
r = &(A->row[i]);
sprow_mltadd(r,r_piv,-tmp,k+1,merge,TYPE_SPROW);
idx = sprow_idx(r,k+1);
if ( idx < 0 )
idx = -(idx+2);
/* see if r needs expanding */
if ( r->maxlen < idx + merge->len )
sprow_xpd(r,idx+merge->len,TYPE_SPMAT);
r->len = idx+merge->len;
MEM_COPY((char *)(merge->elt),(char *)&(r->elt[idx]),
merge->len*sizeof(row_elt));
}
}
#ifdef THREADSAFE
sprow_free(merge); V_FREE(col_vals);
#endif
return A;
}
//--------------------------------------------------------------------------
SPMAT *Hqp_IpRedSpBKP::sub_CTC(const PERM *px, SPMAT *Q)
// return Q - _CT * diag(_zw) * _CT'
// read: _CT, _zw
// write: _scale
{
int i, j, j_idx, j_end;
int qi, qj, qj_idx;
SPROW *crow, *qrow;
Real sum, val;
IVEC neigh_header;
IVEC *neigh = &neigh_header;
assert(Q->n == Q->m);
assert((int)px->size == Q->m && Q->m >= _n);
if (!Q->flag_diag)
sp_diag_access(Q);
neigh_header.max_dim = 0;
crow = _CT->row;
for (i=0; i<_n; i++, crow++) {
qrow = Q->row + px->pe[i];
if (crow->len <= 0) {
val = qrow->elt[qrow->diag].val;
_scale->ve[i] = min(1.0, sqrt(-1.0 / val));
}
else {
// calculate diagonal entry
sum = sprow_inprod(crow, _zw, crow);
j_idx = qrow->diag;
val = qrow->elt[j_idx].val -= sum;
_scale->ve[i] = min(1.0, sqrt(-1.0 / val));
// calculate resting entries
neigh->ive = _CTC_neighs->ive + _CTC_neigh_start->ive[i];
neigh->dim = _CTC_neigh_start->ive[i + 1] - _CTC_neigh_start->ive[i];
j_end = neigh->dim;
for (j_idx = 0; j_idx < j_end; j_idx++) {
j = neigh->ive[j_idx];
if (j < i) {
sum = sprow_inprod(crow, _zw, _CT->row + j);
qi = px->pe[i];
qj = px->pe[j];
// substract sum from Qij or Qji (entry from upper part only)
if (qi < qj) {
qrow = Q->row + qi;
qj_idx = sprow_idx(qrow, qj);
if (qj_idx < 0) {
// the structure must already have been allocated in init()
m_error(E_INTERN, "Hqp_IpRedSpBKP");
}
else {
qrow->elt[qj_idx].val -= sum;
}
}
else {
qrow = Q->row + qj;
qj_idx = sprow_idx(qrow, qi);
if (qj_idx < 0) {
// the structure must already have been allocated in init()
m_error(E_INTERN, "Hqp_IpRedSpBKP");
}
else {
qrow->elt[qj_idx].val -= sum;
}
}
}
}
}
}
return Q;
}
SPMAT *spILUfactor(SPMAT *A, double alpha)
#endif
{
int i, k, idx, idx_piv, m, n, old_idx, old_idx_piv;
SPROW *r, *r_piv;
Real piv_val, tmp;
/* printf("spILUfactor: entered\n"); */
if ( ! A )
error(E_NULL,"spILUfactor");
if ( alpha < 0.0 )
error(E_RANGE,"[alpha] in spILUfactor");
m = A->m; n = A->n;
sp_diag_access(A);
sp_col_access(A);
for ( k = 0; k < n; k++ )
{
/* printf("spILUfactor(l.%d): checkpoint A: k = %d\n",__LINE__,k); */
/* printf("spILUfactor(l.%d): A =\n", __LINE__); */
/* sp_output(A); */
r_piv = &(A->row[k]);
idx_piv = r_piv->diag;
if ( idx_piv < 0 )
{
sprow_set_val(r_piv,k,alpha);
idx_piv = sprow_idx(r_piv,k);
}
/* printf("spILUfactor: checkpoint B\n"); */
if ( idx_piv < 0 )
error(E_BOUNDS,"spILUfactor");
old_idx_piv = idx_piv;
piv_val = r_piv->elt[idx_piv].val;
/* printf("spILUfactor: checkpoint C\n"); */
if ( fabs(piv_val) < alpha )
piv_val = ( piv_val < 0.0 ) ? -alpha : alpha;
if ( piv_val == 0.0 ) /* alpha == 0.0 too! */
error(E_SING,"spILUfactor");
/* go to next row with a non-zero in this column */
i = r_piv->elt[idx_piv].nxt_row;
old_idx = idx = r_piv->elt[idx_piv].nxt_idx;
while ( i >= k )
{
/* printf("spILUfactor: checkpoint D: i = %d\n",i); */
/* perform row operations */
r = &(A->row[i]);
/* idx = sprow_idx(r,k); */
/* printf("spLUfactor(l.%d) i = %d, idx = %d\n",
__LINE__, i, idx); */
if ( idx < 0 )
{
idx = r->elt[old_idx].nxt_idx;
i = r->elt[old_idx].nxt_row;
continue;
}
/* printf("spILUfactor: checkpoint E\n"); */
/* compute and set multiplier */
r->elt[idx].val = tmp = r->elt[idx].val/piv_val;
/* printf("spILUfactor: piv_val = %g, multiplier = %g\n",
piv_val, tmp); */
/* printf("spLUfactor(l.%d) multiplier = %g\n", __LINE__, tmp); */
if ( tmp == 0.0 )
{
idx = r->elt[old_idx].nxt_idx;
i = r->elt[old_idx].nxt_row;
continue;
}
/* idx = sprow_idx(r,k+1); */
/* if ( idx < 0 )
idx = -(idx+2); */
idx_piv++; idx++; /* now look beyond the multiplier entry */
/* printf("spILUfactor: checkpoint F: idx = %d, idx_piv = %d\n",
idx, idx_piv); */
while ( idx_piv < r_piv->len && idx < r->len )
{
/* printf("spILUfactor: checkpoint G: idx = %d, idx_piv = %d\n",
idx, idx_piv); */
if ( r_piv->elt[idx_piv].col < r->elt[idx].col )
idx_piv++;
else if ( r_piv->elt[idx_piv].col > r->elt[idx].col )
idx++;
else /* column numbers match */
{
/* printf("spILUfactor(l.%d) subtract %g times the ",
__LINE__, tmp); */
/* printf("(%d,%d) entry to the (%d,%d) entry\n",
k, r_piv->elt[idx_piv].col,
i, r->elt[idx].col); */
r->elt[idx].val -= tmp*r_piv->elt[idx_piv].val;
idx++; idx_piv++;
}
}
/* bump to next row with a non-zero in column k */
/* printf("spILUfactor(l.%d) column = %d, row[%d] =\n",
__LINE__, r->elt[old_idx].col, i); */
/* sprow_foutput(stdout,r); */
i = r->elt[old_idx].nxt_row;
old_idx = idx = r->elt[old_idx].nxt_idx;
/* printf("spILUfactor(l.%d) i = %d, idx = %d\n", __LINE__, i, idx); */
/* and restore idx_piv to index of pivot entry */
idx_piv = old_idx_piv;
}
}
/* printf("spILUfactor: exiting\n"); */
return A;
}
