static int DTPUMatCholeskyFactor(void* AA, int *flag){
dtpumat* A=(dtpumat*) AA;
int i;
ffinteger INFO,LDA=1,N=A->n;
double *AP=A->val,*ss=A->sscale,*v;
char UPLO=A->UPLO;
if (N<=0) LDA=1;
else LDA=N;
if (A->scaleit){
for (v=AP,i=0;i<N;i++){ ss[i]=*v;v+=(i+2);}
for (i=0;i<N;i++){ ss[i]=1.0/sqrt(fabs(ss[i])+1.0e-8); }
dtpuscalemat(AP,ss,N);
}
dpptrf(&UPLO, &N, AP, &INFO );
*flag=INFO;
return 0;
}
static void divergence_free_init(Element_List **V, double *u0, double *r,
Bsystem **B, double **wk){
register int i,j,k,cnt;
int eDIM = V[0]->fhead->dim();
int asize,info,Nbmodes;
int **bmap = B[eDIM]->bmap;
int nel = B[eDIM]->nel;
int nglobal = B[eDIM]->nglobal;
int nsolve = B[eDIM]->nsolve;
int vsolve = B[0]->nsolve;
double **a = B[eDIM]->Gmat->a,*x,*b,*sc,*sc1;
static double *invb;
x = dvector(0,nel-1);
/* form and invert B' B system */
if(!invb){
invb = dvector(0,nel*(nel+1)/2-1);
sc = B[0]->signchange;
for(cnt = 0,k = 0; k < nel; ++k){
/* gather B from local systems */
Nbmodes = V[0]->flist[k]->Nbmodes;
asize = Nbmodes*eDIM+1;
b = a[V[0]->flist[k]->geom->id] + asize*(asize-1)/2;
dzero(nglobal,u0,1);
for(j = 0; j < eDIM; ++j){
for(i = 0; i < Nbmodes; ++i)
u0[bmap[k][i+j*Nbmodes]] += sc[i]*b[i+j*Nbmodes];
}
dzero(nglobal-nsolve,u0+nsolve,1);
/* take inner product with B' */
sc1 = B[0]->signchange;
for(j = k; j < nel; ++j,cnt++){
dzero(asize,wk[0],1);
dgathr(asize-1, u0, bmap[j], wk[0]);
for(i = 0; i < eDIM; ++i)
dvmul (Nbmodes, sc1, 1, wk[0]+i*Nbmodes, 1, wk[0]+i*Nbmodes, 1);
Nbmodes = V[0]->flist[j]->Nbmodes;
asize = Nbmodes*eDIM+1;
b = a[V[0]->flist[j]->geom->id] + asize*(asize-1)/2;
invb[cnt] = ddot(asize-1,b,1,wk[0],1);
sc1 += Nbmodes;
}
sc += V[0]->flist[k]->Nbmodes;
}
/* take out first row to deal with singularity */
if(B[eDIM]->singular)
dzero(nel,invb,1); invb[0] = 1.0;
dpptrf('L', nel, invb, info);
}
/* solve B' B x = r */
dcopy (nel,r+eDIM*vsolve,1,x,1);
dpptrs('L', nel, 1, invb, x, nel, info);
dzero(B[eDIM]->nglobal,u0,1);
/* generate initial vector as u0 = B x */
sc = B[0]->signchange;
for(k = 0; k < nel; ++k){
Nbmodes = V[0]->flist[k]->Nbmodes;
asize = Nbmodes*eDIM+1;
b = a[V[0]->flist[k]->geom->id] + asize*(asize-1)/2;
dsmul(asize-1,x[k],b,1,wk[0],1);
for(j = 0; j < eDIM; ++j){
for(i = 0; i < Nbmodes; ++i)
u0[bmap[k][i+j*Nbmodes]] += sc[i]*wk[0][i+j*Nbmodes];
}
sc += Nbmodes;
}
dzero(nglobal-eDIM*vsolve, u0 + eDIM*vsolve, 1);
/* subtract off a*u0 from r */
sc = B[0]->signchange;
for(k = 0; k < nel; ++k){
Nbmodes = V[0]->flist[k]->Nbmodes;
dzero(eDIM*Nbmodes+1,wk[0],1);
dgathr(eDIM*Nbmodes+1, u0, bmap[k], wk[0]);
for(j = 0; j < eDIM; ++j)
dvmul (Nbmodes, sc, 1, wk[0] + j*Nbmodes, 1, wk[0] + j*Nbmodes,1);
dspmv('U',eDIM*Nbmodes+1,1.0,a[V[0]->flist[k]->geom->id],
wk[0],1,0.0,wk[1],1);
for(j = 0; j < eDIM; ++j)
for(i = 0; i < Nbmodes; ++i)
r[bmap[k][i+j*Nbmodes]] -= sc[i]*wk[1][i+j*Nbmodes];
r[bmap[k][eDIM*Nbmodes]] -= wk[1][eDIM*Nbmodes];
sc += Nbmodes;
}
r[eDIM*vsolve] = 0.0;
dzero(nglobal-nsolve, r + nsolve, 1);
free(x);
}
