static int Find_expired_msgs (LB_struct *lb,
int n_rms, unsigned int onp, int *ind_first)
{
unsigned int cr_num_ptr;
int n_exps, cr_nmsgs, off_first;
cr_num_ptr = lb->hd->num_pt;
cr_nmsgs = GET_NMSG (cr_num_ptr); /* current # msgs */
if (n_rms != N_MSG_RM_COMPU) {
n_exps = n_rms;
off_first = cr_nmsgs;
}
else { /* evaluate number of expired/to-
be_expired msgs */
off_first = GET_NMSG (onp); /* # msgs before expiring */
n_exps = off_first - cr_nmsgs; /* # expired msgs */
if (off_first >= lb->maxn_msgs) /* one more msg will expire
when the new msg is added */
n_exps++;
}
/* find index of the first expired/to-be-expired message */
if (n_exps > 0) {
int ptr;
ptr = GET_POINTER (cr_num_ptr);
*ind_first = (ptr - off_first + lb->n_slots) % lb->n_slots;
/* slot index of the first msg */
}
else /* avoid any negative return */
n_exps = 0;
return (n_exps);
}
static int Find_replace_msgpt (LB_struct *lb, LB_id_t *id)
{
int msgpt, page;
if (*id == LB_ANY) {
static int ss_off = 0; /* circular search offset */
unsigned int num_ptr;
int pt0, cnt, turn, nmsgs, ind;
if (!(lb->hd->miscflags & LB_MSG_DELETED))
return (LB_FAILURE);
num_ptr = lb->hd->num_pt;
nmsgs = GET_NMSG (num_ptr); /* msg number */
pt0 = GET_POINTER(num_ptr) - nmsgs; /* pointer to the first msg */
if (pt0 < 0)
pt0 += lb->ptr_range;
if (nmsgs < lb->maxn_msgs)
return (LB_FAILURE);
cnt = 0;
if (ss_off >= nmsgs)
ss_off = 0;
ind = (pt0 + ss_off) % lb->n_slots;
turn = nmsgs - ss_off;
while (1) { /* search for a 0 size msg */
unsigned int ucnt;
LB_msg_info_t *msginfo;
ucnt = lb->dir[ind].loc;
msginfo = (LB_msg_info_t *)lb->msginfo + DB_WORD_OFFSET (ind, ucnt);
if (msginfo->len < 0) /* found */
break;
cnt++;
if (cnt == turn) /* back to the first msg */
ind = pt0 % lb->n_slots;
if (cnt >= nmsgs) { /* LB is full */
ss_off = (ss_off + cnt) % nmsgs;
return (LB_FAILURE);
}
ind = (ind + 1) % lb->n_slots;
}
ss_off = (ss_off + cnt) % nmsgs;
msgpt = ind;
*id = lb->dir[ind].id + LB_MSG_DB_ID_MASK + 1;
if (*id > LB_MAX_ID)
*id = (lb->dir[ind].id) & LB_MSG_DB_ID_MASK;
lb->dir[ind].id = *id;
}
else if (LB_Search_msg (lb, *id, &msgpt, &page) < 0) /* not found */
return (LB_FAILURE);
lb->prev_id = *id;
if (lb->umid != NULL)
*lb->umid = *id;
return (msgpt);
}
Int KLU_valid_LU (Int n, Int flag_test_start_ptr, Int Xip [ ],
Int Xlen [ ], Unit LU [ ])
{
Int *Xi ;
Entry *Xx ;
Int j, p1, p2, i, p, len ;
PRINTF (("\ncolumn oriented matrix, n = %d\n", n)) ;
if (n <= 0)
{
PRINTF (("n must be >= 0: %d\n", n)) ;
return (FALSE) ;
}
if (flag_test_start_ptr && Xip [0] != 0)
{
/* column pointers must start at Xip [0] = 0*/
PRINTF (("column 0 pointer bad\n")) ;
return (FALSE) ;
}
for (j = 0 ; j < n ; j++)
{
p1 = Xip [j] ;
PRINTF (("\nColumn of factor: %d p1: %d ", j, p1)) ;
if (j < n-1)
{
p2 = Xip [j+1] ;
PRINTF (("p2: %d ", p2)) ;
if (p1 > p2)
{
/* column pointers must be ascending */
PRINTF (("column %d pointer bad\n", j)) ;
return (FALSE) ;
}
}
PRINTF (("\n")) ;
GET_POINTER (LU, Xip, Xlen, Xi, Xx, j, len) ;
for (p = 0 ; p < len ; p++)
{
i = Xi [p] ;
PRINTF (("row: %d", i)) ;
if (i < 0 || i >= n)
{
/* row index out of range */
PRINTF (("index out of range, col %d row %d\n", j, i)) ;
return (FALSE) ;
}
if (Xx != (Entry *) NULL)
{
PRINT_ENTRY (Xx [p]) ;
}
PRINTF (("\n")) ;
}
}
return (TRUE) ;
}
static void lsolve_numeric
(
/* input, not modified on output: */
Int Pinv [ ], /* Pinv [i] = k if i is kth pivot row, or EMPTY if row i
* is not yet pivotal. */
Unit *LU, /* LU factors (pattern and values) */
Int Stack [ ], /* stack for dfs */
Int Lip [ ], /* size n, Lip [k] is position in LU of column k of L */
Int top, /* top of stack on input */
Int n, /* A is n-by-n */
Int Llen [ ], /* size n, Llen [k] = # nonzeros in column k of L */
/* output, must be zero on input: */
Entry X [ ] /* size n, initially zero. On output,
* X [Ui [up1..up-1]] and X [Li [lp1..lp-1]]
* contains the solution. */
)
{
Entry xj ;
Entry *Lx ;
Int *Li ;
Int p, s, j, jnew, len ;
/* solve Lx=b */
for (s = top ; s < n ; s++)
{
/* forward solve with column j of L */
j = Stack [s] ;
jnew = Pinv [j] ;
ASSERT (jnew >= 0) ;
xj = X [j] ;
GET_POINTER (LU, Lip, Llen, Li, Lx, jnew, len) ;
ASSERT (Lip [jnew] <= Lip [jnew+1]) ;
for (p = 0 ; p < len ; p++)
{
/*X [Li [p]] -= Lx [p] * xj ; */
MULT_SUB (X [Li [p]], Lx [p], xj) ;
}
}
}
void KLU_ltsolve
(
/* inputs, not modified: */
Int n,
Int Lip [ ],
Int Llen [ ],
Unit LU [ ],
Int nrhs,
#ifdef COMPLEX
Int conj_solve,
#endif
/* right-hand-side on input, solution to L'x=b on output */
Entry X [ ]
)
{
Entry x [4], lik ;
Int *Li ;
Entry *Lx ;
Int k, p, len, i ;
switch (nrhs)
{
case 1:
for (k = n-1 ; k >= 0 ; k--)
{
GET_POINTER (LU, Lip, Llen, Li, Lx, k, len) ;
x [0] = X [k] ;
for (p = 0 ; p < len ; p++)
{
#ifdef COMPLEX
if (conj_solve)
{
/* x [0] -= CONJ (Lx [p]) * X [Li [p]] ; */
MULT_SUB_CONJ (x [0], X [Li [p]], Lx [p]) ;
}
else
#endif
{
/*x [0] -= Lx [p] * X [Li [p]] ;*/
MULT_SUB (x [0], Lx [p], X [Li [p]]) ;
}
}
X [k] = x [0] ;
}
break ;
case 2:
for (k = n-1 ; k >= 0 ; k--)
{
x [0] = X [2*k ] ;
x [1] = X [2*k + 1] ;
GET_POINTER (LU, Lip, Llen, Li, Lx, k, len) ;
for (p = 0 ; p < len ; p++)
{
i = Li [p] ;
#ifdef COMPLEX
if (conj_solve)
{
CONJ (lik, Lx [p]) ;
}
else
#endif
{
lik = Lx [p] ;
}
MULT_SUB (x [0], lik, X [2*i]) ;
MULT_SUB (x [1], lik, X [2*i + 1]) ;
}
X [2*k ] = x [0] ;
X [2*k + 1] = x [1] ;
}
break ;
case 3:
for (k = n-1 ; k >= 0 ; k--)
{
x [0] = X [3*k ] ;
x [1] = X [3*k + 1] ;
x [2] = X [3*k + 2] ;
GET_POINTER (LU, Lip, Llen, Li, Lx, k, len) ;
for (p = 0 ; p < len ; p++)
{
i = Li [p] ;
#ifdef COMPLEX
if (conj_solve)
{
CONJ (lik, Lx [p]) ;
}
else
#endif
{
lik = Lx [p] ;
}
MULT_SUB (x [0], lik, X [3*i]) ;
MULT_SUB (x [1], lik, X [3*i + 1]) ;
MULT_SUB (x [2], lik, X [3*i + 2]) ;
}
X [3*k ] = x [0] ;
X [3*k + 1] = x [1] ;
X [3*k + 2] = x [2] ;
}
break ;
case 4:
for (k = n-1 ; k >= 0 ; k--)
{
x [0] = X [4*k ] ;
x [1] = X [4*k + 1] ;
x [2] = X [4*k + 2] ;
x [3] = X [4*k + 3] ;
GET_POINTER (LU, Lip, Llen, Li, Lx, k, len) ;
for (p = 0 ; p < len ; p++)
{
i = Li [p] ;
#ifdef COMPLEX
if (conj_solve)
{
CONJ (lik, Lx [p]) ;
}
else
#endif
{
lik = Lx [p] ;
}
MULT_SUB (x [0], lik, X [4*i]) ;
MULT_SUB (x [1], lik, X [4*i + 1]) ;
MULT_SUB (x [2], lik, X [4*i + 2]) ;
MULT_SUB (x [3], lik, X [4*i + 3]) ;
}
X [4*k ] = x [0] ;
X [4*k + 1] = x [1] ;
X [4*k + 2] = x [2] ;
X [4*k + 3] = x [3] ;
}
break ;
}
}
void KLU_usolve
(
/* inputs, not modified: */
Int n,
Int Uip [ ],
Int Ulen [ ],
Unit LU [ ],
Entry Udiag [ ],
Int nrhs,
/* right-hand-side on input, solution to Ux=b on output */
Entry X [ ]
)
{
Entry x [4], uik, ukk ;
Int *Ui ;
Entry *Ux ;
Int k, p, len, i ;
switch (nrhs)
{
case 1:
for (k = n-1 ; k >= 0 ; k--)
{
GET_POINTER (LU, Uip, Ulen, Ui, Ux, k, len) ;
/* x [0] = X [k] / Udiag [k] ; */
DIV (x [0], X [k], Udiag [k]) ;
X [k] = x [0] ;
for (p = 0 ; p < len ; p++)
{
/* X [Ui [p]] -= Ux [p] * x [0] ; */
MULT_SUB (X [Ui [p]], Ux [p], x [0]) ;
}
}
break ;
case 2:
for (k = n-1 ; k >= 0 ; k--)
{
GET_POINTER (LU, Uip, Ulen, Ui, Ux, k, len) ;
ukk = Udiag [k] ;
/* x [0] = X [2*k ] / ukk ;
x [1] = X [2*k + 1] / ukk ; */
DIV (x [0], X [2*k], ukk) ;
DIV (x [1], X [2*k + 1], ukk) ;
X [2*k ] = x [0] ;
X [2*k + 1] = x [1] ;
for (p = 0 ; p < len ; p++)
{
i = Ui [p] ;
uik = Ux [p] ;
/* X [2*i ] -= uik * x [0] ;
X [2*i + 1] -= uik * x [1] ; */
MULT_SUB (X [2*i], uik, x [0]) ;
MULT_SUB (X [2*i + 1], uik, x [1]) ;
}
}
break ;
case 3:
for (k = n-1 ; k >= 0 ; k--)
{
GET_POINTER (LU, Uip, Ulen, Ui, Ux, k, len) ;
ukk = Udiag [k] ;
DIV (x [0], X [3*k], ukk) ;
DIV (x [1], X [3*k + 1], ukk) ;
DIV (x [2], X [3*k + 2], ukk) ;
X [3*k ] = x [0] ;
X [3*k + 1] = x [1] ;
X [3*k + 2] = x [2] ;
for (p = 0 ; p < len ; p++)
{
i = Ui [p] ;
uik = Ux [p] ;
MULT_SUB (X [3*i], uik, x [0]) ;
MULT_SUB (X [3*i + 1], uik, x [1]) ;
MULT_SUB (X [3*i + 2], uik, x [2]) ;
}
}
break ;
case 4:
for (k = n-1 ; k >= 0 ; k--)
{
GET_POINTER (LU, Uip, Ulen, Ui, Ux, k, len) ;
ukk = Udiag [k] ;
DIV (x [0], X [4*k], ukk) ;
DIV (x [1], X [4*k + 1], ukk) ;
DIV (x [2], X [4*k + 2], ukk) ;
DIV (x [3], X [4*k + 3], ukk) ;
X [4*k ] = x [0] ;
X [4*k + 1] = x [1] ;
X [4*k + 2] = x [2] ;
X [4*k + 3] = x [3] ;
for (p = 0 ; p < len ; p++)
{
i = Ui [p] ;
uik = Ux [p] ;
MULT_SUB (X [4*i], uik, x [0]) ;
MULT_SUB (X [4*i + 1], uik, x [1]) ;
MULT_SUB (X [4*i + 2], uik, x [2]) ;
MULT_SUB (X [4*i + 3], uik, x [3]) ;
}
}
break ;
}
}
void KLU_lsolve
(
/* inputs, not modified: */
Int n,
Int Lip [ ],
Int Llen [ ],
Unit LU [ ],
Int nrhs,
/* right-hand-side on input, solution to Lx=b on output */
Entry X [ ]
)
{
Entry x [4], lik ;
Int *Li ;
Entry *Lx ;
Int k, p, len, i ;
switch (nrhs)
{
case 1:
for (k = 0 ; k < n ; k++)
{
x [0] = X [k] ;
GET_POINTER (LU, Lip, Llen, Li, Lx, k, len) ;
/* unit diagonal of L is not stored*/
for (p = 0 ; p < len ; p++)
{
/* X [Li [p]] -= Lx [p] * x [0] ; */
MULT_SUB (X [Li [p]], Lx [p], x [0]) ;
}
}
break ;
case 2:
for (k = 0 ; k < n ; k++)
{
x [0] = X [2*k ] ;
x [1] = X [2*k + 1] ;
GET_POINTER (LU, Lip, Llen, Li, Lx, k, len) ;
for (p = 0 ; p < len ; p++)
{
i = Li [p] ;
lik = Lx [p] ;
MULT_SUB (X [2*i], lik, x [0]) ;
MULT_SUB (X [2*i + 1], lik, x [1]) ;
}
}
break ;
case 3:
for (k = 0 ; k < n ; k++)
{
x [0] = X [3*k ] ;
x [1] = X [3*k + 1] ;
x [2] = X [3*k + 2] ;
GET_POINTER (LU, Lip, Llen, Li, Lx, k, len) ;
for (p = 0 ; p < len ; p++)
{
i = Li [p] ;
lik = Lx [p] ;
MULT_SUB (X [3*i], lik, x [0]) ;
MULT_SUB (X [3*i + 1], lik, x [1]) ;
MULT_SUB (X [3*i + 2], lik, x [2]) ;
}
}
break ;
case 4:
for (k = 0 ; k < n ; k++)
{
x [0] = X [4*k ] ;
x [1] = X [4*k + 1] ;
x [2] = X [4*k + 2] ;
x [3] = X [4*k + 3] ;
GET_POINTER (LU, Lip, Llen, Li, Lx, k, len) ;
for (p = 0 ; p < len ; p++)
{
i = Li [p] ;
lik = Lx [p] ;
MULT_SUB (X [4*i], lik, x [0]) ;
MULT_SUB (X [4*i + 1], lik, x [1]) ;
MULT_SUB (X [4*i + 2], lik, x [2]) ;
MULT_SUB (X [4*i + 3], lik, x [3]) ;
}
}
break ;
}
}
/*
* GetClipboardSavebuf - gets data from the clipboard, and builds a
* temporary savebuf from it
*/
int GetClipboardSavebuf( savebuf *clip )
{
GLOBALHANDLE hglob;
char _HUGE_ *ptr;
char _HUGE_ *cpos;
fcb_list fcblist;
int i;
bool is_flushed;
bool has_lf;
bool record_done;
char ch;
int used;
if( !openClipboardForRead() ) {
return( ERR_CLIPBOARD_EMPTY );
}
hglob = GetClipboardData( CF_TEXT );
if( hglob == NULL ) {
return( ERR_CLIPBOARD );
}
ptr = GetPtrGlobalLock( hglob );
cpos = ptr;
i = 0;
is_flushed = false;
has_lf = false;
fcblist.head = NULL;
fcblist.tail = NULL;
record_done = false;
/*
* add all characters to ReadBuffer. Each time this fills,
* create a new FCB
*/
while( (ch = *ptr) != '\0' ) {
INC_POINTER( ptr );
ReadBuffer[i++] = ch;
if( ch == LF ) {
has_lf = true;
}
if( i >= MAX_IO_BUFFER ) {
is_flushed = true;
used = addAnFcb( &fcblist, i );
ptr = GET_POINTER( cpos, used );
cpos = ptr;
i = 0;
}
}
/*
* after we are done, see if any characters are left unprocessed
*/
if( i != 0 ) {
/*
* check if this is a partial line
*/
if( !is_flushed && !has_lf ) {
clip->type = SAVEBUF_LINE;
ReadBuffer[i] = 0;
clip->u.data = MemAlloc( i + 1 );
strcpy( clip->u.data, ReadBuffer );
record_done = true;
} else {
// add LF to end of buffer
if( i >= MAX_IO_BUFFER - 2 ) {
addAnFcb( &fcblist, i );
i = 0;
}
ReadBuffer[i++] = CR;
ReadBuffer[i++] = LF;
addAnFcb( &fcblist, i );
}
} else if( !is_flushed ) {
clip->type = SAVEBUF_NOP;
record_done = true;
}
if( !record_done ) {
clip->type = SAVEBUF_FCBS;
clip->u.fcbs.head = fcblist.head;
clip->u.fcbs.tail = fcblist.tail;
}
GlobalUnlock( hglob );
CloseClipboard();
return( ERR_NO_ERR );
} /* GetClipboardSavebuf */
Int KLU_extract /* returns TRUE if successful, FALSE otherwise */
(
/* inputs: */
KLU_numeric *Numeric,
KLU_symbolic *Symbolic,
/* outputs, all of which must be allocated on input */
/* L */
Int *Lp, /* size n+1 */
Int *Li, /* size nnz(L) */
double *Lx, /* size nnz(L) */
#ifdef COMPLEX
double *Lz, /* size nnz(L) for the complex case, ignored if real */
#endif
/* U */
Int *Up, /* size n+1 */
Int *Ui, /* size nnz(U) */
double *Ux, /* size nnz(U) */
#ifdef COMPLEX
double *Uz, /* size nnz(U) for the complex case, ignored if real */
#endif
/* F */
Int *Fp, /* size n+1 */
Int *Fi, /* size nnz(F) */
double *Fx, /* size nnz(F) */
#ifdef COMPLEX
double *Fz, /* size nnz(F) for the complex case, ignored if real */
#endif
/* P, row permutation */
Int *P, /* size n */
/* Q, column permutation */
Int *Q, /* size n */
/* Rs, scale factors */
double *Rs, /* size n */
/* R, block boundaries */
Int *R, /* size nblocks+1 */
KLU_common *Common
)
{
Int *Lip, *Llen, *Uip, *Ulen, *Li2, *Ui2 ;
Unit *LU ;
Entry *Lx2, *Ux2, *Ukk ;
Int i, k, block, nblocks, n, nz, k1, k2, nk, len, kk, p ;
if (Common == NULL)
{
return (FALSE) ;
}
if (Symbolic == NULL || Numeric == NULL)
{
Common->status = KLU_INVALID ;
return (FALSE) ;
}
Common->status = KLU_OK ;
n = Symbolic->n ;
nblocks = Symbolic->nblocks ;
/* ---------------------------------------------------------------------- */
/* extract scale factors */
/* ---------------------------------------------------------------------- */
if (Rs != NULL)
{
if (Numeric->Rs != NULL)
{
for (i = 0 ; i < n ; i++)
{
Rs [i] = Numeric->Rs [i] ;
}
}
else
{
/* no scaling */
for (i = 0 ; i < n ; i++)
{
Rs [i] = 1 ;
}
}
}
/* ---------------------------------------------------------------------- */
/* extract block boundaries */
/* ---------------------------------------------------------------------- */
if (R != NULL)
{
for (block = 0 ; block <= nblocks ; block++)
{
R [block] = Symbolic->R [block] ;
}
}
/* ---------------------------------------------------------------------- */
/* extract final row permutation */
/* ---------------------------------------------------------------------- */
if (P != NULL)
{
for (k = 0 ; k < n ; k++)
{
P [k] = Numeric->Pnum [k] ;
}
}
/* ---------------------------------------------------------------------- */
/* extract column permutation */
/* ---------------------------------------------------------------------- */
if (Q != NULL)
{
for (k = 0 ; k < n ; k++)
{
Q [k] = Symbolic->Q [k] ;
}
}
/* ---------------------------------------------------------------------- */
/* extract each block of L */
/* ---------------------------------------------------------------------- */
if (Lp != NULL && Li != NULL && Lx != NULL
#ifdef COMPLEX
&& Lz != NULL
#endif
)
{
nz = 0 ;
for (block = 0 ; block < nblocks ; block++)
{
k1 = Symbolic->R [block] ;
k2 = Symbolic->R [block+1] ;
nk = k2 - k1 ;
if (nk == 1)
{
/* singleton block */
Lp [k1] = nz ;
Li [nz] = k1 ;
Lx [nz] = 1 ;
#ifdef COMPLEX
Lz [nz] = 0 ;
#endif
nz++ ;
}
else
{
/* non-singleton block */
LU = Numeric->LUbx [block] ;
Lip = Numeric->Lip + k1 ;
Llen = Numeric->Llen + k1 ;
for (kk = 0 ; kk < nk ; kk++)
{
Lp [k1+kk] = nz ;
/* add the unit diagonal entry */
Li [nz] = k1 + kk ;
Lx [nz] = 1 ;
#ifdef COMPLEX
Lz [nz] = 0 ;
#endif
nz++ ;
GET_POINTER (LU, Lip, Llen, Li2, Lx2, kk, len) ;
for (p = 0 ; p < len ; p++)
{
Li [nz] = k1 + Li2 [p] ;
Lx [nz] = REAL (Lx2 [p]) ;
#ifdef COMPLEX
Lz [nz] = IMAG (Lx2 [p]) ;
#endif
nz++ ;
}
}
}
}
Lp [n] = nz ;
ASSERT (nz == Numeric->lnz) ;
}
/* ---------------------------------------------------------------------- */
/* extract each block of U */
/* ---------------------------------------------------------------------- */
if (Up != NULL && Ui != NULL && Ux != NULL
#ifdef COMPLEX
&& Uz != NULL
#endif
)
{
nz = 0 ;
for (block = 0 ; block < nblocks ; block++)
{
k1 = Symbolic->R [block] ;
k2 = Symbolic->R [block+1] ;
nk = k2 - k1 ;
Ukk = ((Entry *) Numeric->Udiag) + k1 ;
if (nk == 1)
{
/* singleton block */
Up [k1] = nz ;
Ui [nz] = k1 ;
Ux [nz] = REAL (Ukk [0]) ;
#ifdef COMPLEX
Uz [nz] = IMAG (Ukk [0]) ;
#endif
nz++ ;
}
else
{
/* non-singleton block */
LU = Numeric->LUbx [block] ;
Uip = Numeric->Uip + k1 ;
Ulen = Numeric->Ulen + k1 ;
for (kk = 0 ; kk < nk ; kk++)
{
Up [k1+kk] = nz ;
GET_POINTER (LU, Uip, Ulen, Ui2, Ux2, kk, len) ;
for (p = 0 ; p < len ; p++)
{
Ui [nz] = k1 + Ui2 [p] ;
Ux [nz] = REAL (Ux2 [p]) ;
#ifdef COMPLEX
Uz [nz] = IMAG (Ux2 [p]) ;
#endif
nz++ ;
}
/* add the diagonal entry */
Ui [nz] = k1 + kk ;
Ux [nz] = REAL (Ukk [kk]) ;
#ifdef COMPLEX
Uz [nz] = IMAG (Ukk [kk]) ;
#endif
nz++ ;
}
}
}
Up [n] = nz ;
ASSERT (nz == Numeric->unz) ;
}
/* ---------------------------------------------------------------------- */
/* extract the off-diagonal blocks, F */
/* ---------------------------------------------------------------------- */
if (Fp != NULL && Fi != NULL && Fx != NULL
#ifdef COMPLEX
&& Fz != NULL
#endif
)
{
for (k = 0 ; k <= n ; k++)
{
Fp [k] = Numeric->Offp [k] ;
}
nz = Fp [n] ;
for (k = 0 ; k < nz ; k++)
{
Fi [k] = Numeric->Offi [k] ;
}
for (k = 0 ; k < nz ; k++)
{
Fx [k] = REAL (((Entry *) Numeric->Offx) [k]) ;
#ifdef COMPLEX
Fz [k] = IMAG (((Entry *) Numeric->Offx) [k]) ;
#endif
}
}
return (TRUE) ;
}
Int KLU_refactor /* returns TRUE if successful, FALSE otherwise */
(
/* inputs, not modified */
Int Ap [ ], /* size n+1, column pointers */
Int Ai [ ], /* size nz, row indices */
double Ax [ ],
KLU_symbolic<Entry, Int> *Symbolic,
/* input/output */
KLU_numeric<Entry, Int> *Numeric,
KLU_common<Entry, Int> *Common
)
{
Entry ukk, ujk, s ;
Entry *Offx, *Lx, *Ux, *X, *Az, *Udiag ;
double *Rs ;
Int *P, *Q, *R, *Pnum, *Offp, *Offi, *Ui, *Li, *Pinv, *Lip, *Uip, *Llen,
*Ulen ;
Unit **LUbx ;
Unit *LU ;
Int k1, k2, nk, k, block, oldcol, pend, oldrow, n, p, newrow, scale,
nblocks, poff, i, j, up, ulen, llen, maxblock, nzoff ;
/* ---------------------------------------------------------------------- */
/* check inputs */
/* ---------------------------------------------------------------------- */
if (Common == NULL)
{
return (FALSE) ;
}
Common->status = KLU_OK ;
if (Numeric == NULL)
{
/* invalid Numeric object */
Common->status = KLU_INVALID ;
return (FALSE) ;
}
Common->numerical_rank = EMPTY ;
Common->singular_col = EMPTY ;
Az = (Entry *) Ax ;
/* ---------------------------------------------------------------------- */
/* get the contents of the Symbolic object */
/* ---------------------------------------------------------------------- */
n = Symbolic->n ;
P = Symbolic->P ;
Q = Symbolic->Q ;
R = Symbolic->R ;
nblocks = Symbolic->nblocks ;
maxblock = Symbolic->maxblock ;
/* ---------------------------------------------------------------------- */
/* get the contents of the Numeric object */
/* ---------------------------------------------------------------------- */
Pnum = Numeric->Pnum ;
Offp = Numeric->Offp ;
Offi = Numeric->Offi ;
Offx = (Entry *) Numeric->Offx ;
LUbx = (Unit **) Numeric->LUbx ;
scale = Common->scale ;
if (scale > 0)
{
/* factorization was not scaled, but refactorization is scaled */
if (Numeric->Rs == NULL)
{
Numeric->Rs = (double *)KLU_malloc (n, sizeof (double), Common) ;
if (Common->status < KLU_OK)
{
Common->status = KLU_OUT_OF_MEMORY ;
return (FALSE) ;
}
}
}
else
{
/* no scaling for refactorization; ensure Numeric->Rs is freed. This
* does nothing if Numeric->Rs is already NULL. */
Numeric->Rs = (double *) KLU_free (Numeric->Rs, n, sizeof (double), Common) ;
}
Rs = Numeric->Rs ;
Pinv = Numeric->Pinv ;
X = (Entry *) Numeric->Xwork ;
Common->nrealloc = 0 ;
Udiag = (Entry *) Numeric->Udiag ;
nzoff = Symbolic->nzoff ;
/* ---------------------------------------------------------------------- */
/* check the input matrix compute the row scale factors, Rs */
/* ---------------------------------------------------------------------- */
/* do no scale, or check the input matrix, if scale < 0 */
if (scale >= 0)
{
/* check for out-of-range indices, but do not check for duplicates */
if (!KLU_scale (scale, n, Ap, Ai, Ax, Rs, NULL, Common))
{
return (FALSE) ;
}
}
/* ---------------------------------------------------------------------- */
/* clear workspace X */
/* ---------------------------------------------------------------------- */
for (k = 0 ; k < maxblock ; k++)
{
/* X [k] = 0 */
CLEAR (X [k]) ;
}
poff = 0 ;
/* ---------------------------------------------------------------------- */
/* factor each block */
/* ---------------------------------------------------------------------- */
if (scale <= 0)
{
/* ------------------------------------------------------------------ */
/* no scaling */
/* ------------------------------------------------------------------ */
for (block = 0 ; block < nblocks ; block++)
{
/* -------------------------------------------------------------- */
/* the block is from rows/columns k1 to k2-1 */
/* -------------------------------------------------------------- */
k1 = R [block] ;
k2 = R [block+1] ;
nk = k2 - k1 ;
if (nk == 1)
{
/* ---------------------------------------------------------- */
/* singleton case */
/* ---------------------------------------------------------- */
oldcol = Q [k1] ;
pend = Ap [oldcol+1] ;
CLEAR (s) ;
for (p = Ap [oldcol] ; p < pend ; p++)
{
newrow = Pinv [Ai [p]] - k1 ;
if (newrow < 0 && poff < nzoff)
{
/* entry in off-diagonal block */
Offx [poff] = Az [p] ;
poff++ ;
}
else
{
/* singleton */
s = Az [p] ;
}
}
Udiag [k1] = s ;
}
else
{
/* ---------------------------------------------------------- */
/* construct and factor the kth block */
/* ---------------------------------------------------------- */
Lip = Numeric->Lip + k1 ;
Llen = Numeric->Llen + k1 ;
Uip = Numeric->Uip + k1 ;
Ulen = Numeric->Ulen + k1 ;
LU = LUbx [block] ;
for (k = 0 ; k < nk ; k++)
{
/* ------------------------------------------------------ */
/* scatter kth column of the block into workspace X */
/* ------------------------------------------------------ */
oldcol = Q [k+k1] ;
pend = Ap [oldcol+1] ;
for (p = Ap [oldcol] ; p < pend ; p++)
{
newrow = Pinv [Ai [p]] - k1 ;
if (newrow < 0 && poff < nzoff)
{
/* entry in off-diagonal block */
Offx [poff] = Az [p] ;
poff++ ;
}
else
{
/* (newrow,k) is an entry in the block */
X [newrow] = Az [p] ;
}
}
/* ------------------------------------------------------ */
/* compute kth column of U, and update kth column of A */
/* ------------------------------------------------------ */
GET_POINTER (LU, Uip, Ulen, Ui, Ux, k, ulen) ;
for (up = 0 ; up < ulen ; up++)
{
j = Ui [up] ;
ujk = X [j] ;
/* X [j] = 0 */
CLEAR (X [j]) ;
Ux [up] = ujk ;
GET_POINTER (LU, Lip, Llen, Li, Lx, j, llen) ;
for (p = 0 ; p < llen ; p++)
{
/* X [Li [p]] -= Lx [p] * ujk */
MULT_SUB (X [Li [p]], Lx [p], ujk) ;
}
}
/* get the diagonal entry of U */
ukk = X [k] ;
/* X [k] = 0 */
CLEAR (X [k]) ;
/* singular case */
if (IS_ZERO (ukk))
{
/* matrix is numerically singular */
Common->status = KLU_SINGULAR ;
if (Common->numerical_rank == EMPTY)
{
Common->numerical_rank = k+k1 ;
Common->singular_col = Q [k+k1] ;
}
if (Common->halt_if_singular)
{
/* do not continue the factorization */
return (FALSE) ;
}
}
Udiag [k+k1] = ukk ;
/* gather and divide by pivot to get kth column of L */
GET_POINTER (LU, Lip, Llen, Li, Lx, k, llen) ;
for (p = 0 ; p < llen ; p++)
{
i = Li [p] ;
DIV (Lx [p], X [i], ukk) ;
CLEAR (X [i]) ;
}
}
}
}
}
else
{
/* ------------------------------------------------------------------ */
/* scaling */
/* ------------------------------------------------------------------ */
for (block = 0 ; block < nblocks ; block++)
{
/* -------------------------------------------------------------- */
/* the block is from rows/columns k1 to k2-1 */
/* -------------------------------------------------------------- */
k1 = R [block] ;
k2 = R [block+1] ;
nk = k2 - k1 ;
if (nk == 1)
{
/* ---------------------------------------------------------- */
/* singleton case */
/* ---------------------------------------------------------- */
oldcol = Q [k1] ;
pend = Ap [oldcol+1] ;
CLEAR (s) ;
for (p = Ap [oldcol] ; p < pend ; p++)
{
oldrow = Ai [p] ;
newrow = Pinv [oldrow] - k1 ;
if (newrow < 0 && poff < nzoff)
{
/* entry in off-diagonal block */
/* Offx [poff] = Az [p] / Rs [oldrow] */
SCALE_DIV_ASSIGN (Offx [poff], Az [p], Rs [oldrow]) ;
poff++ ;
}
else
{
/* singleton */
/* s = Az [p] / Rs [oldrow] */
SCALE_DIV_ASSIGN (s, Az [p], Rs [oldrow]) ;
}
}
Udiag [k1] = s ;
}
else
{
/* ---------------------------------------------------------- */
/* construct and factor the kth block */
/* ---------------------------------------------------------- */
Lip = Numeric->Lip + k1 ;
Llen = Numeric->Llen + k1 ;
Uip = Numeric->Uip + k1 ;
Ulen = Numeric->Ulen + k1 ;
LU = LUbx [block] ;
for (k = 0 ; k < nk ; k++)
{
/* ------------------------------------------------------ */
/* scatter kth column of the block into workspace X */
/* ------------------------------------------------------ */
oldcol = Q [k+k1] ;
pend = Ap [oldcol+1] ;
for (p = Ap [oldcol] ; p < pend ; p++)
{
oldrow = Ai [p] ;
newrow = Pinv [oldrow] - k1 ;
if (newrow < 0 && poff < nzoff)
{
/* entry in off-diagonal part */
/* Offx [poff] = Az [p] / Rs [oldrow] */
SCALE_DIV_ASSIGN (Offx [poff], Az [p], Rs [oldrow]);
poff++ ;
}
else
{
/* (newrow,k) is an entry in the block */
/* X [newrow] = Az [p] / Rs [oldrow] */
SCALE_DIV_ASSIGN (X [newrow], Az [p], Rs [oldrow]) ;
}
}
/* ------------------------------------------------------ */
/* compute kth column of U, and update kth column of A */
/* ------------------------------------------------------ */
GET_POINTER (LU, Uip, Ulen, Ui, Ux, k, ulen) ;
for (up = 0 ; up < ulen ; up++)
{
j = Ui [up] ;
ujk = X [j] ;
/* X [j] = 0 */
CLEAR (X [j]) ;
Ux [up] = ujk ;
GET_POINTER (LU, Lip, Llen, Li, Lx, j, llen) ;
for (p = 0 ; p < llen ; p++)
{
/* X [Li [p]] -= Lx [p] * ujk */
MULT_SUB (X [Li [p]], Lx [p], ujk) ;
}
}
/* get the diagonal entry of U */
ukk = X [k] ;
/* X [k] = 0 */
CLEAR (X [k]) ;
/* singular case */
if (IS_ZERO (ukk))
{
/* matrix is numerically singular */
Common->status = KLU_SINGULAR ;
if (Common->numerical_rank == EMPTY)
{
Common->numerical_rank = k+k1 ;
Common->singular_col = Q [k+k1] ;
}
if (Common->halt_if_singular)
{
/* do not continue the factorization */
return (FALSE) ;
}
}
Udiag [k+k1] = ukk ;
/* gather and divide by pivot to get kth column of L */
GET_POINTER (LU, Lip, Llen, Li, Lx, k, llen) ;
for (p = 0 ; p < llen ; p++)
{
i = Li [p] ;
DIV (Lx [p], X [i], ukk) ;
CLEAR (X [i]) ;
}
}
}
}
}
/* ---------------------------------------------------------------------- */
/* permute scale factors Rs according to pivotal row order */
/* ---------------------------------------------------------------------- */
if (scale > 0)
{
for (k = 0 ; k < n ; k++)
{
/* TODO : Check. REAL(X[k]) Can be just X[k] */
/* REAL (X [k]) = Rs [Pnum [k]] ; */
X [k] = Rs [Pnum [k]] ;
}
for (k = 0 ; k < n ; k++)
{
Rs [k] = REAL (X [k]) ;
}
}
#ifndef NDEBUGKLU2
ASSERT (Offp [n] == poff) ;
ASSERT (Symbolic->nzoff == poff) ;
PRINTF (("\n------------------- Off diagonal entries, new:\n")) ;
ASSERT (KLU_valid (n, Offp, Offi, Offx)) ;
if (Common->status == KLU_OK)
{
PRINTF (("\n ########### KLU_BTF_REFACTOR done, nblocks %d\n",nblocks));
for (block = 0 ; block < nblocks ; block++)
{
k1 = R [block] ;
k2 = R [block+1] ;
nk = k2 - k1 ;
PRINTF ((
"\n================KLU_refactor output: k1 %d k2 %d nk %d\n",
k1, k2, nk)) ;
if (nk == 1)
{
PRINTF (("singleton ")) ;
PRINT_ENTRY (Udiag [k1]) ;
}
else
{
Lip = Numeric->Lip + k1 ;
Llen = Numeric->Llen + k1 ;
LU = (Unit *) Numeric->LUbx [block] ;
PRINTF (("\n---- L block %d\n", block)) ;
ASSERT (KLU_valid_LU (nk, TRUE, Lip, Llen, LU)) ;
Uip = Numeric->Uip + k1 ;
Ulen = Numeric->Ulen + k1 ;
PRINTF (("\n---- U block %d\n", block)) ;
ASSERT (KLU_valid_LU (nk, FALSE, Uip, Ulen, LU)) ;
}
}
}
#endif
return (TRUE) ;
}
/* Prune the columns of L to reduce work in subsequent depth-first searches */
static void prune
(
/* input/output: */
Int Lpend [ ], /* Lpend [j] marks symmetric pruning point for L(:,j) */
/* input: */
Int Pinv [ ], /* Pinv [i] = k if row i is kth pivot row, or EMPTY if
* row i is not yet pivotal. */
Int k, /* prune using column k of U */
Int pivrow, /* current pivot row */
/* input/output: */
Unit *LU, /* LU factors (pattern and values) */
/* input */
Int Uip [ ], /* size n, column pointers for U */
Int Lip [ ], /* size n, column pointers for L */
Int Ulen [ ], /* size n, column length of U */
Int Llen [ ] /* size n, column length of L */
)
{
Entry x ;
Entry *Lx, *Ux ;
Int *Li, *Ui ;
Int p, i, j, p2, phead, ptail, llen, ulen ;
/* check to see if any column of L can be pruned */
GET_POINTER (LU, Uip, Ulen, Ui, Ux, k, ulen) ;
for (p = 0 ; p < ulen ; p++)
{
j = Ui [p] ;
ASSERT (j < k) ;
PRINTF (("%d is pruned: %d. Lpend[j] %d Lip[j+1] %d\n",
j, Lpend [j] != EMPTY, Lpend [j], Lip [j+1])) ;
if (Lpend [j] == EMPTY)
{
/* scan column j of L for the pivot row */
GET_POINTER (LU, Lip, Llen, Li, Lx, j, llen) ;
for (p2 = 0 ; p2 < llen ; p2++)
{
if (pivrow == Li [p2])
{
/* found it! This column can be pruned */
#ifndef NDEBUG
PRINTF (("==== PRUNE: col j %d of L\n", j)) ;
{
Int p3 ;
for (p3 = 0 ; p3 < Llen [j] ; p3++)
{
PRINTF (("before: %i pivotal: %d\n", Li [p3],
Pinv [Li [p3]] >= 0)) ;
}
}
#endif
/* partition column j of L. The unit diagonal of L
* is not stored in the column of L. */
phead = 0 ;
ptail = Llen [j] ;
while (phead < ptail)
{
i = Li [phead] ;
if (Pinv [i] >= 0)
{
/* leave at the head */
phead++ ;
}
else
{
/* swap with the tail */
ptail-- ;
Li [phead] = Li [ptail] ;
Li [ptail] = i ;
x = Lx [phead] ;
Lx [phead] = Lx [ptail] ;
Lx [ptail] = x ;
}
}
/* set Lpend to one past the last entry in the
* first part of the column of L. Entries in
* Li [0 ... Lpend [j]-1] are the only part of
* column j of L that needs to be scanned in the DFS.
* Lpend [j] was EMPTY; setting it >= 0 also flags
* column j as pruned. */
Lpend [j] = ptail ;
#ifndef NDEBUG
{
Int p3 ;
for (p3 = 0 ; p3 < Llen [j] ; p3++)
{
if (p3 == Lpend [j]) PRINTF (("----\n")) ;
PRINTF (("after: %i pivotal: %d\n", Li [p3],
Pinv [Li [p3]] >= 0)) ;
}
}
#endif
break ;
}
}
}
}
}
static Int lpivot
(
Int diagrow,
Int *p_pivrow,
Entry *p_pivot,
double *p_abs_pivot,
double tol,
Entry X [ ],
Unit *LU, /* LU factors (pattern and values) */
Int Lip [ ],
Int Llen [ ],
Int k,
Int n,
Int Pinv [ ], /* Pinv [i] = k if row i is kth pivot row, or EMPTY if
* row i is not yet pivotal. */
Int *p_firstrow,
TRILINOS_KLU_common *Common
)
{
Entry x, pivot, *Lx ;
double abs_pivot, xabs ;
Int p, i, ppivrow, pdiag, pivrow, *Li, last_row_index, firstrow, len ;
pivrow = EMPTY ;
if (Llen [k] == 0)
{
/* matrix is structurally singular */
if (Common->halt_if_singular)
{
return (FALSE) ;
}
for (firstrow = *p_firstrow ; firstrow < n ; firstrow++)
{
PRINTF (("check %d\n", firstrow)) ;
if (Pinv [firstrow] < 0)
{
/* found the lowest-numbered non-pivotal row. Pick it. */
pivrow = firstrow ;
PRINTF (("Got pivotal row: %d\n", pivrow)) ;
break ;
}
}
ASSERT (pivrow >= 0 && pivrow < n) ;
CLEAR (pivot) ;
*p_pivrow = pivrow ;
*p_pivot = pivot ;
*p_abs_pivot = 0 ;
*p_firstrow = firstrow ;
return (FALSE) ;
}
pdiag = EMPTY ;
ppivrow = EMPTY ;
abs_pivot = EMPTY ;
i = Llen [k] - 1 ;
GET_POINTER (LU, Lip, Llen, Li, Lx, k, len) ;
last_row_index = Li [i] ;
/* decrement the length by 1 */
Llen [k] = i ;
GET_POINTER (LU, Lip, Llen, Li, Lx, k, len) ;
/* look in Li [0 ..Llen [k] - 1 ] for a pivot row */
for (p = 0 ; p < len ; p++)
{
/* gather the entry from X and store in L */
i = Li [p] ;
x = X [i] ;
CLEAR (X [i]) ;
Lx [p] = x ;
/* xabs = ABS (x) ; */
ABS (xabs, x) ;
/* find the diagonal */
if (i == diagrow)
{
pdiag = p ;
}
/* find the partial-pivoting choice */
if (xabs > abs_pivot)
{
abs_pivot = xabs ;
ppivrow = p ;
}
}
/* xabs = ABS (X [last_row_index]) ;*/
ABS (xabs, X [last_row_index]) ;
if (xabs > abs_pivot)
{
abs_pivot = xabs ;
ppivrow = EMPTY ;
}
/* compare the diagonal with the largest entry */
if (last_row_index == diagrow)
{
if (xabs >= tol * abs_pivot)
{
abs_pivot = xabs ;
ppivrow = EMPTY ;
}
}
else if (pdiag != EMPTY)
{
/* xabs = ABS (Lx [pdiag]) ;*/
ABS (xabs, Lx [pdiag]) ;
if (xabs >= tol * abs_pivot)
{
/* the diagonal is large enough */
abs_pivot = xabs ;
ppivrow = pdiag ;
}
}
if (ppivrow != EMPTY)
{
pivrow = Li [ppivrow] ;
pivot = Lx [ppivrow] ;
/* overwrite the ppivrow values with last index values */
Li [ppivrow] = last_row_index ;
Lx [ppivrow] = X [last_row_index] ;
}
else
{
pivrow = last_row_index ;
pivot = X [last_row_index] ;
}
CLEAR (X [last_row_index]) ;
*p_pivrow = pivrow ;
*p_pivot = pivot ;
*p_abs_pivot = abs_pivot ;
ASSERT (pivrow >= 0 && pivrow < n) ;
if (IS_ZERO (pivot) && Common->halt_if_singular)
{
/* numerically singular case */
return (FALSE) ;
}
/* divide L by the pivot value */
for (p = 0 ; p < Llen [k] ; p++)
{
/* Lx [p] /= pivot ; */
DIV (Lx [p], Lx [p], pivot) ;
}
return (TRUE) ;
}
int main(int argc, char* argv[])
{
HANDLE hFile = INVALID_HANDLE_VALUE,
hMap = NULL;
PBYTE pBuffer = NULL, pOps = NULL;
DWORD dwFileSize = 0,
dwSizeOfHeaders = 0,
dwSections = 0,
dwBaseAddress = 0,
dwImageSize = 0,
dwExportRVA = 0,
dwExportSize = 0,
dwExportRaw = 0,
dwExports = 0;
PDWORD pdwFunctions, pszFunctionNames;
PWORD pwOrdinals;
PIMAGE_NT_HEADERS NTHeader;
PIMAGE_DOS_HEADER DOSHeader;
PIMAGE_SECTION_HEADER Sections;
PIMAGE_EXPORT_DIRECTORY pExportDirectory;
hFile = CreateFile
(
"c:\\windows\\system32\\ntdll.dll",
GENERIC_READ,
FILE_SHARE_READ | FILE_SHARE_DELETE,
NULL,
OPEN_EXISTING,
FILE_ATTRIBUTE_NORMAL,
NULL
);
if( hFile == INVALID_HANDLE_VALUE )
{
fprintf( stderr, "Could not open file: %08X\n", GetLastError() );
goto done;
}
dwFileSize = GetFileSize( hFile, NULL );
hMap = CreateFileMapping( hFile, NULL, PAGE_READONLY, 0, 0, NULL );
if( hMap == NULL )
{
fprintf( stderr, "Could not create memory map: %08X\n", GetLastError() );
goto done;
}
pBuffer = (PBYTE)MapViewOfFile( hMap, FILE_MAP_READ, 0, 0, 0 );
if( hMap == NULL )
{
fprintf( stderr, "Could not obtain memory map view: %08X\n", GetLastError() );
goto done;
}
if( pBuffer[0] != 'M' || pBuffer[1] != 'Z' )
{
fprintf( stderr, "Unexpected file header.\n" );
goto done;
}
// start reading PE headers
DOSHeader = (PIMAGE_DOS_HEADER)pBuffer;
NTHeader = (PIMAGE_NT_HEADERS)( pBuffer + DOSHeader->e_lfanew );
dwSizeOfHeaders = NTHeader->OptionalHeader.SizeOfHeaders;
dwBaseAddress = NTHeader->OptionalHeader.ImageBase;
dwImageSize = NTHeader->OptionalHeader.SizeOfImage;
dwSections = NTHeader->FileHeader.NumberOfSections;
// get first section header
Sections = (PIMAGE_SECTION_HEADER)
(
pBuffer +
DOSHeader->e_lfanew +
sizeof(IMAGE_NT_HEADERS)
);
// now parse the export directory
dwExportRVA = NTHeader->OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_EXPORT].VirtualAddress;
dwExportSize = NTHeader->OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_EXPORT].Size;
dwExportRaw = RawOffsetByRVA( Sections, dwSections, dwFileSize, dwExportRVA );
if( !dwExportRVA || !dwExportSize || !dwExportRaw )
{
fprintf( stderr, "Unexpected export directory structure.\n" );
goto done;
}
pExportDirectory = (PIMAGE_EXPORT_DIRECTORY)( pBuffer + dwExportRaw );
pdwFunctions = (PDWORD)GET_POINTER( pExportDirectory->AddressOfFunctions );
pwOrdinals = (PWORD)GET_POINTER( pExportDirectory->AddressOfNameOrdinals );
pszFunctionNames = (PDWORD)GET_POINTER( pExportDirectory->AddressOfNames );
dwExports = pExportDirectory->NumberOfNames;
printf("pExportDirectory->NumberOfNames=%d\n",pExportDirectory->NumberOfNames);
printf( "SYSCALL RVA NAME\n" );
printf( "-----------------------------------------------\n" );
// loop each exported symbol by name
for( DWORD i = 0; i < pExportDirectory->NumberOfNames; ++i )
{
DWORD dwNameRVA = pszFunctionNames[ i ],
dwApiRVA = pdwFunctions[ pwOrdinals[ i ] ],
dwSyscall = 0,
dwApiRaw = RawOffsetByRVA( Sections, dwSections, dwFileSize, dwApiRVA ),
dwNameRaw = RawOffsetByRVA( Sections, dwSections, dwFileSize, dwNameRVA );
pOps = pBuffer + dwApiRaw;
/*
* Check if the API entry begins with:
*
* MOV EAX, IMM32
* XOR ECX, ECX
* LEA EDX, [ESP+04h]
* CALL FS:[C0h]
*
* Or
*
* MOV EAX, IMM32
* MOV ECX, IMM32
* LEA EDX, [ESP+04h]
* CALL FS:[C0h]
*/
if( pOps[0] == 0xB8 && // mov eax, imm32
(
(
pOps[5] == 0x33 && pOps[6] == 0xC9 && // xor ecx, ecx
!memcmp( &pOps[7], "\x8D\x54\x24\x04", 4 ) && // lea edx, [esp+04h]
!memcmp( &pOps[11], "\x64\xFF\x15\xC0\x00\x00\x00", 7 ) // call fs:[C0h]
)
||
(
pOps[5] == 0xB9 && // mov ecx, imm32
!memcmp( &pOps[10], "\x8D\x54\x24\x04", 4 ) && // lea edx, [esp+04h]
!memcmp( &pOps[13], "\x64\xFF\x15\xC0\x00\x00\x00", 7 ) // call fs:[C0h]
)
)
)
{
/*
* Extract the IMM32 part, this is our syscall number.
*/
dwSyscall = *(DWORD *)( pOps + 1 );
printf( "%08X %08X %s\n", dwSyscall, dwBaseAddress + dwApiRVA, pBuffer + dwNameRaw );
}
}
done:
if( hFile != INVALID_HANDLE_VALUE )
{
CloseHandle( hFile );
}
if( pBuffer != NULL )
{
UnmapViewOfFile( pBuffer );
}
if( hMap != NULL )
{
CloseHandle( hMap );
}
return 0;
}//end main()
static int LB_write_internal (int lbd, const char *msg, int length, LB_id_t id)
{
LB_struct *lb;
unsigned int num_ptr, org_num_ptr;
int ptr, nmsgs;
int n_rm;
LB_dir *dir;
int loc, new_space;
int ret, ind, tag;
if ((length < 0 && msg != DELETE_FLAG) || (length > 0 && msg == NULL) ||
(id > LB_MAX_ID && id != LB_ANY)) /* check arguments */
return (LB_BAD_ARGUMENT);
/* get the LB structure, lock and mmap the file */
lb = LB_Get_lb_structure (lbd, &ret);
if (lb == NULL)
return (ret);
if ((ret = LB_lock_mmap (lb, WRITE_PERM, EXC_LOCK)) < 0)
return (LB_Unlock_return (lb, ret));
if (!(lb->flags & LB_WRITE)) /* check write flag */
return (LB_Unlock_return (lb, LB_BAD_ACCESS));
if ((lb->flags & LB_DIRECT) && /* check direct access lock */
LB_direct_access_lock (lb, TEST_LOCK, 0) != 0)
return (LB_Unlock_return (lb, LB_BAD_ACCESS));
if (length <= 0 && !(lb->flags & LB_DB))
return (LB_Unlock_return (lb, LB_BAD_ARGUMENT));
if (msg == DELETE_FLAG && (lb->hd->miscflags & LB_ID_BY_USER))
return (LB_Unlock_return (lb, LB_NOT_SUPPORTED));
if (lb->active_test) { /* test LB_ACTIVE_SV_LOCK_OFF lock */
ret = LB_process_lock (TEST_LOCK, lb, EXC_LOCK, LB_ACTIVE_SV_LOCK_OFF);
if (ret != LB_LOCKED)
return (LB_Unlock_return (lb, LB_NOT_ACTIVE));
}
if (C_and_w && Check_msg (lb, msg, length, id))
return (LB_Unlock_return (lb, 0));
org_num_ptr = lb->hd->num_pt; /* save for evaluating # expired msgs */
if (lb->utag != NULL)
tag = *(lb->utag);
else
tag = 0;
/* process message replacing */
if (lb->flags & LB_DB) {
ret = Replace_message (lb, id, length, msg, tag);
if (ret != MSG_NOT_REPLACED)
return (LB_Unlock_return (lb, ret));
}
/* find the write pointer and the new dir slot */
num_ptr = lb->hd->num_pt;
ptr = GET_POINTER (num_ptr);
ind = ptr % lb->n_slots; /* new slot index */
nmsgs = GET_NMSG (num_ptr) + 1; /* msg number including the new */
if (lb->flags & LB_DB) {
if (id != LB_ANY && (lb->hd->miscflags & LB_MSG_DELETED))
return (LB_Unlock_return (lb, LB_NOT_SUPPORTED));
if (nmsgs > lb->maxn_msgs)
return (LB_Unlock_return (lb, LB_FULL));
}
/* get free space */
loc = new_space = 0;
if (length > 0)
loc = LB_sms_get_free_space (lb, length, &new_space);
if (loc < 0)
return (LB_Unlock_return (lb, loc));
/* write the message */
if (length > 0 &&
(ret = Write_msg_body (lb, loc, length, msg, new_space)) < 0)
return (LB_Unlock_return (lb, ret));
/* update the dir slot and the msg info */
dir = lb->dir + ind;
if (lb->flags & LB_DB) {
LB_msg_info_t *msginfo;
dir->loc = 0; /* for ucnt */
msginfo = (LB_msg_info_t *)lb->msginfo + DB_WORD_OFFSET (ind, 0);
msginfo->len = length;
msginfo->loc = loc;
}
else if (lb->ma_size == 0) {
LB_msg_info_seq_t *msginfo;
dir->loc = loc;
msginfo = (LB_msg_info_seq_t *)lb->msginfo + ind;
msginfo->len = length;
}
else
dir->loc = (loc + length) % lb->ma_size;
{ /* find the previous id and check if the LB is of non-decreasing ID */
LB_id_t prid;
/* this works since the entire control area is initialized to 0 */
if (nmsgs > 1) { /* find previous id */
int ppt; /* pointer to the previous slot */
ppt = ptr - 1;
if (ppt < 0)
ppt = lb->ptr_range - 1;
prid = (lb->dir [ppt % lb->n_slots]).id;
}
else
prid = 0;
if (id == LB_ANY) /* new id */
id = (lb_t)((prid + 1) % (unsigned int)(LB_MAX_ID + 1));
else
lb->hd->miscflags |= LB_ID_BY_USER;
if (id < prid && nmsgs > 1) /* The LB is not of non-decreasing ID */
lb->hd->non_dec_id &= 0xfe;
}
dir->id = id;
/* write the tag for the new message */
if (lb->hd->tag_size > 0)
LB_write_tag (lb, ind, tag, 0);
/* process nrs and update LB time */
if (lb->off_nra > 0 &&
(ret = LB_process_nr (lb, id, length, tag,
N_MSG_RM_COMPU, org_num_ptr)) < 0)
return (LB_Unlock_return (lb, ret));
lb->hd->lb_time = time (NULL);
/* update num_ptr and page number */
if (nmsgs > lb->maxn_msgs)
n_rm = nmsgs - lb->maxn_msgs; /* number of messages to remove */
else
n_rm = 0;
LB_Update_pointer (lb, 1, n_rm); /* we add one new message */
if (((lb->flags & LB_DB) || lb->ma_size == 0) &&
length > 0) /* sets sms_ok flag */
lb->hd->sms_ok = 1;
if (nmsgs > lb->maxn_msgs && lb->ma_size == 0) {
int ln, lc, p;
p = ptr - nmsgs + 1 + lb->n_slots;
ln = LB_Get_message_info (lb, p, &lc, NULL);
LB_sms_free_space (lb, lc, ln);
}
if (lb->flags & LB_SHARE_STREAM) {
int exppt = (GET_POINTER (lb->hd->num_pt) + lb->ptr_range -
(lb->maxn_msgs + 1)) % lb->ptr_range;
if (LB_Ptr_compare (lb, exppt, (int)lb->hd->ptr_read) > 0)
lb->hd->ptr_read = exppt;
} /* advance ptr_read to keep close to the available msgs */
lb->prev_id = id;
if (lb->umid != NULL)
*lb->umid = id;
if (length < 0)
length = 0;
return (LB_Unlock_return (lb, length));
}
void KLU_utsolve
(
/* inputs, not modified: */
Int n,
Int Uip [ ],
Int Ulen [ ],
Unit LU [ ],
Entry Udiag [ ],
Int nrhs,
#ifdef COMPLEX
Int conj_solve,
#endif
/* right-hand-side on input, solution to Ux=b on output */
Entry X [ ]
)
{
Entry x [4], uik, ukk ;
Int k, p, len, i ;
Int *Ui ;
Entry *Ux ;
switch (nrhs)
{
case 1:
for (k = 0 ; k < n ; k++)
{
GET_POINTER (LU, Uip, Ulen, Ui, Ux, k, len) ;
x [0] = X [k] ;
for (p = 0 ; p < len ; p++)
{
#ifdef COMPLEX
if (conj_solve)
{
/* x [0] -= CONJ (Ux [p]) * X [Ui [p]] ; */
MULT_SUB_CONJ (x [0], X [Ui [p]], Ux [p]) ;
}
else
#endif
{
/* x [0] -= Ux [p] * X [Ui [p]] ; */
MULT_SUB (x [0], Ux [p], X [Ui [p]]) ;
}
}
#ifdef COMPLEX
if (conj_solve)
{
CONJ (ukk, Udiag [k]) ;
}
else
#endif
{
ukk = Udiag [k] ;
}
DIV (X [k], x [0], ukk) ;
}
break ;
case 2:
for (k = 0 ; k < n ; k++)
{
GET_POINTER (LU, Uip, Ulen, Ui, Ux, k, len) ;
x [0] = X [2*k ] ;
x [1] = X [2*k + 1] ;
for (p = 0 ; p < len ; p++)
{
i = Ui [p] ;
#ifdef COMPLEX
if (conj_solve)
{
CONJ (uik, Ux [p]) ;
}
else
#endif
{
uik = Ux [p] ;
}
MULT_SUB (x [0], uik, X [2*i]) ;
MULT_SUB (x [1], uik, X [2*i + 1]) ;
}
#ifdef COMPLEX
if (conj_solve)
{
CONJ (ukk, Udiag [k]) ;
}
else
#endif
{
ukk = Udiag [k] ;
}
DIV (X [2*k], x [0], ukk) ;
DIV (X [2*k + 1], x [1], ukk) ;
}
break ;
case 3:
for (k = 0 ; k < n ; k++)
{
GET_POINTER (LU, Uip, Ulen, Ui, Ux, k, len) ;
x [0] = X [3*k ] ;
x [1] = X [3*k + 1] ;
x [2] = X [3*k + 2] ;
for (p = 0 ; p < len ; p++)
{
i = Ui [p] ;
#ifdef COMPLEX
if (conj_solve)
{
CONJ (uik, Ux [p]) ;
}
else
#endif
{
uik = Ux [p] ;
}
MULT_SUB (x [0], uik, X [3*i]) ;
MULT_SUB (x [1], uik, X [3*i + 1]) ;
MULT_SUB (x [2], uik, X [3*i + 2]) ;
}
#ifdef COMPLEX
if (conj_solve)
{
CONJ (ukk, Udiag [k]) ;
}
else
#endif
{
ukk = Udiag [k] ;
}
DIV (X [3*k], x [0], ukk) ;
DIV (X [3*k + 1], x [1], ukk) ;
DIV (X [3*k + 2], x [2], ukk) ;
}
break ;
case 4:
for (k = 0 ; k < n ; k++)
{
GET_POINTER (LU, Uip, Ulen, Ui, Ux, k, len) ;
x [0] = X [4*k ] ;
x [1] = X [4*k + 1] ;
x [2] = X [4*k + 2] ;
x [3] = X [4*k + 3] ;
for (p = 0 ; p < len ; p++)
{
i = Ui [p] ;
#ifdef COMPLEX
if (conj_solve)
{
CONJ (uik, Ux [p]) ;
}
else
#endif
{
uik = Ux [p] ;
}
MULT_SUB (x [0], uik, X [4*i]) ;
MULT_SUB (x [1], uik, X [4*i + 1]) ;
MULT_SUB (x [2], uik, X [4*i + 2]) ;
MULT_SUB (x [3], uik, X [4*i + 3]) ;
}
#ifdef COMPLEX
if (conj_solve)
{
CONJ (ukk, Udiag [k]) ;
}
else
#endif
{
ukk = Udiag [k] ;
}
DIV (X [4*k], x [0], ukk) ;
DIV (X [4*k + 1], x [1], ukk) ;
DIV (X [4*k + 2], x [2], ukk) ;
DIV (X [4*k + 3], x [3], ukk) ;
}
break ;
}
}
size_t TRILINOS_KLU_kernel /* final size of LU on output */
(
/* input, not modified */
Int n, /* A is n-by-n */
Int Ap [ ], /* size n+1, column pointers for A */
Int Ai [ ], /* size nz = Ap [n], row indices for A */
Entry Ax [ ], /* size nz, values of A */
Int Q [ ], /* size n, optional input permutation */
size_t lusize, /* initial size of LU on input */
/* output, not defined on input */
Int Pinv [ ], /* size n, inverse row permutation, where Pinv [i] = k if
* row i is the kth pivot row */
Int P [ ], /* size n, row permutation, where P [k] = i if row i is the
* kth pivot row. */
Unit **p_LU, /* LU array, size lusize on input */
Entry Udiag [ ], /* size n, diagonal of U */
Int Llen [ ], /* size n, column length of L */
Int Ulen [ ], /* size n, column length of U */
Int Lip [ ], /* size n, column pointers for L */
Int Uip [ ], /* size n, column pointers for U */
Int *lnz, /* size of L*/
Int *unz, /* size of U*/
/* workspace, not defined on input */
Entry X [ ], /* size n, undefined on input, zero on output */
/* workspace, not defined on input or output */
Int Stack [ ], /* size n */
Int Flag [ ], /* size n */
Int Ap_pos [ ], /* size n */
/* other workspace: */
Int Lpend [ ], /* size n workspace, for pruning only */
/* inputs, not modified on output */
Int k1, /* the block of A is from k1 to k2-1 */
Int PSinv [ ], /* inverse of P from symbolic factorization */
double Rs [ ], /* scale factors for A */
/* inputs, modified on output */
Int Offp [ ], /* off-diagonal matrix (modified by this routine) */
Int Offi [ ],
Entry Offx [ ],
/* --------------- */
TRILINOS_KLU_common *Common
)
{
Entry pivot ;
double abs_pivot, xsize, nunits, tol, memgrow ;
Entry *Ux ;
Int *Li, *Ui ;
Unit *LU ; /* LU factors (pattern and values) */
Int k, p, i, j, pivrow, kbar, diagrow, firstrow, lup, top, scale, len ;
size_t newlusize ;
#ifndef NDEBUG
Entry *Lx ;
#endif
ASSERT (Common != NULL) ;
scale = Common->scale ;
tol = Common->tol ;
memgrow = Common->memgrow ;
*lnz = 0 ;
*unz = 0 ;
/* ---------------------------------------------------------------------- */
/* get initial Li, Lx, Ui, and Ux */
/* ---------------------------------------------------------------------- */
PRINTF (("input: lusize %d \n", lusize)) ;
ASSERT (lusize > 0) ;
LU = *p_LU ;
/* ---------------------------------------------------------------------- */
/* initializations */
/* ---------------------------------------------------------------------- */
firstrow = 0 ;
lup = 0 ;
for (k = 0 ; k < n ; k++)
{
/* X [k] = 0 ; */
CLEAR (X [k]) ;
Flag [k] = EMPTY ;
Lpend [k] = EMPTY ; /* flag k as not pruned */
}
/* ---------------------------------------------------------------------- */
/* mark all rows as non-pivotal and determine initial diagonal mapping */
/* ---------------------------------------------------------------------- */
/* PSinv does the symmetric permutation, so don't do it here */
for (k = 0 ; k < n ; k++)
{
P [k] = k ;
Pinv [k] = FLIP (k) ; /* mark all rows as non-pivotal */
}
/* initialize the construction of the off-diagonal matrix */
Offp [0] = 0 ;
/* P [k] = row means that UNFLIP (Pinv [row]) = k, and visa versa.
* If row is pivotal, then Pinv [row] >= 0. A row is initially "flipped"
* (Pinv [k] < EMPTY), and then marked "unflipped" when it becomes
* pivotal. */
#ifndef NDEBUG
for (k = 0 ; k < n ; k++)
{
PRINTF (("Initial P [%d] = %d\n", k, P [k])) ;
}
#endif
/* ---------------------------------------------------------------------- */
/* factorize */
/* ---------------------------------------------------------------------- */
for (k = 0 ; k < n ; k++)
{
PRINTF (("\n\n==================================== k: %d\n", k)) ;
/* ------------------------------------------------------------------ */
/* determine if LU factors have grown too big */
/* ------------------------------------------------------------------ */
/* (n - k) entries for L and k entries for U */
nunits = DUNITS (Int, n - k) + DUNITS (Int, k) +
DUNITS (Entry, n - k) + DUNITS (Entry, k) ;
/* LU can grow by at most 'nunits' entries if the column is dense */
PRINTF (("lup %d lusize %g lup+nunits: %g\n", lup, (double) lusize,
lup+nunits));
xsize = ((double) lup) + nunits ;
if (xsize > (double) lusize)
{
/* check here how much to grow */
xsize = (memgrow * ((double) lusize) + 4*n + 1) ;
if (INT_OVERFLOW (xsize))
{
PRINTF (("Matrix is too large (Int overflow)\n")) ;
Common->status = TRILINOS_KLU_TOO_LARGE ;
return (lusize) ;
}
newlusize = memgrow * lusize + 2*n + 1 ;
/* Future work: retry mechanism in case of malloc failure */
LU = (Unit*) TRILINOS_KLU_realloc (newlusize, lusize, sizeof (Unit), LU, Common) ;
Common->nrealloc++ ;
*p_LU = LU ;
if (Common->status == TRILINOS_KLU_OUT_OF_MEMORY)
{
PRINTF (("Matrix is too large (LU)\n")) ;
return (lusize) ;
}
lusize = newlusize ;
PRINTF (("inc LU to %d done\n", lusize)) ;
}
/* ------------------------------------------------------------------ */
/* start the kth column of L and U */
/* ------------------------------------------------------------------ */
Lip [k] = lup ;
/* ------------------------------------------------------------------ */
/* compute the nonzero pattern of the kth column of L and U */
/* ------------------------------------------------------------------ */
#ifndef NDEBUG
for (i = 0 ; i < n ; i++)
{
ASSERT (Flag [i] < k) ;
/* ASSERT (X [i] == 0) ; */
ASSERT (IS_ZERO (X [i])) ;
}
#endif
top = lsolve_symbolic (n, k, Ap, Ai, Q, Pinv, Stack, Flag,
Lpend, Ap_pos, LU, lup, Llen, Lip, k1, PSinv) ;
#ifndef NDEBUG
PRINTF (("--- in U:\n")) ;
for (p = top ; p < n ; p++)
{
PRINTF (("pattern of X for U: %d : %d pivot row: %d\n",
p, Stack [p], Pinv [Stack [p]])) ;
ASSERT (Flag [Stack [p]] == k) ;
}
PRINTF (("--- in L:\n")) ;
Li = (Int *) (LU + Lip [k]);
for (p = 0 ; p < Llen [k] ; p++)
{
PRINTF (("pattern of X in L: %d : %d pivot row: %d\n",
p, Li [p], Pinv [Li [p]])) ;
ASSERT (Flag [Li [p]] == k) ;
}
p = 0 ;
for (i = 0 ; i < n ; i++)
{
ASSERT (Flag [i] <= k) ;
if (Flag [i] == k) p++ ;
}
#endif
/* ------------------------------------------------------------------ */
/* get the column of the matrix to factorize and scatter into X */
/* ------------------------------------------------------------------ */
construct_column (k, Ap, Ai, Ax, Q, X,
k1, PSinv, Rs, scale, Offp, Offi, Offx) ;
/* ------------------------------------------------------------------ */
/* compute the numerical values of the kth column (s = L \ A (:,k)) */
/* ------------------------------------------------------------------ */
lsolve_numeric (Pinv, LU, Stack, Lip, top, n, Llen, X) ;
#ifndef NDEBUG
for (p = top ; p < n ; p++)
{
PRINTF (("X for U %d : ", Stack [p])) ;
PRINT_ENTRY (X [Stack [p]]) ;
}
Li = (Int *) (LU + Lip [k]) ;
for (p = 0 ; p < Llen [k] ; p++)
{
PRINTF (("X for L %d : ", Li [p])) ;
PRINT_ENTRY (X [Li [p]]) ;
}
#endif
/* ------------------------------------------------------------------ */
/* partial pivoting with diagonal preference */
/* ------------------------------------------------------------------ */
/* determine what the "diagonal" is */
diagrow = P [k] ; /* might already be pivotal */
PRINTF (("k %d, diagrow = %d, UNFLIP (diagrow) = %d\n",
k, diagrow, UNFLIP (diagrow))) ;
/* find a pivot and scale the pivot column */
if (!lpivot (diagrow, &pivrow, &pivot, &abs_pivot, tol, X, LU, Lip,
Llen, k, n, Pinv, &firstrow, Common))
{
/* matrix is structurally or numerically singular */
Common->status = TRILINOS_KLU_SINGULAR ;
if (Common->numerical_rank == EMPTY)
{
Common->numerical_rank = k+k1 ;
Common->singular_col = Q [k+k1] ;
}
if (Common->halt_if_singular)
{
/* do not continue the factorization */
return (lusize) ;
}
}
/* we now have a valid pivot row, even if the column has NaN's or
* has no entries on or below the diagonal at all. */
PRINTF (("\nk %d : Pivot row %d : ", k, pivrow)) ;
PRINT_ENTRY (pivot) ;
ASSERT (pivrow >= 0 && pivrow < n) ;
ASSERT (Pinv [pivrow] < 0) ;
/* set the Uip pointer */
Uip [k] = Lip [k] + UNITS (Int, Llen [k]) + UNITS (Entry, Llen [k]) ;
/* move the lup pointer to the position where indices of U
* should be stored */
lup += UNITS (Int, Llen [k]) + UNITS (Entry, Llen [k]) ;
Ulen [k] = n - top ;
/* extract Stack [top..n-1] to Ui and the values to Ux and clear X */
GET_POINTER (LU, Uip, Ulen, Ui, Ux, k, len) ;
for (p = top, i = 0 ; p < n ; p++, i++)
{
j = Stack [p] ;
Ui [i] = Pinv [j] ;
Ux [i] = X [j] ;
CLEAR (X [j]) ;
}
/* position the lu index at the starting point for next column */
lup += UNITS (Int, Ulen [k]) + UNITS (Entry, Ulen [k]) ;
/* U(k,k) = pivot */
Udiag [k] = pivot ;
/* ------------------------------------------------------------------ */
/* log the pivot permutation */
/* ------------------------------------------------------------------ */
ASSERT (UNFLIP (Pinv [diagrow]) < n) ;
ASSERT (P [UNFLIP (Pinv [diagrow])] == diagrow) ;
if (pivrow != diagrow)
{
/* an off-diagonal pivot has been chosen */
Common->noffdiag++ ;
PRINTF ((">>>>>>>>>>>>>>>>> pivrow %d k %d off-diagonal\n",
pivrow, k)) ;
if (Pinv [diagrow] < 0)
{
/* the former diagonal row index, diagrow, has not yet been
* chosen as a pivot row. Log this diagrow as the "diagonal"
* entry in the column kbar for which the chosen pivot row,
* pivrow, was originally logged as the "diagonal" */
kbar = FLIP (Pinv [pivrow]) ;
P [kbar] = diagrow ;
Pinv [diagrow] = FLIP (kbar) ;
}
}
P [k] = pivrow ;
Pinv [pivrow] = k ;
#ifndef NDEBUG
for (i = 0 ; i < n ; i++) { ASSERT (IS_ZERO (X [i])) ;}
GET_POINTER (LU, Uip, Ulen, Ui, Ux, k, len) ;
for (p = 0 ; p < len ; p++)
{
PRINTF (("Column %d of U: %d : ", k, Ui [p])) ;
PRINT_ENTRY (Ux [p]) ;
}
GET_POINTER (LU, Lip, Llen, Li, Lx, k, len) ;
for (p = 0 ; p < len ; p++)
{
PRINTF (("Column %d of L: %d : ", k, Li [p])) ;
PRINT_ENTRY (Lx [p]) ;
}
#endif
/* ------------------------------------------------------------------ */
/* symmetric pruning */
/* ------------------------------------------------------------------ */
prune (Lpend, Pinv, k, pivrow, LU, Uip, Lip, Ulen, Llen) ;
*lnz += Llen [k] + 1 ; /* 1 added to lnz for diagonal */
*unz += Ulen [k] + 1 ; /* 1 added to unz for diagonal */
}
/* ---------------------------------------------------------------------- */
/* finalize column pointers for L and U, and put L in the pivotal order */
/* ---------------------------------------------------------------------- */
for (p = 0 ; p < n ; p++)
{
Li = (Int *) (LU + Lip [p]) ;
for (i = 0 ; i < Llen [p] ; i++)
{
Li [i] = Pinv [Li [i]] ;
}
}
#ifndef NDEBUG
for (i = 0 ; i < n ; i++)
{
PRINTF (("P [%d] = %d Pinv [%d] = %d\n", i, P [i], i, Pinv [i])) ;
}
for (i = 0 ; i < n ; i++)
{
ASSERT (Pinv [i] >= 0 && Pinv [i] < n) ;
ASSERT (P [i] >= 0 && P [i] < n) ;
ASSERT (P [Pinv [i]] == i) ;
ASSERT (IS_ZERO (X [i])) ;
}
#endif
/* ---------------------------------------------------------------------- */
/* shrink the LU factors to just the required size */
/* ---------------------------------------------------------------------- */
newlusize = lup ;
ASSERT ((size_t) newlusize <= lusize) ;
/* this cannot fail, since the block is descreasing in size */
LU = (Unit*) TRILINOS_KLU_realloc (newlusize, lusize, sizeof (Unit), LU, Common) ;
*p_LU = LU ;
return (newlusize) ;
}
Int KLU_rgrowth /* return TRUE if successful, FALSE otherwise */
(
Int *Ap,
Int *Ai,
double *Ax,
KLU_symbolic *Symbolic,
KLU_numeric *Numeric,
KLU_common *Common
)
{
double temp, max_ai, max_ui, min_block_rgrowth ;
Entry aik ;
Int *Q, *Ui, *Uip, *Ulen, *Pinv ;
Unit *LU ;
Entry *Aentry, *Ux, *Ukk ;
double *Rs ;
Int i, newrow, oldrow, k1, k2, nk, j, oldcol, k, pend, len ;
/* ---------------------------------------------------------------------- */
/* check inputs */
/* ---------------------------------------------------------------------- */
if (Common == NULL)
{
return (FALSE) ;
}
if (Symbolic == NULL || Ap == NULL || Ai == NULL || Ax == NULL)
{
Common->status = KLU_INVALID ;
return (FALSE) ;
}
if (Numeric == NULL)
{
/* treat this as a singular matrix */
Common->rgrowth = 0 ;
Common->status = KLU_SINGULAR ;
return (TRUE) ;
}
Common->status = KLU_OK ;
/* ---------------------------------------------------------------------- */
/* compute the reciprocal pivot growth */
/* ---------------------------------------------------------------------- */
Aentry = (Entry *) Ax ;
Pinv = Numeric->Pinv ;
Rs = Numeric->Rs ;
Q = Symbolic->Q ;
Common->rgrowth = 1 ;
for (i = 0 ; i < Symbolic->nblocks ; i++)
{
k1 = Symbolic->R[i] ;
k2 = Symbolic->R[i+1] ;
nk = k2 - k1 ;
if (nk == 1)
{
continue ; /* skip singleton blocks */
}
LU = (Unit *) Numeric->LUbx[i] ;
Uip = Numeric->Uip + k1 ;
Ulen = Numeric->Ulen + k1 ;
Ukk = ((Entry *) Numeric->Udiag) + k1 ;
min_block_rgrowth = 1 ;
for (j = 0 ; j < nk ; j++)
{
max_ai = 0 ;
max_ui = 0 ;
oldcol = Q[j + k1] ;
pend = Ap [oldcol + 1] ;
for (k = Ap [oldcol] ; k < pend ; k++)
{
oldrow = Ai [k] ;
newrow = Pinv [oldrow] ;
if (newrow < k1)
{
continue ; /* skip entry outside the block */
}
ASSERT (newrow < k2) ;
if (Rs != NULL)
{
/* aik = Aentry [k] / Rs [oldrow] */
SCALE_DIV_ASSIGN (aik, Aentry [k], Rs [newrow]) ;
}
else
{
aik = Aentry [k] ;
}
/* temp = ABS (aik) */
ABS (temp, aik) ;
if (temp > max_ai)
{
max_ai = temp ;
}
}
/* Ui is set but not used. This is OK, because otherwise the macro
would have to be redesigned. */
GET_POINTER (LU, Uip, Ulen, Ui, Ux, j, len) ;
for (k = 0 ; k < len ; k++)
{
/* temp = ABS (Ux [k]) */
ABS (temp, Ux [k]) ;
if (temp > max_ui)
{
max_ui = temp ;
}
}
/* consider the diagonal element */
ABS (temp, Ukk [j]) ;
if (temp > max_ui)
{
max_ui = temp ;
}
/* if max_ui is 0, skip the column */
if (SCALAR_IS_ZERO (max_ui))
{
continue ;
}
temp = max_ai / max_ui ;
if (temp < min_block_rgrowth)
{
min_block_rgrowth = temp ;
}
}
if (min_block_rgrowth < Common->rgrowth)
{
Common->rgrowth = min_block_rgrowth ;
}
}
return (TRUE) ;
}
static void sort (Int n, Int *Xip, Int *Xlen, Unit *LU, Int *Tp, Int *Tj,
Entry *Tx, Int *W)
{
Int *Xi ;
Entry *Xx ;
Int p, i, j, len, nz, tp, xlen, pend ;
ASSERT (KLU_valid_LU (n, FALSE, Xip, Xlen, LU)) ;
/* count the number of entries in each row of L or U */
for (i = 0 ; i < n ; i++)
{
W [i] = 0 ;
}
for (j = 0 ; j < n ; j++)
{
GET_POINTER (LU, Xip, Xlen, Xi, Xx, j, len) ;
for (p = 0 ; p < len ; p++)
{
W [Xi [p]]++ ;
}
}
/* construct the row pointers for T */
nz = 0 ;
for (i = 0 ; i < n ; i++)
{
Tp [i] = nz ;
nz += W [i] ;
}
Tp [n] = nz ;
for (i = 0 ; i < n ; i++)
{
W [i] = Tp [i] ;
}
/* transpose the matrix into Tp, Ti, Tx */
for (j = 0 ; j < n ; j++)
{
GET_POINTER (LU, Xip, Xlen, Xi, Xx, j, len) ;
for (p = 0 ; p < len ; p++)
{
tp = W [Xi [p]]++ ;
Tj [tp] = j ;
Tx [tp] = Xx [p] ;
}
}
/* transpose the matrix back into Xip, Xlen, Xi, Xx */
for (j = 0 ; j < n ; j++)
{
W [j] = 0 ;
}
for (i = 0 ; i < n ; i++)
{
pend = Tp [i+1] ;
for (p = Tp [i] ; p < pend ; p++)
{
j = Tj [p] ;
GET_POINTER (LU, Xip, Xlen, Xi, Xx, j, len) ;
xlen = W [j]++ ;
Xi [xlen] = i ;
Xx [xlen] = Tx [p] ;
}
}
ASSERT (KLU_valid_LU (n, FALSE, Xip, Xlen, LU)) ;
}
