void Tri_setup_iprodlap()
{
int qa = QGmax;
int qb;
if(LZero) // use extra points if have Legendre zeros in 'b' direction
qb = QGmax;
else
qb = QGmax-1;
int qc = 0;
int L = LGmax;
// Set up dummy element with maximum quadrature/edge order
Coord X;
X.x = dvector(0,NTri_verts-1);
X.y = dvector(0,NTri_verts-1);
X.x[0] = 0.0;
X.x[1] = 1.0;
X.x[2] = 0.0;
X.y[0] = 0.0;
X.y[1] = 0.0;
X.y[2] = 1.0;
Tri *T = (Tri*) new Tri(0,'T', L, qa, qb, qc, &X);
free(X.x);
free(X.y);
int i,j,k,n;
int facs = Tri_DIM*Tri_DIM;
Tri_ipmodes = T->Nmodes;
Tri_iplap = (double***) calloc(facs,sizeof(double**));
for(i = 0; i < facs; ++i)
{
Tri_iplap[i] = dmatrix(0, T->Nmodes-1, 0, T->Nmodes-1);
dzero(T->Nmodes*T->Nmodes, Tri_iplap[i][0], 1);
}
// Set up gradient basis
Basis *B,*DB;
Mode *w,*m,*m1,*md,*md1,**gb,**gb1,*fac;
double *z;
B = T->getbasis();
DB = T->derbasis();
fac = B->vert;
w = mvector(0,0);
gb = (Mode **) malloc(T->Nmodes*sizeof(Mode *));
gb[0] = mvecset(0,Tri_DIM*T->Nmodes,qa, qb, qc);
gb1 = (Mode **) malloc(T->Nmodes*sizeof(Mode *));
gb1[0] = mvecset(0,Tri_DIM*T->Nmodes,qa, qb, qc);
for(i = 1; i < T->Nmodes; ++i)
gb[i] = gb[i-1]+Tri_DIM;
for(i = 1; i < T->Nmodes; ++i)
gb1[i] = gb1[i-1]+Tri_DIM;
getzw(qa,&z,&w[0].a,'a');
getzw(qb,&z,&w[0].b,'b');
/* fill gb with basis info for laplacian calculation */
// vertex modes
m = B->vert;
md = DB->vert;
for(i = 0,n=0; i < T->Nverts; ++i,++n)
T->fill_gradbase(gb[n],m+i,md+i,fac);
// edge modes
for(i = 0; i < T->Nedges; ++i)
{
m1 = B ->edge[i];
md1 = DB->edge[i];
for(j = 0; j < T->edge[i].l; ++j,++n)
T->fill_gradbase(gb[n],m1+j,md1+j,fac);
}
// face modes
for(i = 0; i < T->Nfaces; ++i)
for(j = 0; j < T->face[0].l; ++j)
{
m1 = B ->face[i][j];
md1 = DB->face[i][j];
for(k = 0; k < T->face[0].l-j; ++k,++n)
T->fill_gradbase(gb[n],m1+k,md1+k,fac);
}
/* multiply by weights */
for(i = 0; i < T->Nmodes; ++i)
{
Tri_mvmul2d(qa,qb,qc,gb[i] ,w,gb1[i]);
Tri_mvmul2d(qa,qb,qc,gb[i]+1,w,gb1[i]+1);
}
// Calculate Laplacian inner products
double s1, s2, s3, s4, s5, s6, s7, s8;
double *tmp = dvector(0, QGmax-1);
fac = B->vert+1;
for(i = 0; i < T->Nmodes; ++i)
for(j = 0; j < T->Nmodes; ++j)
{
s1 = ddot(qa,gb[i][0].a,1,gb1[j][0].a,1);
s1 *= ddot(qb,gb[i][0].b,1,gb1[j][0].b,1);
dvmul(qa, fac->a, 1, gb[i][0].a, 1, tmp, 1);
s2 = ddot(qa, tmp,1,gb1[j][0].a,1);
s2 *= ddot(qb,gb[i][0].b,1,gb1[j][0].b,1);
s3 = ddot(qa, tmp,1,gb1[j][1].a,1);
s3 *= ddot(qb,gb[i][0].b,1,gb1[j][1].b,1);
dvmul(qa, fac->a, 1, tmp, 1, tmp, 1);
s4 = ddot(qa, tmp,1,gb1[j][0].a,1);
s4 *= ddot(qb,gb[i][0].b,1,gb1[j][0].b,1);
s5 = ddot(qa,gb[i][0].a,1,gb1[j][1].a,1);
s5 *= ddot(qb,gb[i][0].b,1,gb1[j][1].b,1);
s6 = ddot(qa,gb[i][1].a,1,gb1[j][0].a,1);
s6 *= ddot(qb,gb[i][1].b,1,gb1[j][0].b,1);
dvmul(qa, fac->a, 1, gb[i][1].a, 1, tmp, 1);
s7 = ddot(qa, tmp,1,gb1[j][0].a,1);
s7 *= ddot(qb,gb[i][1].b,1,gb1[j][0].b,1);
s8 = ddot(qa,gb[i][1].a,1,gb1[j][1].a,1);
s8 *= ddot(qb,gb[i][1].b,1,gb1[j][1].b,1);
Tri_iplap[0][i][j] = s1;
Tri_iplap[1][i][j] = s5 + 2*s2 + s6;
Tri_iplap[2][i][j] = s3 + s4 + s7 + s8;
}
/* fill gb with basis info for mass matrix calculation */
// vertex modes
m = B->vert;
for(i = 0,n=0; i < T->Nverts; ++i,++n)
{
dcopy(qa, m[i].a, 1, gb[n]->a, 1);
dcopy(qb, m[i].b, 1, gb[n]->b, 1);
}
// edge modes
for(i = 0; i < T->Nedges; ++i)
{
m1 = B ->edge[i];
for(j = 0; j < T->edge[i].l; ++j,++n)
{
dcopy(qa, m1[j].a, 1, gb[n]->a, 1);
dcopy(qb, m1[j].b, 1, gb[n]->b, 1);
}
}
// face modes
for(i = 0; i < T->Nfaces; ++i)
for(j = 0; j < T->face[i].l; ++j)
{
m1 = B ->face[i][j];
for(k = 0; k < T->face[i].l-j; ++k,++n)
{
dcopy(qa, m1[k].a, 1, gb[n]->a, 1);
dcopy(qb, m1[k].b, 1, gb[n]->b, 1);
}
}
/* multiply by weights */
for(i = 0; i < T->Nmodes; ++i)
Tri_mvmul2d(qa,qb,qc,gb[i] ,w,gb1[i]);
for(i = 0; i < T->Nmodes; ++i)
for(j = 0; j < T->Nmodes; ++j)
{
s1 = ddot(qa,gb[i][0].a,1,gb1[j][0].a,1);
s1 *= ddot(qb,gb[i][0].b,1,gb1[j][0].b,1);
Tri_iplap[3][i][j] = s1;
}
free_mvec(gb[0]) ;
free((char *) gb);
free_mvec(gb1[0]);
free((char *) gb1);
free((char*)w);
free(tmp);
delete (T);
}
static void WriteMesh(Element_List *U, FILE *out){
register int i,j;
int qa, qb, qc;
int qt,zone;
double *z,*w;
Coord X,Y;
char *outformat,*Colour;
Element *E;
int dim = U->fhead->dim();
if(!option("Qpts")){ /* reset quadrature points */
reset_bases();
for(j=2;j<=QGmax;++j){
getzw(j,&z,&w,'a');
for(i = 0; i < j; ++i) z[i] = 2.0*i/(double)(j-1) -1.0;
getzw(j,&z,&w,'b');
for(i = 0; i < j; ++i) z[i] = 2.0*i/(double)(j-1) -1.0;
if(dim == 3){
getzw(j,&z,&w,'c');
for(i = 0; i < j; ++i) z[i] = 2.0*i/(double)(j-1) -1.0;
}
}
}
qt = QGmax*QGmax*QGmax;
X.x = dvector(0,qt-1);
X.y = dvector(0,qt-1);
X.z = dvector(0,qt-1);
if(dim == 3){
fprintf(out,"VARIABLES = x y z\n");
outformat = strdup("%lf \t %lf \t %lf\n");
#ifdef ONEELMT
int elmtid;
if(elmtid = option("ELMTID")){ /* dump faces of a single element */
E = U->flist[elmtid-1];
E->coord(&X);
fprintf(out,"ZONE T=\"face %d\", I=%d, J=%d, F=POINT\n",
1,E->qa,E->qb);
for(i = 0; i < E->qa*E->qb; ++i)
fprintf(out, outformat, X.x[i], X.y[i], X.z[i]);
fprintf(out,"ZONE T=\"face %d\", I=%d, J=%d, F=POINT\n",
2,E->qa,E->qc);
for(j = 0; j < E->qc; ++j)
for(i = 0; i < E->qa; ++i)
fprintf(out, outformat, X.x[j*E->qa*E->qb+i], X.y[j*E->qb*E->qb+i],
X.z[j*E->qa*E->qb+i]);
fprintf(out,"ZONE T=\"face %d\", I=%d, J=%d, F=POINT\n",
3,E->qb,E->qc);
for(j = 0; j < E->qc; ++j)
for(i = 0; i < E->qb; ++i)
fprintf(out, outformat, X.x[j*E->qa*E->qb+i*E->qa+E->qa-1],
X.y[j*E->qa*E->qb+i*E->qa+E->qa-1],
X.z[j*E->qa*E->qb+i*E->qa+E->qa-1]);
switch (E->identify()){
case Nek_Tet:
fprintf(out,"ZONE T=\"face %d\", I=%d, J=%d, F=POINT\n",
4,E->qb,E->qc);
for(j = 0; j < E->qc; ++j)
for(i = 0; i < E->qb; ++i)
fprintf(out, outformat, X.x[j*E->qa*E->qb+i*E->qa],
X.y[j*E->qa*E->qb+i*E->qa],
X.z[j*E->qa*E->qb+i*E->qa]);
break;
case Nek_Prism:
fprintf(out,"ZONE T=\"face %d\", I=%d, J=%d, F=POINT\n",
4,E->qa,E->qc);
for(j = 0; j < E->qc; ++j)
for(i = 0; i < E->qa; ++i)
fprintf(out, outformat, X.x[j*E->qa*E->qb+i+(E->qb-1)*E->qa],
X.y[j*E->qa*E->qb+i+(E->qb-1)*E->qa],
X.z[j*E->qa*E->qb+i+(E->qb-1)*E->qa]);
fprintf(out,"ZONE T=\"face %d\", I=%d, J=%d, F=POINT\n",
5,E->qb,E->qc);
for(j = 0; j < E->qc; ++j)
for(i = 0; i < E->qb; ++i)
fprintf(out, outformat, X.x[j*E->qa*E->qb+i*E->qa],
X.y[j*E->qa*E->qb+i*E->qa],
X.z[j*E->qa*E->qb+i*E->qa]);
break;
default:
fprintf(stderr,"This element type not configured\n");
exit(-1);
break;
}
exit(1);
}
#endif
for(zone = 0, E = U->fhead; E; E = E->next){
if(Check_range(E)){
qt = E->qtot;
E->coord(&X);
fprintf(out,"ZONE T=\"Element %d\", I=%d, J=%d, K=%d, F=POINT\n",
E->id+1,E->qa,E->qb,E->qc);
for(i = 0; i < qt; ++i)
fprintf(out, outformat, X.x[i], X.y[i], X.z[i]);
}
}
}
else{
if(option("FEstorage")){
int n,k;
fprintf(out,"VARIABLES = x y\n");
fprintf(out,"ZONE N=%d, E=%d, F=FEPOINT, ET=QUADRILATERAL\n", U->nel*4, U->nel);
for(k = 0,zone=0; k < U->nel; ++k){
for(i = 0; i < U->flist[k]->Nverts; ++i)
fprintf(out,"%lg %lg\n", U->flist[k]->vert[i].x, U->flist[k]->vert[i].y);
if(i == 3)
fprintf(out,"%lg %lg\n", U->flist[k]->vert[i-1].x, U->flist[k]->vert[i-1].y);
}
for(k = 0,n=1; k < U->nel; ++k){
fprintf(out,"%d %d %d %d\n",n,n+1,n+3,n+2);
n += 4;
}
}
else{
if(option("SMformat")){
for(zone = 0, E=U->fhead; E; E = E->next)
if(Check_range(E)) ++zone;
fprintf(out,"%d %d %d %d Nr Ns Nz Nel\n",U->fhead->qa,U->fhead->qb,0,
zone);
}
else{
fprintf(out,"VARIABLES = x y\n");
}
outformat = strdup("%lf \t %lf\n");
for(zone = 0, E=U->fhead; E; E = E->next){
if(Check_range(E)){
qt = E->qtot;
E->coord(&X);
if(!option("SMformat"))
fprintf(out,"ZONE T=\"Element %d\", I=%d, J=%d, F=POINT\n",
++zone,E->qa,E->qb);
for(i = 0; i < qt; ++i)
fprintf(out, outformat, X.x[i], X.y[i], X.z[i]);
}
}
}
}
if(bdy.N) dump_faces(out,U,X,zone);
free(X.x); free(X.y); free(X.z);
}
void Hex::GetZW(double **za, double **wa, double **zb, double **wb, double **zc, double **wc){
getzw(qa, za, wa, 'a');
getzw(qb, zb, wb, 'a');
getzw(qc, zc, wc, 'a');
}
void Tri::GetZW(double **za, double **wa, double **zb, double **wb, double **zc, double **wc){
getzw(qa, za, wa, 'a');
getzw(qb, zb, wb, 'b');
}
void Quad::GetZW(double **za, double **wa, double **zb, double **wb, double **, double **){
getzw(qa, za, wa, 'a');
getzw(qb, zb, wb, 'a');
}