void adap_fmm_init(const int accuracy, const int nparts)
{
// The init function completes three tasks: (1) Based on the accuracy
// requirement, it determines the length of the multipole/local expansion;
// (2) It computes the coefficient invariants in the multipole-to-multipole,
// local-to-local, and multipole-exponential-local operators.
if ( accuracy == 3 ) {
PTERMS = 9;
NLAMBS = 9;
} else if ( accuracy == 6) {
PTERMS = 18;
NLAMBS = 18;
}else if(accuracy == 9){
PTERMS = 27;
NLAMBS = 27;
}else if(accuracy == 12){
PTERMS = 36;
NLAMBS = 36;
}else {
printf("Error: wrong accuracy input\n");
exit(-1);
}
NPARTS = nparts;
PGSZ = pow(PTERMS+1,2);
PTERMS2 = PTERMS*PTERMS;
// Allocate memory to hold the coefficient invariants in all sorts of operators.
NUMPHYS = (int *)calloc(NLAMBS, sizeof(int));
NUMFOUR = (int *)calloc(NLAMBS, sizeof(int));
WHTS = (double *)calloc(NLAMBS, sizeof(double));
RLAMS = (double *)calloc(NLAMBS, sizeof(double));
RDPLUS = (double *)calloc(PGSZ*(2*PTERMS+1), sizeof(double));
RDMINUS = (double *)calloc(PGSZ*(2*PTERMS+1), sizeof(double));
RDSQ3 = (double *)calloc(PGSZ*(2*PTERMS+1), sizeof(double));
RDMSQ3 = (double *)calloc(PGSZ*(2*PTERMS+1), sizeof(double));
DC = (double *)calloc(pow(2*PTERMS+1,2), sizeof(double));
YTOPC = (double *)calloc(3721, sizeof(double));
YTOPCS = (double *)calloc(3721, sizeof(double));
YTOPCSINV = (double *)calloc(3721, sizeof(double));
RLSC = (double *)calloc(PGSZ*NLAMBS, sizeof(double));
CARRAY = (double *)calloc(pow(4*PTERMS+1,2), sizeof(double));
int allocFailure = (NUMPHYS==0) || (NUMFOUR==0) || (WHTS==0) ||
(RLAMS==0) || (RDPLUS==0) || (RDMINUS==0) || (RDSQ3==0) ||
(RDMSQ3==0) || (DC==0) || (YTOPC==0) || (YTOPCS==0) || (YTOPCSINV==0) ||
(RLSC==0) || (CARRAY==0);
if ( allocFailure ) {
printf("Error in %s, line %d: unable to allocate memory\n", __FILE__, __LINE__);
exit(-1);
}
// Generate coefficient invariants
frmini(YTOPC, YTOPCS, YTOPCSINV);
rotgen(PTERMS, CARRAY, RDPLUS, RDMINUS, RDSQ3, RDMSQ3, DC);
vwts(NLAMBS, RLAMS, WHTS);
numthetahalf(NLAMBS, NUMFOUR);
numthetafour(NLAMBS, NUMPHYS);
rlscini(NLAMBS, PTERMS, RLAMS, RLSC);
NEXPTOT = 0;
NTHMAX = 0;
NEXPTOTP = 0;
int i;
for ( i = 1; i <= NLAMBS; i++ ) {
NEXPTOT += NUMFOUR[i-1];
if ( NUMFOUR[i-1] > NTHMAX )
NTHMAX = NUMFOUR[i-1];
NEXPTOTP += NUMPHYS[i-1];
}
NEXPTOTP /= 2.0;
NEXPMAX = MAX(NEXPTOT, NEXPTOTP) + 1;
XS = (dcomplex *)calloc(NEXPMAX*3, sizeof(dcomplex));
YS = (dcomplex *)calloc(NEXPMAX*3, sizeof(dcomplex));
ZS = (double *)calloc(NEXPMAX*3, sizeof(double));
// wenhua Oct. 24
FEXPE = (dcomplex *)calloc(30000, sizeof(dcomplex));
FEXPO = (dcomplex *)calloc(30000, sizeof(dcomplex));
FEXPBACK = (dcomplex *)calloc(30000, sizeof(dcomplex));
allocFailure = (XS==0) || (YS==0 ) || (ZS==0) ||
(FEXPE==0) || (FEXPO==0) || (FEXPBACK==0);
if ( allocFailure ) {
printf("Error in %s, line %d: unable to allocate memory\n", __FILE__, __LINE__);
exit(-1);
}
mkfexp(NLAMBS, NUMFOUR, NUMPHYS, FEXPE, FEXPO, FEXPBACK);
mkexps(RLAMS, NLAMBS, NUMPHYS, NEXPTOTP, XS, YS, ZS);
FMMLOC = (double *)calloc(3*NPARTS, sizeof(double));
FMMCHARGE = (double *)calloc(NPARTS, sizeof(double));
//march 3th
RPYCHARGE = (double *)calloc(3*NPARTS, sizeof(double));
RPYPOT = (double *)calloc(3*NPARTS, sizeof(double));
FMMPOT = (double *)calloc(NPARTS, sizeof(double));
FMMFIELD = (double *)calloc(3*NPARTS, sizeof(double));
FMMPOTN = (double *)calloc(NPARTS, sizeof(double));
FMMFIELDN = (double *)calloc(3*NPARTS, sizeof(double));
FMMDXX = (double *)calloc(NPARTS, sizeof(double));
FMMDYY = (double *)calloc(NPARTS, sizeof(double));
FMMDZZ = (double *)calloc(NPARTS, sizeof(double));
FMMDXY = (double *)calloc(NPARTS, sizeof(double));
FMMDXZ = (double *)calloc(NPARTS, sizeof(double));
FMMDYZ = (double *)calloc(NPARTS, sizeof(double));
FMMDXXN = (double *)calloc(NPARTS, sizeof(double));
FMMDYYN = (double *)calloc(NPARTS, sizeof(double));
FMMDZZN = (double *)calloc(NPARTS, sizeof(double));
FMMDXYN = (double *)calloc(NPARTS, sizeof(double));
FMMDXZN = (double *)calloc(NPARTS, sizeof(double));
FMMDYZN = (double *)calloc(NPARTS, sizeof(double));
allocFailure = (FMMLOC==0) || (FMMFIELD==0) || (FMMPOT==0) ||
(FMMFIELD==0)|| (FMMPOTN==0) || (FMMFIELDN==0) || (FMMDXX==0) || (FMMDYY==0)||
(FMMDZZ==0) || (FMMDXY==0) || (FMMDXZ==0) || (FMMDYZ==0) || (FMMDXXN==0) ||
(FMMDYYN==0)|| (FMMDZZN==0) || (FMMDXYN==0) || (FMMDXZN==0) || (FMMDYZN==0);
if ( allocFailure ) {
printf("Error in %s, line %d: unable to allocate memory\n", __FILE__, __LINE__);
exit(-1);
}
IFL_UP[0] = 3; IFL_UP[1] = 4; IFL_UP[2] = 2; IFL_UP[3] = 1;
IFL_UP[4] = 3; IFL_UP[5] = 4; IFL_UP[6] = 2; IFL_UP[7] = 1;
IFL_DN[0] = 1; IFL_DN[1] = 2; IFL_DN[2] = 4; IFL_DN[3] = 3;
IFL_DN[4] = 1; IFL_DN[5] = 2; IFL_DN[6] = 4; IFL_DN[7] = 3;
}
/*
Algorithm taken from Matrix Algorithms Vol. II by G.W. Stewart.
Given an upper Hessenberg matrix, H, hqr overwrites it iwth a unitary similar
triangular matrix whose diagonals are the eigenvalues of H.
I beleive this is called Schur form.
n is the size of the matrix H
-1 is returned if more than maxiter iterations are required to to deflate
the matrix at any eigenvalue. If everything completes successfully, a 0 is
returned.
c, s, r1, r2, and t are arrays of length n, used for scratch work
*/
int hqr(Complex *H, Complex *Q, Real *c, Complex *s, Complex *r1, Complex *r2, Complex *t, int n, int maxiter, Real epsilon)
{
int i1, i2, iter, oldi2, i, j;
Complex k, tmp;
//2. i1 = 1; i2 = n
i1 = 0;
i2 = n-1;//this is used both as an index and an upper bound in loops, so
//it must be n-1, but I must use <= in loops.
//3. iter = 0;
iter = 0;
//4. while(true)
while(1)
{
//5. iter = iter+1
iter += 1;
//6. if(iter > maxiter) error return fi
if(iter > maxiter)
return -1;
//7. oldi2 = i2
oldi2 = i2;
//8. backsearch(H, i2, i1, i2)
backsearch(H, n, i2, &i1, &i2, epsilon);
//9. if(i2 = 1) leave hqr fi
if(i2 == 0)
return 0;
//10. if(i2 != oldi2)iter = 0 fi
if(i2 != oldi2)
iter = 0;//I suppose we moved to the next eigenvalue
//11. wilkshift(H[i2-1,i2-1], H[i2-1,i2], H[i2,i2-1], H[i2,i2], k)
wilkshift(&INDEX(H,n,(i2-1),(i2-1)), &INDEX(H,n,(i2-1),i2), &INDEX(H,n,i2,(i2-1)), &INDEX(H,n,i2,i2), &k);
//12. H[i1,i1] = H[i1,i1] - k
INDEX(H,n,i1,i1).real -= k.real;
INDEX(H,n,i1,i1).imag -= k.imag;
//13. for i = i1 to i2-1
for(i = i1; i <= i2-1; i++)
{
//14. rotgen(H[i,i], H[i+1, i], c_i, s_i)
rotgen(&INDEX(H,n,i,i), &INDEX(H,n,(i+1),i), &c[i], &s[i]);
//15. H[i+1, i+1] = H[i+1, i+1] - k
INDEX(H,n,(i+1),(i+1)).real -= k.real;
INDEX(H,n,(i+1),(i+1)).imag -= k.imag;
//16. rotapp(c_i, s_i, H[i, i+1:n], H[i+1,i+1:n])
//Unfortunately, we are now using a row. Before we were looking at
//single columns, so I indexed the arrays H[i,j] = H[i + j*n], so
//that &INDEX(H,n,i,j) could be used to equal H[i:n,j]. I can't do
//that with rows now.
//I will be using the array r1 and r2 for these two rows
//copy the contents fo the rows to r1,r2
for(j = i+1; j < n; j++)
{
r1[j].real = INDEX(H,n,i,j).real;
r1[j].imag = INDEX(H,n,i,j).imag;
r2[j].real = INDEX(H,n,(i+1),j).real;
r2[j].imag = INDEX(H,n,(i+1),j).imag;
}
rotapp(&c[i], &s[i], &r1[i+1], &r2[i+1], t, n-i-1);
//now copy the results back to H
for(j = i+1; j < n; j++)
{
INDEX(H,n,i,j).real = r1[j].real;
INDEX(H,n,i,j).imag = r1[j].imag;
INDEX(H,n,(i+1),j).real = r2[j].real;
INDEX(H,n,(i+1),j).imag = r2[j].imag;
}
}//17. end for i
//18. for i = i1 to i2-1
for(i = i1; i <= i2-1; i++)
{
//19. rotapp(c_i, s_i_bar, H[1:i+1, i], H[1:i+1, i+1]
tmp.real = s[i].real;
tmp.imag = -s[i].imag;
//I can use the column as a continuous array
rotapp(&c[i], &tmp, &INDEX(H,n,0,i), &INDEX(H,n,0,(i+1)), t, i+2);
//20. rotapp(c_i, s_i_bar, Q[1:n,i], Q[1:n,i+1)
//I can use the column as a continuous array
rotapp(&c[i], &tmp, &INDEX(Q,n,0,i), &INDEX(Q,n,0,(i+1)), t, n);
//21. H[i,i] = H[i,i] + k
INDEX(H,n,i,i).real += k.real;
INDEX(H,n,i,i).imag += k.imag;
}//22. end for i
//23. H[i2,i2] = H[i2,i2] + k
INDEX(H,n,i2,i2).real += k.real;
INDEX(H,n,i2,i2).imag += k.imag;
}//24. end while
}//25 end hqr
