static void taucs_ccs_amd(taucs_ccs_matrix * m, int **perm, int **invperm, char *which)
{
#ifndef TAUCS_CONFIG_AMD
taucs_printf("taucs_ccs_amd: AMD routines not linked.\n");
*perm = NULL;
*invperm = NULL;
return;
#else
int n, iwlen, pfree, ncmpa, iovflo;
int *iw;
int *pe;
int *degree;
int *nv;
int *next;
int *last;
int *head;
int *elen;
int *w;
int *len;
int nnz, i, j, ip;
taucs_printf("taucs_ccs_amd: starting (%s)\n", which);
if (!(m->flags & TAUCS_SYMMETRIC) && !(m->flags & TAUCS_HERMITIAN)) {
taucs_printf("taucs_ccs_amd: AMD ordering only works on symmetric matrices.\n");
*perm = NULL;
*invperm = NULL;
return;
}
/*
* this routine may actually work on UPPER as well
*/
if (!(m->flags & TAUCS_LOWER)) {
taucs_printf("taucs_ccs_amd: the lower part of the matrix must be represented.\n");
*perm = NULL;
*invperm = NULL;
return;
}
*perm = NULL;
*invperm = NULL;
n = m->n;
nnz = (m->colptr)[n];
pe = (int *) taucs_malloc((n+1) * sizeof(int));
degree = (int *) taucs_malloc(n * sizeof(int));
nv = (int *) taucs_malloc(n * sizeof(int));
next = (int *) taucs_malloc(n * sizeof(int));
last = (int *) taucs_malloc(n * sizeof(int));
head = (int *) taucs_malloc(n * sizeof(int));
elen = (int *) taucs_malloc(n * sizeof(int));
w = (int *) taucs_malloc(n * sizeof(int));
len = (int *) taucs_malloc(n * sizeof(int));
/*
* AMD docs recommend iwlen >= 1.2 nnz, but this leads to compressions
*/
iwlen = n + (int) (10.0 * (nnz - n));
taucs_printf("taucs_ccs_amd: allocating %d ints for iw\n", iwlen);
iw = (int *) taucs_malloc(iwlen * sizeof(int));
if (!pe || !degree || !nv || !next || !last || !head || !elen || !w || !len || !iw) {
taucs_printf("taucs_ccs_amd: out of memory\n");
taucs_free(pe);
taucs_free(degree);
taucs_free(nv);
taucs_free(next);
taucs_free(last);
taucs_free(head);
taucs_free(elen);
taucs_free(w);
taucs_free(len);
taucs_free(iw);
return;
}
/*
* assert(iw && pe && degree && nv && next && last && head && elen && w && len);
*/
int offset;
if (!strcmp(which, "amdc") || !strcmp(which, "amdbarc")){
offset = 0; /* C */
} else {
offset = 1; /* Fortran */
}
iovflo = INT_MAX; /* for 32-bit only! */
for (i = 0; i < n; i++)
len[i] = 0;
for (j = 0; j < n; j++) {
for (ip = (m->colptr)[j]; ip < (m->colptr)[j + 1]; ip++) {
i = (m->rowind)[ip];
if (i != j) {
len[i]++;
len[j]++;
}
}
}
pe[0] = offset;
for (i = 1; i < n; i++)
pe[i] = pe[i - 1] + len[i - 1];
pfree = pe[n - 1] + len[n - 1];
if (offset == 0) {
pe[n] = pfree;
}
/*
* use degree as a temporary
*/
for (i = 0; i < n; i++)
degree[i] = pe[i] - offset;
for (j = 0; j < n; j++) {
for (ip = (m->colptr)[j]; ip < (m->colptr)[j + 1]; ip++) {
i = (m->rowind)[ip];
if (i != j) {
iw[degree[i]] = j + offset;
iw[degree[j]] = i + offset;
degree[i]++;
degree[j]++;
}
}
}
taucs_printf("taucs_ccs_amd: calling amd matrix is %dx%d, nnz=%d\n", n, n, nnz);
if (!strcmp(which, "mmd"))
amdexa_(&n, pe, iw, len, &iwlen, &pfree, nv, next, last, head, elen, degree, &ncmpa, w, &iovflo);
else if (!strcmp(which, "md"))
amdtru_(&n, pe, iw, len, &iwlen, &pfree, nv, next, last, head, elen, degree, &ncmpa, w, &iovflo);
else if (!strcmp(which, "amdbar"))
amdbarnew_(&n, pe, iw, len, &iwlen, &pfree, nv, next, last, head, elen, degree, &ncmpa, w);
else if (!strcmp(which, "amd"))
amdnew_(&n, pe, iw, len, &iwlen, &pfree, nv, next, last, head, elen, degree, &ncmpa, w);
else if (!strcmp(which, "amdc"))
GMRFLib_amdc(n, pe, iw, len, iwlen, pfree, nv, next, last, head, elen, degree, ncmpa, w);
else if (!strcmp(which, "amdbarc"))
GMRFLib_amdbarc(n, pe, iw, len, iwlen, pfree, nv, next, last, head, elen, degree, ncmpa, w);
else {
taucs_printf("taucs_ccs_amd: WARNING - invalid ordering requested (%s)\n", which);
return;
}
taucs_printf("taucs_ccs_amd: amd returned. optimal iwlen=%d (in this run was %d), %d compressions\n", pfree, iwlen, ncmpa);
/*
* { FILE* f; f=fopen("p.ijv","w"); for (i=0; i<n; i++) fprintf(f,"%d\n",last[i]); fclose(f); }
*/
taucs_free(pe);
taucs_free(degree);
taucs_free(nv);
taucs_free(next);
/*
* free(last );
*/
taucs_free(head);
taucs_free(elen);
taucs_free(w);
/*
* free(len );
*/
taucs_free(iw);
for (i = 0; i < n; i++)
last[i]--;
for (i = 0; i < n; i++)
len[last[i]] = i;
*perm = last;
*invperm = len;
#endif
}
taucs_ccs_matrix*
taucs_dtl(ccs_read_mtx)(char* filename,int flags)
{
FILE* f;
taucs_ccs_matrix* m;
int* clen;
int* is;
int* js;
taucs_datatype* vs;
int ncols, nrows, nnz;
int i,j,k,n;
double di,dj;
taucs_datatype dv;
f = fopen (filename , "r");
if (f == NULL) {
taucs_printf("taucs_ccs_read_mtx: could not open mtx file %s\n",filename);
return NULL;
}
if (fscanf(f, "%d %d %d", &nrows, &ncols, &nnz) != 3) {
taucs_printf("taucs_ccs_read_mtx: wrong header\n");
return NULL;
}
n = 10000;
is = (int*) taucs_malloc(n*sizeof(int));
js = (int*) taucs_malloc(n*sizeof(int));
vs = (taucs_datatype*) taucs_malloc(n*sizeof(taucs_datatype));
if (!is || !js || !vs) {
taucs_printf("taucs_ccs_read_mtx: out of memory\n");
taucs_free(is); taucs_free(js); taucs_free(vs);
return NULL;
}
nnz = 0;
nrows = ncols = 0;
while (!feof(f)) {
if (nnz == n) {
n = (int) ( 1.25 * (double) n);
taucs_printf("taucs_ccs_read_mtx: allocating %d ijv's\n",n);
is = (int*) taucs_realloc(is,n*sizeof(int));
js = (int*) taucs_realloc(js,n*sizeof(int));
vs = (taucs_datatype*) taucs_realloc(vs,n*sizeof(taucs_datatype));
if (!is || !js || !vs) {
taucs_printf("taucs_ccs_read_mtx: out of memory\n");
taucs_free(is); taucs_free(js); taucs_free(vs);
return NULL;
}
}
#ifdef TAUCS_CORE_DOUBLE
if (fscanf(f, "%lg %lg %lg", &di, &dj, &dv) != 3) break;
#endif
#ifdef TAUCS_CORE_SINGLE
if (fscanf(f, "%lg %lg %g", &di, &dj, &dv) != 3) break;
#endif
#ifdef TAUCS_CORE_COMPLEX
{
taucs_real_datatype dv_i;
taucs_real_datatype dv_r;
#ifdef TAUCS_CORE_DCOMPLEX
if (fscanf(f, "%lg %lg %lg+%lgi", &di, &dj, &dv_r,&dv_i) != 4) break;
#endif
#ifdef TAUCS_CORE_SCOMPLEX
if (fscanf(f, "%lg %lg %g+%gi", &di, &dj, &dv_r,&dv_i) != 4) break;
#endif
dv = taucs_complex_create(dv_r,dv_i);
}
#endif
is[nnz] = (int)di; js[nnz] = (int)dj; vs[nnz] = dv;/*omer*/
/* upper or lower might be stored, we use lower */
if ((flags & TAUCS_SYMMETRIC) && is[nnz] < js[nnz]) {
int t = is[nnz];
is[nnz] = js[nnz];
js[nnz] = t;
}
if (flags & TAUCS_PATTERN) {
#ifdef TAUCS_CORE_DOUBLE
if (is[nnz] == js[nnz]) vs[nnz] = (double) (nrows+1);
else vs[nnz] = -1.0;
#endif
#ifdef TAUCS_CORE_SINGLE
if (is[nnz] == js[nnz]) vs[nnz] = (float) (nrows+1);
else vs[nnz] = -1.0;
#endif
#ifdef TAUCS_CORE_DCOMPEX
assert(0);
#endif
#ifdef TAUCS_CORE_SCOMPLEX
assert(0);
#endif
}
nrows = max(is[nnz],nrows);
ncols = max(js[nnz],ncols);
nnz++;
}
fclose ( f );
m = (taucs_ccs_matrix*) taucs_malloc(sizeof(taucs_ccs_matrix));
if (!m) {
taucs_printf("taucs_ccs_read_mtx: out of memory\n");
taucs_free(is); taucs_free(js); taucs_free(vs);
return NULL;
}
m->n = nrows;
m->m = ncols;
if (flags & TAUCS_SYMMETRIC)
m->flags = TAUCS_SYMMETRIC | TAUCS_LOWER;
else
m->flags = 0;
#ifdef TAUCS_CORE_DOUBLE
m->flags |= TAUCS_DOUBLE;
#endif
#ifdef TAUCS_CORE_SINGLE
m->flags |= TAUCS_SINGLE;
#endif
#ifdef TAUCS_CORE_DCOMPLEX
m->flags |= TAUCS_DCOMPLEX;
#endif
#ifdef TAUCS_CORE_SCOMPLEX
m->flags |= TAUCS_SCOMPLEX;
#endif
clen = (int*) taucs_malloc((ncols+1) * sizeof(int));
m->colptr = (int*) taucs_malloc((ncols+1) * sizeof(int));
m->rowind = (int*) taucs_malloc(nnz * sizeof(int));
m->taucs_values = (taucs_datatype*) taucs_malloc(nnz * sizeof(taucs_datatype));
if (!clen || !(m->colptr) || !(m->rowind) || !(m->rowind)) {
taucs_printf("taucs_ccs_read_mtx: out of memory: ncols=%d nnz=%d\n",ncols,nnz);
taucs_free(clen); taucs_free(m->colptr); taucs_free(m->rowind);
taucs_free(m->taucs_values);
taucs_free (m); taucs_free(is); taucs_free(js); taucs_free(vs);
return NULL;
}
for (j=0; j<ncols; j++) clen[j] = 0;
for (k=0; k<nnz; k++) {
i = is[k] - 1; /* make it 1-based */
j = js[k] - 1; /* make it 1-based */
( clen[j] )++;
}
/* just check */
k = 0;
for (j=0; j<ncols; j++)
k += clen[j];
assert(k == nnz);
/* now compute column pointers */
k = 0;
for (j=0; j<ncols; j++) {
int tmp;
tmp = clen[j];
clen[j] = (m->colptr[j]) = k;
k += tmp;
}
clen[ncols] = (m->colptr[ncols]) = k;
assert(clen[ncols] == nnz);
/* now read matrix into data structure */
for (k=0; k<nnz; k++) {
i = is[k] - 1; /* make it 1-based */
j = js[k] - 1; /* make it 1-based */
assert(i < nrows);
assert(j < ncols);
(m->taucs_values)[ clen[j] ] = vs[k];
(m->rowind)[ clen[j] ] = i;
clen[j] ++;
}
taucs_free(clen);
taucs_free(vs);
taucs_free(js);
taucs_free(is);
taucs_printf("taucs_ccs_read_mtx: read %s, n=%d\n",filename,m->n);
return m;
}
taucs_ccs_matrix*
taucs_dtl(ccs_read_ccs)(char* filename,int flags)
{
FILE* f;
taucs_ccs_matrix* m;
/*
int* clen;
int* is;
int* js;
taucs_datatype* vs;
int ncols, nrows, nnz;
int i,ip,j,k,n;
*/
/* taucs_datatype dv;*/
/* double di,dj;*/
int i,ip,j,N,*pointers;
f = fopen(filename ,"r");
if (f == NULL) {
taucs_printf("taucs_ccs_read_ccs: could not open ccs file %s\n",filename);
return NULL;
}
fscanf(f,"%d",&N);
pointers = (int*) taucs_malloc((N+1)*sizeof(int));
for(i=0; i<N+1; ++i) {
fscanf(f,"%d",&pointers[i]);
}
m = taucs_dtl(ccs_create)(N, N, pointers[N]);
for (i=0; i<=N; i++) (m->colptr)[i] = pointers[i];
for(i=0; i<pointers[N]; ++i)
fscanf(f,"%d",(m->rowind)+i);
#ifdef TAUCS_CORE_DOUBLE
for(i=0; i<pointers[N]; ++i)
fscanf(f,"%lg",(m->taucs_values)+i);
#endif
#ifdef TAUCS_CORE_SINGLE
for(i=0; i<pointers[N]; ++i)
fscanf(f,"%g",(m->taucs_values)+i);
#endif
#ifdef TAUCS_CORE_DCOMPLEX
for(i=0; i<pointers[N]; ++i) {
taucs_real_datatype dv_r;
taucs_real_datatype dv_i;
fscanf(f,"%lg+%lgi",&dv_r,&dv_i);
(m->taucs_values)[i] = taucs_complex_create(dv_r,dv_i);
}
#endif
#ifdef TAUCS_CORE_SCOMPLEX
for(i=0; i<pointers[N]; ++i) {
taucs_real_datatype dv_r;
taucs_real_datatype dv_i;
fscanf(f,"%g+%gi",&dv_r,&dv_i);
(m->taucs_values)[i] = taucs_complex_create(dv_r,dv_i);
}
#endif
if (flags & TAUCS_SYMMETRIC) {
m->flags = TAUCS_SYMMETRIC | TAUCS_LOWER;
for (j=0; j<N; j++) {
for (ip=(m->colptr)[j]; ip<(m->colptr)[j+1]; ip++) {
i = (m->rowind)[ip];
assert(i >= j);
}
}
} else
m->flags = 0;
#ifdef TAUCS_CORE_DOUBLE
m->flags |= TAUCS_DOUBLE;
#endif
#ifdef TAUCS_CORE_SINGLE
m->flags |= TAUCS_SINGLE;
#endif
#ifdef TAUCS_CORE_DCOMPLEX
m->flags |= TAUCS_DCOMPLEX;
#endif
#ifdef TAUCS_CORE_SCOMPLEX
m->flags |= TAUCS_SCOMPLEX;
#endif
taucs_free(pointers);
taucs_printf("taucs_ccs_read_ccs: read %s, n=%d\n",filename,m->n);
return m;
}
taucs_ccs_matrix*
taucs_ccs_read_binary(char* filename)
{
taucs_ccs_matrix* A = NULL; /* warning*/
int nrows,ncols,flags,j;/*nnz, omer*/
int f;
ssize_t bytes_read;
int* colptr;
taucs_printf("taucs_ccs_binary: reading binary matrix %s\n",filename);
#ifdef OSTYPE_win32
f = open(filename,_O_RDONLY |_O_BINARY);
#else
f = open(filename,O_RDONLY);
#endif
/*f = open(filename,O_RDONLY);*/
bytes_read = read(f,&nrows,sizeof(int));
bytes_read = read(f,&ncols,sizeof(int));
bytes_read = read(f,&flags,sizeof(int));
taucs_printf("\t%d-by-%d, flags = %08x\n",nrows,ncols,flags);
taucs_printf("\t%d-by-%d, flags = %d \n",nrows,ncols,flags);
colptr = (int*) taucs_malloc((ncols+1) * sizeof(int));
assert(colptr);
bytes_read = read(f,colptr,(ncols+1)*sizeof(int));
taucs_printf("colptr = [");
for(j=0; j<min(ncols-1,10); j++)
taucs_printf("%d,",colptr[j]);
taucs_printf("...,%d]\n",colptr[ncols]);
if ( 0 ) /* we need this so that we have 'else if' in each type */
{}
#ifdef TAUCS_DOUBLE_IN_BUILD
else if (flags & TAUCS_DOUBLE) {
A = taucs_dccs_create(nrows,ncols,colptr[ncols]);
if (!A) return NULL;
bytes_read = read(f,A->rowind,colptr[ncols]*sizeof(int));
bytes_read = read(f,A->values.d,colptr[ncols]*sizeof(taucs_double));
}
#endif
#ifdef TAUCS_SINGLE_IN_BUILD
else if (flags & TAUCS_SINGLE) {
A = taucs_sccs_create(nrows,ncols,colptr[ncols]);
if (!A) return NULL;
bytes_read = read(f,A->rowind,colptr[ncols]*sizeof(int));
bytes_read = read(f,A->values.s,colptr[ncols]*sizeof(taucs_single));
}
#endif
#ifdef TAUCS_DCOMPLEX_IN_BUILD
else if (flags & TAUCS_DCOMPLEX) {
A = taucs_zccs_create(nrows,ncols,colptr[ncols]);
if (!A) return NULL;
bytes_read = read(f,A->rowind,colptr[ncols]*sizeof(int));
bytes_read = read(f,A->values.z,colptr[ncols]*sizeof(taucs_dcomplex));
}
#endif
#ifdef TAUCS_SCOMPLEX_IN_BUILD
else if (flags & TAUCS_SCOMPLEX) {
A = taucs_cccs_create(nrows,ncols,colptr[ncols]);
if (!A) return NULL;
bytes_read = read(f,A->rowind,colptr[ncols]*sizeof(int));
bytes_read = read(f,A->values.c,colptr[ncols]*sizeof(taucs_scomplex));
}
#endif
else {
assert(0);
}
A->flags = flags;
for (j=0; j<=ncols; j++) (A->colptr)[j] = colptr[j];
taucs_free(colptr);
close(f);
taucs_printf("taucs_ccs_read_binary: done reading\n");
return A;
}
taucs_ccs_matrix*
taucs_dtl(ccs_read_ijv)(char* ijvfilename,int flags,int base)
{
/* omer - base is 0 when the ijv file is 1-based and 1 when the ijv file
is 0-based. we add base to the i's and j's found.*/
FILE* f;
taucs_ccs_matrix* m;
int* clen;
int* is;
int* js;
taucs_datatype* vs;
int ncols, nrows, nnz;
int i,j,k,n;
double di,dj;
taucs_datatype dv;
f = fopen (ijvfilename , "r");
if (f == NULL) {
taucs_printf("taucs_ccs_read_ijv: could not open ijv file %s\n",ijvfilename);
return NULL;
}
n = 10000;
is = (int*) taucs_malloc(n*sizeof(int));
js = (int*) taucs_malloc(n*sizeof(int));
vs = (taucs_datatype*) taucs_malloc(n*sizeof(taucs_datatype));
if (!is || !js || !vs) {
taucs_printf("symccs_read_ijv: out of memory\n");
taucs_free(is); taucs_free(js); taucs_free(vs);
return NULL;
}
nnz = 0;
nrows = ncols = 0;
while (!feof(f)) {
if (nnz == n) {
n = (int) ( 1.25 * (double) n);
taucs_printf("taucs_ccs_read_ijv: allocating %d ijv's\n",n);
is = (int*) taucs_realloc(is,n*sizeof(int));
js = (int*) taucs_realloc(js,n*sizeof(int));
vs = (taucs_datatype*) taucs_realloc(vs,n*sizeof(taucs_datatype));
if (!is || !js || !vs) {
taucs_printf("taucs_ccs_read_ijv: out of memory\n");
taucs_free(is); taucs_free(js); taucs_free(vs);
return NULL;
}
}
#ifdef TAUCS_CORE_DOUBLE
if (fscanf(f, "%lg %lg %lg", &di, &dj, &dv) != 3) break;
#endif
#ifdef TAUCS_CORE_SINGLE
if (fscanf(f, "%lg %lg %g", &di, &dj, &dv) != 3) break;
#endif
#ifdef TAUCS_CORE_COMPLEX
{
taucs_real_datatype dv_i;
taucs_real_datatype dv_r;
#ifdef TAUCS_CORE_DCOMPLEX
if (fscanf(f, "%lg %lg %lg+%lgi", &di, &dj, &dv_r,&dv_i) != 4) break;
#endif
#ifdef TAUCS_CORE_SCOMPLEX
if (fscanf(f, "%lg %lg %g+%gi", &di, &dj, &dv_r, &dv_i) != 4) break;
#endif
dv = taucs_complex_create(dv_r,dv_i);
}
#endif
is[nnz] = (int)di+base; js[nnz] = (int)dj+base; vs[nnz] = dv;/*omer*/
/* we read the lower part */
if ((flags & TAUCS_SYMMETRIC) && is[nnz] < js[nnz]) continue;
if ((flags & TAUCS_HERMITIAN) && is[nnz] < js[nnz]) continue;
nrows = max(is[nnz],nrows);
ncols = max(js[nnz],ncols);
nnz++;
}
fclose ( f );
m = (taucs_ccs_matrix*) taucs_malloc(sizeof(taucs_ccs_matrix));
if (!m) {
taucs_printf("taucs_ccs_read_ijv: out of memory\n");
taucs_free(is); taucs_free(js); taucs_free(vs);
return NULL;
}
m->n = ncols;
m->m = nrows;
m->flags = 0;
if (flags & TAUCS_SYMMETRIC)
m->flags = TAUCS_SYMMETRIC | TAUCS_LOWER;
if (flags & TAUCS_HERMITIAN)
m->flags = TAUCS_HERMITIAN | TAUCS_LOWER;
#ifdef TAUCS_CORE_DOUBLE
m->flags |= TAUCS_DOUBLE;
#endif
#ifdef TAUCS_CORE_SINGLE
m->flags |= TAUCS_SINGLE;
#endif
#ifdef TAUCS_CORE_DCOMPLEX
m->flags |= TAUCS_DCOMPLEX;
#endif
#ifdef TAUCS_CORE_SCOMPLEX
m->flags |= TAUCS_SCOMPLEX;
#endif
clen = (int*) taucs_malloc((ncols+1) * sizeof(int));
m->colptr = (int*) taucs_malloc((ncols+1) * sizeof(int));
m->rowind = (int*) taucs_malloc(nnz * sizeof(int));
m->taucs_values = (taucs_datatype*) taucs_malloc(nnz * sizeof(taucs_datatype));
if (!clen || !(m->colptr) || !(m->rowind) || !(m->rowind)) {
taucs_printf("taucs_ccs_read_ijv: out of memory: ncols=%d nnz=%d\n",ncols,nnz);
taucs_free(clen); taucs_free(m->colptr); taucs_free(m->rowind);
taucs_free(m->taucs_values);
taucs_free (m); taucs_free(is); taucs_free(js); taucs_free(vs);
return NULL;
}
for (j=0; j<ncols; j++) clen[j] = 0;
for (k=0; k<nnz; k++) {
i = is[k] - 1; /* make it 1-based */
j = js[k] - 1; /* make it 1-based */
if ( j<0 || j>ncols ) taucs_printf("j=%d k=%d\n",j,k);
( clen[j] )++;
}
/* just check */
k = 0;
for (j=0; j<ncols; j++)
k += clen[j];
if (k!=nnz) taucs_printf("k=%d, nnz=%d\n",k,nnz);
assert(k == nnz);
/* now compute column pointers */
k = 0;
for (j=0; j<ncols; j++) {
int tmp;
tmp = clen[j];
clen[j] = (m->colptr[j]) = k;
k += tmp;
}
clen[ncols] = (m->colptr[ncols]) = k;
assert(clen[ncols] == nnz);
/* now read matrix into data structure */
for (k=0; k<nnz; k++) {
i = is[k] - 1; /* make it 1-based */
j = js[k] - 1; /* make it 1-based */
assert(i < nrows);
assert(j < ncols);
(m->taucs_values)[ clen[j] ] = vs[k];
(m->rowind)[ clen[j] ] = i;
clen[j] ++;
}
taucs_free(clen);
taucs_free(vs);
taucs_free(js);
taucs_free(is);
taucs_printf("taucs_ccs_read_ijv: read %s, n=%d\n",ijvfilename,m->n);
return m;
}
taucs_ccs_matrix *taucs_dtl(ccs_permute_symmetrically) (taucs_ccs_matrix * A, int *perm, int *invperm) {
taucs_ccs_matrix *PAPT;
int n;
int nnz;
/*
* int* colptr;
*/
int *len;
int i, j, ip, I, J;
taucs_datatype AIJ;
assert(A->flags & TAUCS_SYMMETRIC || A->flags & TAUCS_HERMITIAN);
assert(A->flags & TAUCS_LOWER);
n = A->n;
nnz = (A->colptr)[n];
PAPT = taucs_dtl(ccs_create) (n, n, nnz);
if (!PAPT)
return NULL;
/*
* PAPT->flags = TAUCS_SYMMETRIC | TAUCS_LOWER;
*/
PAPT->flags = A->flags;
len = (int *) taucs_malloc(n * sizeof(int));
/*
* colptr = (int*) taucs_malloc(n * sizeof(int));
*/
if (!len) {
taucs_printf("taucs_ccs_permute_symmetrically: out of memory\n");
taucs_ccs_free(PAPT);
return NULL;
}
for (j = 0; j < n; j++)
len[j] = 0;
for (j = 0; j < n; j++) {
for (ip = (A->colptr)[j]; ip < (A->colptr)[j + 1]; ip++) {
/*
* i = (A->rowind)[ip] - (A->indshift);
*/
i = (A->rowind)[ip];
I = invperm[i];
J = invperm[j];
if (I < J) {
int T = I;
I = J;
J = T;
}
len[J]++;
}
}
(PAPT->colptr)[0] = 0;
for (j = 1; j <= n; j++)
(PAPT->colptr)[j] = (PAPT->colptr)[j - 1] + len[j - 1];
for (j = 0; j < n; j++)
len[j] = (PAPT->colptr)[j];
for (j = 0; j < n; j++) {
for (ip = (A->colptr)[j]; ip < (A->colptr)[j + 1]; ip++) {
/*
* i = (A->rowind)[ip] - (A->indshift);
*/
i = (A->rowind)[ip];
AIJ = (A->taucs_values)[ip];
I = invperm[i];
J = invperm[j];
if (I < J) {
int T = I;
I = J;
J = T;
if (A->flags & TAUCS_HERMITIAN)
AIJ = taucs_conj(AIJ);
}
/*
* (PAPT->rowind)[ len[J] ] = I + (PAPT->indshift);
*/
(PAPT->rowind)[len[J]] = I;
(PAPT->taucs_values)[len[J]] = AIJ;
len[J]++;
}
}
taucs_free(len);
return PAPT;
}
/* split into left p columns, right p columns */
void taucs_dtl(ccs_split) (taucs_ccs_matrix * A, taucs_ccs_matrix ** L, taucs_ccs_matrix ** R, int p) {
int i, n;
int Lnnz, Rnnz;
assert((A->flags & TAUCS_SYMMETRIC) || (A->flags & TAUCS_TRIANGULAR));
assert(A->flags & TAUCS_LOWER);
n = A->n;
*L = (taucs_ccs_matrix *) taucs_malloc(sizeof(taucs_ccs_matrix));
*R = (taucs_ccs_matrix *) taucs_malloc(sizeof(taucs_ccs_matrix));
if (!(*L) || !(*R)) {
taucs_printf("taucs_ccs_split: out of memory\n");
taucs_free(*L);
taucs_free(*R);
*L = *R = NULL;
return;
}
Lnnz = 0;
for (i = 0; i < p; i++)
Lnnz += ((A->colptr)[i + 1] - (A->colptr)[i]);
(*L)->flags |= TAUCS_SYMMETRIC | TAUCS_LOWER;
(*L)->n = n;
(*L)->m = n;
(*L)->colptr = (int *) taucs_malloc((n + 1) * sizeof(int));
(*L)->rowind = (int *) taucs_malloc(Lnnz * sizeof(int));
(*L)->taucs_values = (void *) taucs_malloc(Lnnz * sizeof(taucs_datatype));
if (!((*L)->colptr) || !((*L)->rowind) || !((*L)->rowind)) {
taucs_printf("taucs_ccs_split: out of memory: n=%d nnz=%d\n", n, Lnnz);
taucs_free((*L)->colptr);
taucs_free((*L)->rowind);
taucs_free((*L)->taucs_values);
taucs_free((*L));
return;
}
for (i = 0; i <= p; i++)
((*L)->colptr)[i] = (A->colptr)[i];
for (i = p + 1; i < n + 1; i++)
((*L)->colptr)[i] = ((*L)->colptr)[p]; /* other columns are empty */
for (i = 0; i < Lnnz; i++) {
((*L)->rowind)[i] = (A->rowind)[i];
((*L)->taucs_values)[i] = (A->taucs_values)[i];
}
/*
* now copy right part of matrix into a p-by-p matrix
*/
Rnnz = 0;
for (i = p; i < n; i++)
Rnnz += ((A->colptr)[i + 1] - (A->colptr)[i]);
(*R)->flags = TAUCS_SYMMETRIC | TAUCS_LOWER;
(*R)->n = n - p;
(*R)->m = n - p;
(*R)->colptr = (int *) taucs_malloc((n - p + 1) * sizeof(int));
(*R)->rowind = (int *) taucs_malloc(Rnnz * sizeof(int));
(*R)->taucs_values = (void *) taucs_malloc(Rnnz * sizeof(taucs_datatype));
if (!((*R)->colptr) || !((*R)->rowind) || !((*R)->rowind)) {
taucs_printf("taucs_ccs_split: out of memory (3): p=%d nnz=%d\n", p, Rnnz);
taucs_free((*R)->colptr);
taucs_free((*R)->rowind);
taucs_free((*R)->taucs_values);
taucs_free((*L)->colptr);
taucs_free((*L)->rowind);
taucs_free((*L)->taucs_values);
taucs_free((*R));
taucs_free((*L));
return;
}
for (i = 0; i <= (n - p); i++)
((*R)->colptr)[i] = (A->colptr)[i + p] - Lnnz;
for (i = 0; i < Rnnz; i++) {
((*R)->rowind)[i] = (A->rowind)[i + Lnnz] - p;
((*R)->taucs_values)[i] = (A->taucs_values)[i + Lnnz];
}
}
void *taucs_dtl(vec_create) (int n) {
return (taucs_datatype *) taucs_malloc(n * sizeof(taucs_datatype));
}
static void
taucs_ccs_metis(taucs_ccs_matrix* m,
int** perm, int** invperm,
char* which)
{
#ifndef TAUCS_CONFIG_METIS
taucs_printf("taucs_ccs_metis: METIS routines not linked.\n");
*perm = NULL;
*invperm = NULL;
return;
#else
int n,nnz,i,j,ip;
int* xadj;
int* adj;
int num_flag = 0;
int options_flag = 0;
int* len;
int* ptr;
/* taucs_printf("taucs_ccs_metis: starting (%s)\n",which); */
if (!(m->flags & TAUCS_SYMMETRIC) && !(m->flags & TAUCS_HERMITIAN)) {
taucs_printf("taucs_ccs_treeorder: METIS ordering only works on symmetric matrices.\n");
*perm = NULL;
*invperm = NULL;
return;
}
/* this routine may actually work on UPPER as well */
if (!(m->flags & TAUCS_LOWER)) {
taucs_printf("taucs_ccs_metis: the lower part of the matrix must be represented.\n");
*perm = NULL;
*invperm = NULL;
return;
}
n = m->n;
nnz = (m->colptr)[n];
*perm = (int*) taucs_malloc(n * sizeof(int));
*invperm = (int*) taucs_malloc(n * sizeof(int));
xadj = (int*) taucs_malloc((n+1) * sizeof(int));
/* Change suggested by Yifan Hu for diagonal matrices */
/* and for matrices with no diagonal */
/* adj = (int*) taucs_malloc(2*(nnz-n) * sizeof(int));*/
adj = (int*) taucs_malloc(2* nnz * sizeof(int));
if (!(*perm) || !(*invperm) || !xadj || !adj) {
taucs_free(*perm);
taucs_free(*invperm);
taucs_free(xadj);
taucs_free(adj);
*perm = *invperm = NULL;
return;
}
/* assert(*perm && *invperm && xadj && adj);*/
ptr = len = *perm;
for (i=0; i<n; i++) len[i] = 0;
for (j=0; j<n; j++) {
for (ip = (m->colptr)[j]; ip < (m->colptr)[j+1]; ip++) {
/*i = (m->rowind)[ip] - (m->indshift);*/
i = (m->rowind)[ip];
if (i != j) {
len[i] ++;
len[j] ++;
}
}
}
xadj[0] = 0;
for (i=1; i<=n; i++) xadj[i] = xadj[i-1] + len[i-1];
for (i=0; i<n; i++) ptr[i] = xadj[i];
for (j=0; j<n; j++) {
for (ip = (m->colptr)[j]; ip < (m->colptr)[j+1]; ip++) {
/*i = (m->rowind)[ip] - (m->indshift);*/
i = (m->rowind)[ip];
if (i != j) {
adj[ ptr[i] ] = j;
adj[ ptr[j] ] = i;
ptr[i] ++;
ptr[j] ++;
}
}
}
/* taucs_printf("taucs_ccs_metis: calling metis matrix is %dx%d, nnz=%d\n", */
/* n,n,nnz); */
METIS_NodeND(&n,
xadj,adj,
&num_flag, &options_flag,
*perm,*invperm);
/* taucs_printf("taucs_ccs_metis: metis returned\n"); */
/*
{
FILE* f;
f=fopen("p.ijv","w");
for (i=0; i<n; i++) fprintf(f,"%d\n",last[i]);
fclose(f);
}
*/
taucs_free(xadj);
taucs_free(adj);
#endif
}
static void
taucs_ccs_treeorder(taucs_ccs_matrix* m,
int** perm,
int** invperm)
{
int n,nnz,i,j,ip,k,p,nleaves;
int* adjptr;
int* adj;
int* len;
int* ptr;
int* degree;
int* leaves;
if (!(m->flags & TAUCS_SYMMETRIC) && !(m->flags & TAUCS_HERMITIAN)) {
taucs_printf("taucs_ccs_treeorder: tree ordering only works on symmetric matrices.\n");
*perm = NULL;
*invperm = NULL;
return;
}
/* this routine may actually work on UPPER as well */
if (!(m->flags & TAUCS_LOWER)) {
taucs_printf("taucs_ccs_treeorder: the lower part of the matrix must be represented.\n");
*perm = NULL;
*invperm = NULL;
return;
}
n = m->n;
nnz = (m->colptr)[n];
taucs_printf("taucs_ccs_treeorder: starting, matrix is %dx%d, # edges=%d\n",
n,n,nnz-n);
*perm = (int*) taucs_malloc(n * sizeof(int));
*invperm = (int*) taucs_malloc(n * sizeof(int));
/* we can reuse buffers: don't need invperm until the end */
/* also, we can reuse perm for leaves but it's messy. */
len = (int*) taucs_malloc(n * sizeof(int));
degree = (int*) taucs_malloc(n * sizeof(int));
leaves = (int*) taucs_malloc(n * sizeof(int));
adjptr = (int*) taucs_malloc(n * sizeof(int));
adj = (int*) taucs_malloc(2*(nnz-n) * sizeof(int));
if (!(*perm) || !(*invperm) || !adjptr || !adj || !len || !degree || ! leaves) {
taucs_free(adj);
taucs_free(adjptr);
taucs_free(len);
taucs_free(leaves);
taucs_free(degree);
taucs_free(*perm);
taucs_free(*invperm);
*perm = *invperm = NULL;
}
for (i=0; i<n; i++) len[i] = 0;
for (j=0; j<n; j++) {
for (ip = (m->colptr)[j]; ip < (m->colptr)[j+1]; ip++) {
/*i = (m->rowind)[ip] - (m->indshift);*/
i = (m->rowind)[ip];
if (i != j) {
len[i] ++;
len[j] ++;
}
}
}
nleaves = 0;
for (i=0; i<n; i++) {
degree[i] = len[i];
if (degree[i] <= 1) {
leaves[nleaves] = i;
nleaves++;
}
}
adjptr[0] = 0;
for (i=1; i<n; i++) adjptr[i] = adjptr[i-1] + len[i-1];
ptr = *perm;
for (i=0; i<n; i++) ptr[i] = adjptr[i];
for (j=0; j<n; j++) {
for (ip = (m->colptr)[j]; ip < (m->colptr)[j+1]; ip++) {
/*i = (m->rowind)[ip] - (m->indshift);*/
i = (m->rowind)[ip];
if (i != j) {
adj[ ptr[i] ] = j;
adj[ ptr[j] ] = i;
ptr[i] ++;
ptr[j] ++;
}
}
}
/*
taucs_printf("taucs_ccs_treeorder: %d initial leaves: ",nleaves);
for (i=0; i<nleaves; i++)
taucs_printf("%d ",leaves[i]);
taucs_printf("\n");
*/
for (i=0; i<n; i++) {
nleaves--;
if (nleaves <= 0) {
/* not a tree */
taucs_free(adj);
taucs_free(adjptr);
taucs_free(len);
taucs_free(leaves);
taucs_free(degree);
taucs_free(*perm);
taucs_free(*invperm);
*perm = *invperm = NULL;
}
j = leaves[nleaves];
/*taucs_printf("taucs_ccs_treeorder: next leaf is %d, degree=%d\n",j,len[j]);*/
(*perm) [ i ] = j;
(*invperm)[ j ] = i;
if (len[j] > 0) {
if (len[j] != 1) {
/* not a tree */
taucs_free(adj);
taucs_free(adjptr);
taucs_free(len);
taucs_free(leaves);
taucs_free(degree);
taucs_free(*perm);
taucs_free(*invperm);
*perm = *invperm = NULL;
}
p = adj[ adjptr[j] ];
/*taucs_printf("taucs_ccs_treeorder: parent of %d is %d\n",j,p);*/
for (k = 0; k < len[p]; k++)
if (adj[ adjptr[p] + k ] == j) break;
if ( k >= len[p] ) { /* otherwise j does not show up in p's adjacency list */
/* not a tree */
taucs_free(adj);
taucs_free(adjptr);
taucs_free(len);
taucs_free(leaves);
taucs_free(degree);
taucs_free(*perm);
taucs_free(*invperm);
*perm = *invperm = NULL;
}
/* now delete j from p's adjacency list and compress */
len[p] --;
for (; k < len[p]; k++)
adj[ adjptr[p] + k ] = adj[ adjptr[p] + k+1 ];
if (len[p] == 1) { /* degree was higher and now is 1 */
leaves[ nleaves ] = p;
nleaves++;
}
}
}
taucs_free(adj);
taucs_free(adjptr);
taucs_free(len);
taucs_free(leaves);
taucs_free(degree);
/*
taucs_printf("taucs_ccs_treeorder: ordering: ");
for (i=0; i<n; i++)
taucs_printf("%d ",(*perm)[i]);
taucs_printf("\n");
*/
taucs_printf("taucs_ccs_treeorder: done\n");
}
static void
taucs_ccs_genmmd(taucs_ccs_matrix* m,
int** perm, int** invperm,
char* which)
{
#ifndef TAUCS_CONFIG_GENMMD
taucs_printf("taucs_ccs_genmmd: GENMMD routines not linked.\n");
*perm = NULL;
*invperm = NULL;
return;
#else
int n, maxint, delta, nofsub;
int* xadj;
int* adjncy;
int* invp;
int* prm;
int* dhead;
int* qsize;
int* llist;
int* marker;
int* len;
int* next;
int nnz,i,j,ip;
/*taucs_printf("taucs_ccs_genmmd: starting (%s)\n",which);*/
if (!(m->flags & TAUCS_SYMMETRIC) && !(m->flags & TAUCS_HERMITIAN)) {
taucs_printf("taucs_ccs_genmmd: GENMMD ordering only works on symmetric matrices.\n");
*perm = NULL;
*invperm = NULL;
return;
}
/* this routine may actually work on UPPER as well */
if (!(m->flags & TAUCS_LOWER)) {
taucs_printf("taucs_ccs_genmmd: the lower part of the matrix must be represented.\n");
*perm = NULL;
*invperm = NULL;
return;
}
*perm = NULL;
*invperm = NULL;
n = m->n;
nnz = (m->colptr)[n];
/* I copied the value of delta and the size of */
/* from SuperLU. Sivan */
delta = 1; /* DELTA is a parameter to allow the choice of nodes
whose degree <= min-degree + DELTA. */
delta = 1; /* DELTA is a parameter to allow the choice of nodes
whose degree <= min-degree + DELTA. */
/*maxint = 2147483648;*/ /* 2**31-1, for 32-bit only! */
maxint = 32000;
assert(sizeof(int) == 4);
maxint = 2147483647; /* 2**31-1, for 32-bit only! */
xadj = (int*) taucs_malloc((n+1) * sizeof(int));
adjncy = (int*) taucs_malloc((2*nnz-n) * sizeof(int));
invp = (int*) taucs_malloc((n+1) * sizeof(int));
prm = (int*) taucs_malloc(n * sizeof(int));
dhead = (int*) taucs_malloc((n+1) * sizeof(int));
qsize = (int*) taucs_malloc((n+1) * sizeof(int));
llist = (int*) taucs_malloc(n * sizeof(int));
marker = (int*) taucs_malloc(n * sizeof(int));
if (!xadj || !adjncy || !invp || !prm
|| !dhead || !qsize || !llist || !marker) {
taucs_free(xadj );
taucs_free(adjncy);
taucs_free(invp );
taucs_free(prm );
taucs_free(dhead );
taucs_free(qsize );
taucs_free(llist );
taucs_free(marker);
return;
}
len = dhead; /* we reuse space */
next = qsize; /* we reuse space */
for (i=0; i<n; i++) len[i] = 0;
for (j=0; j<n; j++) {
for (ip = (m->colptr)[j]; ip < (m->colptr)[j+1]; ip++) {
/*i = (m->rowind)[ip] - (m->indshift);*/
i = (m->rowind)[ip];
if (i != j) {
len[i] ++;
len[j] ++;
} else {
/*len[i] ++;*/
}
}
}
xadj[0] = 1;
for (i=1; i<=n; i++) xadj[i] = xadj[i-1] + len[i-1];
/*for (i=0; i<=n; i++) printf("xadj[%d]=%d\n",i,xadj[i]);*/
/* use degree as a temporary */
for (i=0; i<n; i++) next[i] = xadj[i] - 1;
for (j=0; j<n; j++) {
for (ip = (m->colptr)[j]; ip < (m->colptr)[j+1]; ip++) {
/*i = (m->rowind)[ip] - (m->indshift);*/
i = (m->rowind)[ip];
assert( next[i] < 2*nnz-n );
assert( next[j] < 2*nnz-n );
if (i != j) {
adjncy[ next[i] ] = j+1;
adjncy[ next[j] ] = i+1;
next[i] ++;
next[j] ++;
} else {
/*
adjncy[ next[i] ] = j+1;
next[i] ++;
*/
}
}
}
/*
for (j=0; j<n; j++) {
qsort(adjncy + (xadj[j] - 1),
xadj[j+1] - xadj[j],
sizeof(int),
compare_ints);
printf("+++ %d: ",j+1);
for (ip=xadj[j]-1; ip<xadj[j+1]-1;ip++)
printf("%d ",adjncy[ip]);
printf("\n");
}
*/
/*
taucs_printf("taucs_ccs_genmmd: calling genmmd, matrix is %dx%d, nnz=%d\n",
n,n,nnz);
*/
genmmd_(&n,
xadj, adjncy,
invp,prm,
&delta,
dhead,qsize,llist,marker,
&maxint,&nofsub);
/*taucs_printf("taucs_ccs_genmmd: genmmd returned.\n");*/
/*
{
FILE* f;
f=fopen("p.ijv","w");
for (i=0; i<n; i++) fprintf(f,"%d %d\n",prm[i],invp[i]);
fclose(f);
}
*/
taucs_free(marker);
taucs_free(llist );
taucs_free(qsize );
taucs_free(dhead );
taucs_free(xadj );
taucs_free(adjncy);
for (i=0; i<n; i++) prm[i] --;
for (i=0; i<n; i++) invp[ prm[i] ] = i;
*perm = prm;
*invperm = invp;
#endif
}
static void
taucs_ccs_colamd(taucs_ccs_matrix* m,
int** perm, int** invperm,
char* which)
{
#ifndef TAUCS_CONFIG_COLAMD
taucs_printf("taucs_ccs_colamd: COLAMD routines not linked.\n");
*perm = NULL;
*invperm = NULL;
return;
#else
double knobs[COLAMD_KNOBS];
int Alen;
int* A;
int* p;
int* ip;
int k,nnz;
int i;
if (m->flags & TAUCS_SYMMETRIC || m->flags & TAUCS_HERMITIAN) {
taucs_printf("taucs_ccs_colamd: not applicable for symmetric or hermitian matrices\n");
return;
}
taucs_printf("taucs_ccs_colamd: starting\n");
*perm = NULL;
*invperm = NULL;
nnz = (m->colptr)[m->n];
p = (int*) taucs_malloc((m->n + 1) * sizeof(int));
ip = (int*) taucs_malloc((m->n + 1) * sizeof(int));
assert(p && ip);
Alen = colamd_recommended(nnz, m->m, m->n);
A = taucs_malloc(Alen * sizeof(int)); assert(A);
assert(A);
colamd_set_defaults (knobs) ;
for (i=0; i<=m->n; i++) p[i] = (m->colptr)[i];
for (k=0; k<nnz; k++) A[k] = (m->rowind)[k];
taucs_printf("oocsp_ccs_colamd: calling colamd matrix is %dx%d, nnz=%d\n",
m->m,m->n,nnz);
if (!colamd (m->m, m->n, Alen, A, p, knobs)) {
taucs_printf("oocsp_ccs_colamd: colamd failed\n");
taucs_free(A);
taucs_free(p);
return;
}
taucs_printf("oocsp_ccs_colamd: colamd returned\n");
taucs_free(A);
*perm = p;
*invperm = ip;
for (i=0; i<m->n; i++) (*invperm)[(*perm)[i]] = i;
#endif
}
