static void solve_pressure(Element_List **V, double *rhs, Bsystem **Vbsys)
{
register int i;
int eDIM = V[0]->flist[0]->dim();
int info,N,nbl,nblv,id,*bmap;
Bsystem *B = Vbsys[0], *PB = Vbsys[eDIM];
Element *E;
double *hj,*tmp;
double *sc = B->signchange;
if(eDIM == 2)
tmp = dvector(0,8*LGmax);
else
tmp = dvector(0,18*(LGmax-1)*(LGmax-1));
/* back solve for pressure */
for(E=V[eDIM]->fhead;E;E=E->next)
{
N = E->Nmodes - 1;
id = E->geom->id;
hj = E->vert->hj + 1;
E->state = 't';
/* solve interior and negate */
if(PB->lambda->wave)
{
dgetrs('N', N, 1, PB->Gmat->invc[id], N, PB->Gmat->cipiv[id],hj, N,
info);
}
else
{
dpptrs('L', N, 1, PB->Gmat->invc[id], hj, N, info);
dneg(N,hj,1);
}
bmap = PB->bmap[E->id];
nblv = V[0]->flist[E->id]->Nbmodes;
nbl = eDIM*nblv+1;
for(i = 0; i < nbl; ++i)
tmp[i] = rhs[bmap[i]];
for(i = 0; i < eDIM; ++i)
dvmul(nblv,sc,1,tmp+nblv*i,1,tmp+nblv*i,1);
if(PB->lambda->wave)
dgemv('N', N, nbl,-1.0, PB->Gmat->invcd[id], N, tmp, 1, 1.,hj,1);
else
dgemv('N', N, nbl,-1.0, PB->Gmat->binvc[id], N, tmp, 1, 1.,hj,1);
sc += nblv;
}
free(tmp);
}
void Precon_Stokes(Element_List *U, Bsystem *B, double *r, double *z){
switch(B->Precon){
case Pre_Diag:
dvmul(B->Pmat->info.diag.ndiag,B->Pmat->info.diag.idiag,1,r,1,z,1);
break;
case Pre_Block:{
register int i;
int eDIM = U->fhead->dim();
int nedge = B->Pmat->info.block.nedge;
int info,l,cnt;
double *tmp = dvector(0,LGmax-1);
static double *pinv;
dcopy(B->nsolve,r,1,z,1);
#ifdef BVERT
dpptrs('U',B->Pmat->info.block.nvert,1,B->Pmat->info.block.ivert,
z,B->Pmat->info.block.nvert,info);
#else
dvmul(B->Pmat->info.block.nvert,B->Pmat->info.block.ivert,1,z,1,z,1);
#endif
cnt = B->Pmat->info.block.nvert;
for(i = 0; i < nedge; ++i){
l = B->Pmat->info.block.Ledge[i];
dpptrs('U',l,1,B->Pmat->info.block.iedge[i],z+cnt,l,info);
cnt += l;
}
if(!pinv){
pinv = dvector(0,B->nsolve-cnt-1);
for(i = 0; i < B->nsolve-cnt; ++i)
pinv[i] = U->flist[i]->get_1diag_massmat(0);
dvrecp(B->nsolve-cnt,pinv,1,pinv,1);
}
/* finally multiply pressure dof by inverse of mass matrix */
dvmul(B->nsolve-cnt,pinv,1,r+cnt,1,z+cnt,1);
free(tmp);
}
break;
case Pre_None:
dcopy(B->nsolve,r,1,z,1);
break;
case Pre_Diag_Stokes:{
register int i,j,k;
double *tmp = dvector(0,B->nglobal-1),*sc,*b,*p,*wk;
int eDIM = U->fhead->dim();
int **bmap = B->bmap;
int nel = B->nel,asize,Nbmodes,info;
if(eDIM == 2)
wk = dvector(0,eDIM*4*LGmax);
else
wk = dvector(0,eDIM*6*LGmax*LGmax);
dzero(B->nglobal,tmp,1);
dcopy(B->nsolve-nel,r,1,tmp,1);
/* multiply by invc */
dvmul(B->nsolve-nel,B->Pmat->info.diagst.idiag,1,tmp,1,tmp,1);
/* multiply by b^T */
sc = B->signchange;
p = z + B->nsolve-nel;
dcopy(nel,r+B->nsolve-nel,1,p,1);
dneg (nel-1,p+1,1);
/* start at 1 to omit singular pressure point */
if(!(B->singular))
error_msg(issue in setting singular modes in Stokes_Precon not resolved);
for(j = 1; j < nel; ++j){
Nbmodes = U->flist[j]->Nbmodes;
asize = Nbmodes*eDIM+1;
dzero (asize,wk,1);
dgathr(eDIM*Nbmodes, tmp, bmap[j], wk);
dvmul (eDIM*Nbmodes, sc, 1, wk, 1, wk, 1);
b = B->Gmat->a[U->flist[j]->geom->id] + asize*(asize-1)/2;
p[j] += ddot(asize-1,b,1,wk,1);
sc += asize;
}
/* solve for p */
dpptrs('L', nel, 1, B->Pmat->info.diagst.binvcb,p,nel,info);
/* generate initial vector as tmp = B p */
sc = B->signchange;
dzero(B->nglobal,tmp,1);
/* start from 1 due to singular pressure system */
for(k = 1; k < nel; ++k){
Nbmodes = U->flist[k]->Nbmodes;
asize = Nbmodes*eDIM+1;
b = B->Gmat->a[U->flist[k]->geom->id] + asize*(asize-1)/2;
dsmul(asize-1,p[k],b,1,wk,1);
for(i = 0; i < eDIM*Nbmodes; ++i)
tmp[bmap[k][i]] += sc[i]*wk[i];
sc += asize;
}
/* set z = r - tmp */
dvsub(B->nsolve-nel,r,1,tmp,1,z,1);
/* u = invc*z */
dvmul(B->nsolve-nel,B->Pmat->info.diagst.idiag,1,z,1,z,1);
free(tmp); free(wk);
}
break;
case Pre_Block_Stokes:{
register int i,j,k;
double *tmp = dvector(0,B->nglobal-1),*sc,*b,*p,*wk;
int eDIM = U->fhead->dim(),cnt,l;
int **bmap = B->bmap;
int nel = B->nel,asize,Nbmodes,info;
int nedge = B->Pmat->info.blockst.nedge;
if(eDIM == 2)
wk = dvector(0,eDIM*4*LGmax);
else
wk = dvector(0,eDIM*6*LGmax*LGmax);
dzero(B->nglobal,tmp,1);
dcopy(B->nsolve-nel,r,1,tmp,1);
/* multiply by invc */
#ifdef BVERT
dpptrs('U',B->Pmat->info.blockst.nvert,1,B->Pmat->info.blockst.ivert,
tmp,B->Pmat->info.blockst.nvert,info);
#else
dvmul(B->Pmat->info.blockst.nvert,B->Pmat->info.blockst.ivert,1,
tmp,1,tmp,1);
#endif
cnt = B->Pmat->info.blockst.nvert;
for(i = 0; i < nedge; ++i){
l = B->Pmat->info.blockst.Ledge[i];
dpptrs('U',l,1,B->Pmat->info.blockst.iedge[i],tmp+cnt,l,info);
cnt += l;
}
/* multiply by b^T */
sc = B->signchange;
p = z + B->nsolve-nel;
dcopy(nel,r+B->nsolve-nel,1,p,1);
dneg(nel-1,p+1,1);
if(!(B->singular))
error_msg(issue in setting singular modes in Stokes_Precon not resolved);
/* start at 1 to omit singular pressure point */
for(j = 1; j < nel; ++j){
Nbmodes = U->flist[j]->Nbmodes;
asize = Nbmodes*eDIM+1;
dzero (asize,wk,1);
dgathr(eDIM*Nbmodes, tmp, bmap[j], wk);
dvmul (eDIM*Nbmodes, sc, 1, wk, 1, wk, 1);
b = B->Gmat->a[U->flist[j]->geom->id] + asize*(asize-1)/2;
p[j] += ddot(asize-1,b,1,wk,1);
sc += asize;
}
/* solve for p */
dpptrs('L', nel, 1, B->Pmat->info.blockst.binvcb,p,nel,info);
/* generate initial vector as tmp = B p */
sc = B->signchange;
dzero(B->nglobal,tmp,1);
/* start from 1 due to singular pressure system */
for(k = 1; k < nel; ++k){
Nbmodes = U->flist[k]->Nbmodes;
asize = Nbmodes*eDIM+1;
b = B->Gmat->a[U->flist[k]->geom->id] + asize*(asize-1)/2;
dsmul(asize-1,p[k],b,1,wk,1);
for(i = 0; i < eDIM*Nbmodes; ++i)
tmp[bmap[k][i]] += sc[i]*wk[i];
sc += asize;
}
/* set z = r - tmp */
dvsub(B->nsolve-nel,r,1,tmp,1,z,1);
/* u = invc*z */
#ifdef BVERT
dpptrs('U',B->Pmat->info.blockst.nvert,1,B->Pmat->info.blockst.ivert,
z,B->Pmat->info.blockst.nvert,info);
#else
dvmul(B->Pmat->info.blockst.nvert,B->Pmat->info.blockst.ivert,1,z,1,z,1);
#endif
cnt = B->Pmat->info.blockst.nvert;
for(i = 0; i < nedge; ++i){
l = B->Pmat->info.blockst.Ledge[i];
dpptrs('U',l,1,B->Pmat->info.blockst.iedge[i],z+cnt,l,info);
cnt += l;
}
free(tmp); free(wk);
}
break;
default:
fprintf(stderr,"Preconditioner (Precon=%d) not known\n",B->Precon);
exit(-1);
}
}
