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;
	}
}
Ejemplo n.º 2
0
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;
}