void check_spheres(t_ray ray, t_list *spheres, t_intersectInfo **o, double *max) { t_intersectInfo *i; while (spheres) { i = sphere_intersection(((t_sphere *)spheres->data), ray); if (i && i->t > 0 && i->t < *max) { *max = i->t; free(*o); *o = i; } else free(i); spheres = spheres->next; } }
int main( int argc, char **argv ) { /* Counting variables */ int i,j,k,m,n,p,ret; double x,y,sum,tum; /* Some generic character buffers and file variables */ FILE *fp; /* Variables for storing ranges */ long nfr,rng[MAX_NUM_RANGES][2]; /* Constants needed later */ const long c_spmat_inc = SPARSE_MAT_INCREMENT; /* Point cloud variables */ int dim,deg,rdn,npts,nbp; double *pts,*dlt; int *drv; punity_t pt; /* Quadrature variables */ double *ctr,*qbox,*nqbox,*qx,qw,rad; long *size,*index,*tindex; int *ltg; shape_t dm; /* Quadrature itself */ int quadn; double *qpts,*qwts; /* Sparse matrix variables themselves */ long *ia,*ja,*ib,*jb,cc; double *A,*B,*alpha,*beta,*gamma,*omega,*ev,*eig; int mo,neig; /* Nuclei variables */ nuclei_t nuc; /* Grid variables for plotting */ int *dx; double *x0,*wx,*dd; /* Variables for the not so sparse stuff */ double *Q; /* Variables for configuration */ int optc; symtab_t sym; symbol_t *s; /* Load file containing variable declarations */ #include "puksvar.h" /* Output who I am */ fprintf( stderr, "\nPUKSHAM VERSION 0.1\n\n" ); /* Do all the configuration operations here */ #include "pukscfg.h" ////////////////////////////////////////// // Begin actual code here. Good luck... // ////////////////////////////////////////// /* Allocate all space needed at least initially */ if( !b_points_loaded ) { fprintf( stderr, " * ERROR: No points loaded. Exiting.\n\n" ); return 0; } if( !b_quad_loaded ) { fprintf( stderr, " * ERROR: No quadrature loaded. Exiting.\n\n" ); return 0; } if( !b_domain_set ) { fprintf( stderr, " * ERROR: No domain indicator loaded. Exiting.\n\n" ); return 0; } /* Check for discrepancies in Lanczos parameters */ if( i_max_lanczos_steps > npts ) { i_max_lanczos_steps = npts; fprintf( stderr, " ---> ERROR: Value of maxLanczosSteps > npts: Setting maxLanczosSteps to %d\n", npts ); } /* Set up the partition of unity */ dlt = (double*) malloc( npts * sizeof(double) ); /* Setting up supports */ fprintf( stderr, " * Generating supports\n\n" ); generate_cloud_supports_min( dim, npts, pts, rdn, 1.05, dlt, 0.001 ); /* Initializing Shepard partition of unity */ fprintf( stderr, " * Initializing Shepard partition of unity " ); punity_init( &pt, dim, npts, pts, dlt, &cubic_window, &cubic_window_deriv ); #ifdef PUNITY_USE_KDTREES generate_cloud_supports_min( dim, npts, pt.pts, rdn, 1.05, pt.dlt, 0.001 ); #endif fprintf( stderr, "with rmax = %15.7f\n\n", pt.rmax ); /* Allocate stuff for integral evaluation */ ctr = (double*) malloc( dim * sizeof(double) ); qbox = (double*) malloc( dim * dim * sizeof(double) ); nqbox = (double*) malloc( dim * dim * sizeof(double) ); size = (long*) malloc( dim * sizeof(long) ); index = (long*) malloc( dim * sizeof(long) ); tindex = (long*) malloc( dim * sizeof(long) ); qx = (double*) malloc( dim * sizeof(double) ); /* Allocate space for the sparse matrices */ ia = (long*) malloc( npts * sizeof(long) ); ib = (long*) malloc( npts * sizeof(long) ); ja = (long*) malloc( c_spmat_inc * sizeof(long) ); jb = (long*) malloc( c_spmat_inc * sizeof(long) ); A = (double*) malloc( c_spmat_inc * sizeof(double) ); B = (double*) malloc( c_spmat_inc * sizeof(double) ); cc = c_spmat_inc; /* Allocate space for Laplace operator */ drv = (int*) malloc( dim * sizeof(int) ); /* Deal with boundary functions */ nbp = 0; for(i=0;i<npts;i++) { boundary_indicator( pt.pts + i * dim, &dm, f_bndry_tol, &ret ); if( ret == 1 ) ++nbp, pt.bdry[i] = 1; /* Set this node to have a singularity to give delta property on boundary */ } fprintf( stderr, " * Detected %d boundary points using given criteria\n\n", nbp ); /* Now that boundary points are known, make final adjustments to Lanczos parameters */ if( i_max_lanczos_steps > npts - nbp ) { if( i_max_lanczos_steps > npts - nbp ) { i_max_lanczos_steps = npts - nbp; fprintf( stderr, " * ERROR: Value of maxLanczosSteps > npts - nbp: Setting maxLanczosSteps to %d\n\n", npts - nbp ); } } if( neig > i_max_lanczos_steps ) { neig = i_max_lanczos_steps; fprintf( stderr, " * ERROR: Requested numberEigenvalues > maxLanczosSteps: Setting neig = %d\n\n", i_max_lanczos_steps ); } /* Generate Q for saving Lanczos vectors later */ Q = (double*) malloc( i_max_lanczos_steps * npts * sizeof(double) ); /* Loading matrices */ if( b_load_overl_mat ) { fprintf( stderr, " * Loaded overlap matrix from \"%s\"\n\n", s_overl_fname ); } if( b_load_stiff_mat ) { fprintf( stderr, " * Loaded stiffness matrix from \"%s\"\n\n", s_stiff_fname ); } /* Start building the matrices */ if( !b_load_stiff_mat || !b_load_overl_mat ) { fprintf( stderr, " * Building matrices " ); /* Otherwise need to build system which does not contain the boundary nodes */ ltg = (int*) malloc( ( npts - nbp ) * sizeof(int) ); for(i=0,p=0;i<npts;i++) if( pt.bdry[i] == 0 ) ltg[p++] = i; /* Initialize the matrices */ for(i=0;i<pt.npts-nbp;i++) ia[i] = -1, ib[i] = -1; p = 0; for(i=0;i<npts-nbp;i++) { for(j=0;j<i/(npts/20);j++) fprintf( stderr, "=" ); fprintf( stderr, ">%3d%%", i * 100 / ( npts - nbp ) ); for(j=i;j<npts-nbp;j++) { if( sphere_intersection( dim, pt.pts + ltg[i] * dim, pt.dlt[ltg[i]], pt.pts + ltg[j] * dim, pt.dlt[ltg[j]], ctr, &rad, qbox ) == 1 ) { /* Build the local basis for the intersection of spheres */ for(k=0;k<dim;k++) { sum = 0.0; for(m=0;m<dim;m++) sum += qbox[k*dim+m] * qbox[k*dim+m]; sum = sqrt( sum ); for(m=0;m<dim;m++) nqbox[k*dim+m] = qbox[k*dim+m] / sum; } /* Calculate the entries of the inner product matrix */ for(k=0;k<dim;k++) index[k] = 0, size[k] = quadn - 1; sum = 0.0, tum = 0.0; do { lens_gauss_point( dim, pt.pts + ltg[i] * dim, pt.dlt[ltg[i]], pt.pts + ltg[j] * dim, pt.dlt[ltg[j]], rad, nqbox, index, qpts, qwts, qx, &qw ); domain_indicator( qx, &dm, &ret ); if( ret == 1 ) { if( !b_load_overl_mat ) { x = punity_evaluate_delta( &pt, ltg[i], qx, i_sing_order ) * punity_evaluate_delta( &pt, ltg[j], qx, i_sing_order ); sum += qw * x; } if( !b_load_stiff_mat ) { y = 0.0; for(k=0;k<dim;k++) { for(m=0;m<dim;m++) { if( m == k ) drv[m] = 1; else drv[m] = 0; } y += punity_term_deriv_evaluate_delta( &pt, ltg[i], drv, qx, i_sing_order, NULL, 0 ) * punity_term_deriv_evaluate_delta( &pt, ltg[j], drv, qx, i_sing_order, NULL, 0 ); } tum += qw * y; } } } while( arraynext( (long) dim, size, index ) != -1 ); /* Now put sum in the i,j entry in the sparse matrx of inner product entries */ if( p > cc ) { cc += c_spmat_inc; if( !b_load_stiff_mat ) { A = (double*) realloc( A, cc * sizeof(double) ); ja = (long*) realloc( ja, cc * sizeof(long) ); } if( !b_load_overl_mat ) { B = (double*) realloc( B, cc * sizeof(double) ); jb = (long*) realloc( jb, cc * sizeof(long) ); } } if( !b_load_stiff_mat ) { A[p] = tum; ja[p] = j; if( ia[i] == -1 ) ia[i] = p; } if( !b_load_overl_mat ) { B[p] = sum; jb[p] = j; if( ib[i] == -1 ) ib[i] = p; } /* Step to the next entry */ p++; } } parse_print_back( stderr, i / ( npts / 20 ) + 1 + 4 ); } if( !b_load_stiff_mat ) ia[npts-nbp] = p; if( !b_load_overl_mat ) ib[npts-nbp] = p; fprintf( stderr, "\n\n" ); /* Indicate that matrices are both built */ if( !b_load_stiff_mat ) b_have_stiff_mat = 1; if( !b_load_overl_mat ) b_have_overl_mat = 1; } /* Don't go on if the matrices have not been loaded or built */ if( !b_have_stiff_mat ) { fprintf( stderr, " * ERROR: Stiffness matrix has not been built. This is really bad. Exiting angrily.\n\n" ); return 0; } if( !b_have_overl_mat ) { fprintf( stderr, " * ERROR: Overlap matrix has not been built. This is really bad. Exiting angrily.\n\n" ); return 0; } /* Saving matrices to output files */ if( b_save_stiff_mat || b_save_overl_mat ) fprintf( stderr, " * Writing matrix output files\n\n" ); if( b_save_overl_mat ) { smsave( s_overl_fname, npts - nbp, npts - nbp, ib, jb, B, 1 ); fprintf( stderr, " ---> Saved overlap matrix to output \"%s\"\n", s_overl_fname ); } if( b_save_stiff_mat ) { smsave( s_stiff_fname, npts - nbp, npts - nbp, ia, ja, A, 1 ); fprintf( stderr, " ---> Saved stiffness matrix to output \"%s\"\n", s_stiff_fname ); } if( b_save_overl_mat || b_save_stiff_mat ) fprintf( stderr, "\n" ); /* Solve the eigenvalue problem via Lanczos projection */ if( !b_neig_set || ( b_neig_set && neig > npts ) ) { fprintf( stderr, " * ERROR: Number of eigenvalues not specified or invalid. Exiting.\n\n " ); return 0; } alpha = (double*) malloc( ( npts + 2 ) * sizeof(double) ); beta = (double*) malloc( ( npts + 2 ) * sizeof(double) ); gamma = (double*) malloc( ( npts + 2 ) * sizeof(double) ); omega = (double*) malloc( ( npts + 2 ) * sizeof(double) ); ev = (double*) malloc( 2 * npts * sizeof(double) ); eig = (double*) malloc( neig * ( npts - nbp ) * sizeof(double) ); /* Seed the random number generator */ srand((unsigned)time(0)); /* Lanczos procedure */ fprintf( stderr, " * Beginning Lanczos procedure\n\n" ); sgsilanczoscr( npts - nbp, i_max_lanczos_steps, neig, ib, jb, B, ia, ja, A, alpha, beta, omega, NULL, ev, Q, &mo, 1e-15, &x, 10000, 0, &ret ); fprintf( stderr, " * Converged Lanczos procedure in %d steps with a collective residual of %5.9e over all EV's\n\n", mo, x ); /* Now for sgsilanczos need to prepare alpha, beta by premultiplying by inverse of diag(omega) */ copy( mo + 2, beta, gamma ); for(i=0;i<mo-1;i++) alpha[i] /= omega[i], beta[i+1] /= omega[i], gamma[i+1] /= omega[i+1]; alpha[mo-1] /= omega[mo-1]; /* Solve the appropriate tridiagonal eigenvalue problem */ if( strncmp( s_treig_routine, "lr", TOKEN_BUFFER_LENGTH ) == 0 ) treiglr( mo, alpha, beta + 1, gamma + 1, 10000, ev, &ret, &n ); else if( strncmp( s_treig_routine, "qds", TOKEN_BUFFER_LENGTH ) == 0 ) treigqds( mo, alpha, beta + 1, gamma + 1, 10000, ev, &ret, &n ); else if( strncmp( s_treig_routine, "dqds", TOKEN_BUFFER_LENGTH ) == 0 ) treigdqds( mo, alpha, beta + 1, gamma + 1, 10000, ev, &ret, &n ); else if( strncmp( s_treig_routine, "tridqds", TOKEN_BUFFER_LENGTH ) == 0 ) treigtridqds( mo, alpha, beta + 1, gamma + 1, 10000, ev, &ret, &n ); else { fprintf( stderr, " * ERROR: No valid tridiagonal eigenvalue solver selected: Given is \"%s\". Exiting.\n\n", s_treig_routine ); return 0; } complex_bubble_sort( mo, ev ); fprintf( stderr, " * Eigenvalues resulting from Lanczos process:\n\n" ); for(i=0;i<neig;i++) fprintf( stderr, "%15.7f + %15.7fi\n", 1.0 / ev[2*i+0], ev[2*i+1] ); fprintf( stderr, "\n" ); /* Generate the eigenvectors */ fprintf( stderr, " * Generating eigenvectors\n\n" ); /* IMPORTANT: The shift mu used here should be an eigenvalue of the original system, not its inverse */ fprintf( stderr, " ---> Vectors:\n" ); for(i=0;i<neig;i++) { nrandv( npts - nbp, eig + i * ( npts - nbp ) ); sgsinvi( npts - nbp, ia, ja, A, ib, jb, B, eig + i * ( npts - nbp ), 1.0 / ev[2*i+0], 1e-9, 10000, 0 ); fprintf( stderr, " ----> %5d EV = %15.7f: ", i, 1.0 / ev[2*i+0] ); for(j=0;j<NUM_EIG_DIMS_TO_PRINT;j++) fprintf( stderr, "%15.7f", eig[i*(npts-nbp)+j] ); fprintf( stderr, " ...\n" ); } fprintf( stderr, "\n" ); ///////////////////////////////// // Normalize the wavefunctions // ///////////////////////////////// //fprintf( stderr, " * Normalizing output wave functions\n\n" ); //for(i=0;i<dim;i++) // for(j=0;j<dim;j++) // if( j == i ) // nqbox[i*dim+j] = 1.0; // else // nqbox[i*dim+j] = 0.0; //for(i=0;i<neig;i++) //{ // sum = 0.0; // for(j=0;j<npts;j++) // { // for(k=0;k<dim;k++) // index[k] = 0, size[k] = (long) quadn - 1; // do // { // /* Calculate the spherical gauss point for this index */ // copy( dim, pt.pts + j * dim, ctr ); // rad = pt.dlt[j]; // sphere_gauss_point( dim, ctr, rad, nqbox, index, qpts, qwts, qx, &qw ); // domain_indicator( qx, &dm, &ret ); // if( ret == 1 ) // sum += qw * punity_evaluate( &pt, j, qx ); // } // while( arraynext( (long) dim, size, index ) != -1 ); // } //} /* Do some plotting */ if( b_out_eig_range_set ) { /* Announce */ fprintf( stderr, " * Plotting eigenvectors " ); for(i=0;i<nfr;i++) { if( rng[i][0] == rng[i][1] ) fprintf( stderr, "%d ", rng[i][0] ); else if( rng[i][1] > rng[i][0] ) fprintf( stderr, "%d-%d ", rng[i][0], rng[i][1] ); } fprintf( stderr, "\n\n" ); for(i=0;i<dim;i++) size[i] = (long) dx[i] - 1; for(i=0;i<dim;i++) index[i] = 0; do { /* Build the point at which to evaluate the eigenfunction */ for(i=0;i<dim;i++) qx[i] = x0[i] + (double) index[i] * dd[i]; /* Output the point for this line */ for(i=0;i<dim;i++) fprintf( stdout, "%15.7f", qx[i] ); /* Now evaluate the function at that point */ for(n=0;n<nfr;n++) { for(m=rng[n][0];m<=rng[n][1];m++) { sum = 0.0; for(i=0;i<npts-nbp;i++) { y = 0.0; for(j=0;j<dim;j++) y += pow( qx[j] - pt.pts[ltg[i]*dim+j], 2.0 ); y = sqrt( y ); if( y < pt.dlt[ltg[i]] ) sum += eig[m*(npts-nbp)+i] * punity_evaluate_delta( &pt, ltg[i], qx, i_sing_order ); } /* Ouptut the values consecutively */ fprintf( stdout, "%15.7f", sum ); } } /* Close the line */ fprintf( stdout, "\n" ); /* Check to see if another newline is needed to maintain gnuplot's preferred format */ for(i=0;i<dim;i++) tindex[i] = index[i]; arraynext( (long) dim, size, tindex ); for(i=0;i<dim;i++) { if( index[i] == dx[i] - 1 && tindex[i] != dx[i] - 1 ) { fprintf( stdout, "\n" ); break; } } } while( arraynext( (long) dim, size, index ) != -1 ); } /* Announce exit */ fprintf( stderr, " * Exiting happily. Have a nice day!\n\n" ); /* Don't forget to clean up */ free( pts ); free( dlt ); free( drv ); free( qpts ); free( qwts ); free( ia ); free( ib ); free( ja ); free( jb ); free( A ); free( B ); free( Q ); free( alpha ); free( beta ); free( gamma ); free( omega ); free( ctr ); free( qbox ); free( nqbox ); free( qx ); free( size ); free( index ); free( ev ); free( eig ); free( ltg ); return 0; }