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