// ---------------------------------------------------------------------
string sm(string c)
{
rc=0;
if (c=="act")
return smact();
if (c=="active")
return smactive();
if (c=="close")
return smclose();
if (c=="focus")
return smfocus();
if (c=="font")
return smfont();
if (c=="get")
return smget();
if (c=="html")
return smhtml();
if (c=="new")
return smopen();
if (c=="open")
return smopen();
if (c=="profont")
return smprofont();
if (c=="replace")
return smreplace();
if (c=="save")
return smsave();
if (c=="set")
return smset();
else if (c=="prompt")
return smprompt();
cmd.getparms();
return smerror("unrecognized sm command: " + c);
}
int main( int argc, char **argv )
{
/* Counting variables */
int i,ii,j,jj,k,m,n,p,pp,qq,ret;
double x,y,x1,x2,rum,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,mdim,nnb,nrbf,*nb,*drv,*expl,*expr,*ltg,*nlbase,**lbase;
double *pts,*dlt;
punity_t pt;
wfsd_t *rbf;
/* Quadrature variables */
double *ctr,*qbox,*nqbox,*qx,qw,rad;
long *size,*index,*tindex;
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"
/* 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;
}
if( b_use_external_potential && !b_nuc_loaded )
{
fprintf( stderr, " * ERROR: No external potential loaded.\n" );
fprintf( stderr, " * ERROR: If you want to run without a potential\n" );
fprintf( stderr, " * ERROR: then set useExternalPotential = no.\n" );
fprintf( stderr, " * ERROR: Exiting.\n\n" );
return 0;
}
/* 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) );
expl = (int*) malloc( dim * sizeof(int) );
expr = (int*) malloc( dim * sizeof(int) );
/* 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 );
///////////////////////////////////////////////////////////////////
// THIS BLOCK SHOULD BE SOMEHOW TAKEN AS INPUT FROM THE CFG FILE //
///////////////////////////////////////////////////////////////////
/* Set up extra basis functions */
rbf = (wfsd_t*) malloc( 1 * sizeof(wfsd_t) );
rbf[0] = &exp_func;
nrbf = 1;
/* Set up basis on each center; this info should be given as input */
nlbase = (int*) malloc( npts * sizeof(int) );
lbase = (int**) malloc( npts * sizeof(int*) );
for(i=0;i<npts;i++)
{
nlbase[i] = 6;
lbase[i] = (int*) malloc( 16 * sizeof(int) );
lbase[i][0] = 0;
lbase[i][1] = 1;
lbase[i][2] = 2;
lbase[i][3] = 3;
lbase[i][4] = 4;
lbase[i][5] = 5;
lbase[i][6] = 6;
lbase[i][7] = 7;
lbase[i][8] = 8;
lbase[i][9] = 9;
}
nlbase[24] = 7;
lbase[24][6] = -1;
/* Adjust nucleus diameter */
//pt.dlt[12] *= 1.2;
/* Calculate the dimension of the matrices A and B */
mdim = 0;
for(i=0;i<npts;i++)
if( pt.bdry[i] == 0 )
mdim += nlbase[i];
/* Display matrix dimension */
fprintf( stderr, " * Set matrix dimension to %d\n\n", mdim );
/* Now that boundary points are known, make final adjustments to Lanczos parameters */
if( i_max_lanczos_steps > mdim )
{
i_max_lanczos_steps = mdim;
fprintf( stderr, " * ERROR: Value of maxLanczosSteps > mdim: Setting maxLanczosSteps to %d\n\n", mdim );
}
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 );
}
/* Allocate space for the sparse matrices */
ia = (long*) malloc( ( mdim + 2 ) * sizeof(long) );
ib = (long*) malloc( ( mdim + 2 ) * 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;
/* Generate Q for saving Lanczos vectors later */
Q = (double*) malloc( ( i_max_lanczos_steps + 2 ) * mdim * 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 );
}
/* Allocate the index space for excluding boundary points */
ltg = (int*) malloc( ( npts - nbp ) * sizeof(int) );
/* Build list of non-boundary particles */
for(i=0,p=0;i<npts;i++)
if( pt.bdry[i] == 0 )
ltg[p++] = i;
/* Call matrix build function */
fprintf( stderr, " * Building system matrices " );
puksham_mbuild( &pt, mdim, nbp, &dm, nlbase, lbase, rbf, ltg, &nuc, quadn, qpts, qwts, &ia, &ja, &A, &ib, &jb, &B, cc, c_spmat_inc,
b_use_external_potential, b_load_overl_mat, b_load_stiff_mat, b_use_singular, i_sing_order,
&b_have_stiff_mat, &b_have_overl_mat );
/* 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, mdim, mdim, 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, mdim, mdim, 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 > mdim ) )
{
fprintf( stderr, " * ERROR: Number of eigenvalues not specified or invalid. Exiting.\n\n " );
return 0;
}
alpha = (double*) malloc( ( i_max_lanczos_steps + 2 ) * sizeof(double) );
beta = (double*) malloc( ( i_max_lanczos_steps + 2 ) * sizeof(double) );
gamma = (double*) malloc( ( i_max_lanczos_steps + 2 ) * sizeof(double) );
omega = (double*) malloc( ( i_max_lanczos_steps + 2 ) * sizeof(double) );
ev = (double*) malloc( 2 * ( i_max_lanczos_steps + 2 ) * sizeof(double) );
eig = (double*) malloc( ( neig + 2 ) * mdim * sizeof(double) );
/* Seed the random number generator */
srand((unsigned)time(0));
/* Lanczos procedure */
fprintf( stderr, " * Beginning Lanczos procedure\n\n" );
sgsilanczoscr( mdim, i_max_lanczos_steps, neig, ib, jb, B, ia, ja, A, alpha, beta, omega, NULL, ev, Q, &mo, 1e-16, &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;
}
inverse_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( mdim, eig + i * mdim );
sgsinvi( mdim, ia, ja, A, ib, jb, B, eig + i * mdim, 1.0 / ev[2*i+0], 1e-9, 20000, 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*mdim+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,pp=0;i<npts-nbp;i++)
{
for(ii=0;ii<nlbase[ltg[i]];ii++)
{
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]] )
{
if( lbase[ltg[i]][ii] >= 0 )
{
global_polynomial_vector( lbase[ltg[i]][ii], dim, expl );
if( b_use_singular )
sum += eig[m*mdim+pp] * punity_eval_local_poly_delta( &pt, ltg[i], expl, qx, i_sing_order );
else
sum += eig[m*mdim+pp] * punity_eval_local_poly( &pt, ltg[i], expl, qx );
}
else
{
/* Deal with plotting of localized extra RBFs */
for(j=0;j<dim;j++)
ctr[j] = qx[j] - pt.pts[ltg[i]*dim+j];
sum += eig[m*mdim+pp] * rbf[-1-lbase[ltg[i]][ii]]( dim, 0, pt.dlt[ltg[i]], ctr ) * punity_evaluate( &pt, ltg[i], qx );
}
}
pp++;
}
}
/* Ouptut the values consecutively */
fprintf( stdout, "%18.10f", 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 ); free( expl ); free( expr );
for(i=0;i<npts;i++)
free( lbase[i] );
free( lbase );
free( nlbase );
punity_free( &pt );
if( b_use_external_potential )
nuclei_free( &nuc );
return 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;
}
int main( int argc, char **argv )
{
/* Basic variables */
int i,j,k,p,m;
int dim = 2;
int deg = 3;
int pdim = binomial( dim + deg, dim );
int plm = 0;
int radn = 10;
int nnz;
int ret,ns;
double zrt = 1e-6;
double sum;
double xx,res;
double tol = zrt;
double sft = 0.0;
int neig = 100;
double *ev = (double*) malloc( 2 * neig * sizeof(double) );
double *alpha = (double*) malloc( ( neig + 3 ) * sizeof(double) );
double *beta = (double*) malloc( ( neig + 3 ) * sizeof(double) );
double *gamma = (double*) malloc( ( neig + 3 ) * sizeof(double) );
/* Switches */
int b_sft = 0; /* Use argument as shift */
int b_prj = 0; /* Build projected system matrices */
int b_pc = 0; /* Build a preconditioner */
int b_grd = 0; /* Load points from grid file */
int b_ext = 0; /* Load external potential */
/* Other stuff */
char gfn[1024];
FILE *fp;
rkp_t rk;
nuclei_t ext;
symtab_t sym;
symbol_t ss;
/* Take in the options */
int optc;
while( ( optc = getopt( argc, argv, "C:g:d:s:t:S:r:x:pPc" ) ) != -1 )
{
switch( optc )
{
case 'C':
symtab_init( &sym, 1024 );
cfgread_load_symbols_f( optarg, &sym );
symtab_print( &sym );
break;
case 'r':
radn = atoi( optarg );
break;
case 'c':
b_pc = 1;
break;
case 'd':
deg = atoi( optarg );
break;
case 't':
tol = atof( optarg );
break;
case 'S':
sft = atof( optarg );
b_sft = 1;
break;
case 'p':
plm = 1;
break;
case 'P':
b_prj = 1;
break;
case 'g':
b_grd = 1;
strcpy( gfn, optarg );
break;
case 'x':
b_ext = 1;
load_nuclei( optarg, &ext, 0 );
nuclei_print( &ext );
break;
case '?':
default:
fprintf( stderr, "I don't understand the jibberish you are spouting. Goodbye.\n" );
return 0;
break;
}
}
if( !b_ext )
{
fprintf( stderr, "Please specify an external potential. Exiting.\n" );
return 0;
}
/* Allocate and generate grid points */
int nb;
int npts;
double *pts,*dlt,*val,*gqw;
/* Load points from file if switch is set */
if( b_grd )
{
fprintf( stderr, "Loading points from file... " );
load_points( gfn, &dim, &npts, &pts, 0 );
fprintf( stderr, "dim = %d npts = %d. Done.\n", dim, npts );
fflush( stderr );
}
/* Set up the plot points */
int pgx = 70;
int pgy = 70;
double x = 5.0;
double y = 5.0;
double pdx = x / (double) ( pgx - 1 );
double pdy = y / (double) ( pgy - 1 );
int nppts = pgx * pgy;
double *ppts = (double*) malloc( nppts * dim * sizeof(double) );
for(i=0;i<pgx;i++)
for(j=0;j<pgy;j++)
ppts[i*pgy*dim+j*dim+0] = (double) i * pdx,
ppts[i*pgy*dim+j*dim+1] = (double) j * pdy;
/* Generate supports */
dlt = (double*) malloc( npts * sizeof(double) );
val = (double*) malloc( npts * sizeof(double) );
gqw = (double*) malloc( npts * sizeof(double) );
generate_cloud_supports_min( 2, npts, pts, radn, 1.05, dlt, 0.001 );
for(i=0;i<npts;i++)
gqw[i] = 1.0;
/* Build variables */
double f,g,r,s,rr,a,b;
double *vv,*ww,*pc,*xv,*xvh,*rv,*rvh,*rrv,*rrvh,*pv,*pvh; /* Variables for CG iteration */
double *amat,*bmat,*cmat,*cmatt,*smat,*tmat,*temp,*dv,*rhs;
long *iamat,*jamat,*ibmat,*jbmat,*icmat,*jcmat,*icmatt,*jcmatt,*ismat,*jsmat,*itmat,*jtmat,*list;
/* Calculate the number of non-zeros */
for(nnz=0,i=0;i<npts;i++)
{
for(j=0;j<npts;j++)
{
xx = 0.0;
for(k=0;k<dim;k++)
xx += pow( pts[i*dim+k] - pts[j*dim+k], 2.0 );
if( xx < pow( dlt[j], 2.0 ) )
++nnz;
}
}
fprintf( stderr, "nnz = %5d\n", nnz );
nnz = nnz + 1;
/* Allocate this stuff static for now, but make dynamic ASAP */
iamat = (long*) malloc( ( npts + 1 ) * sizeof(long) );
jamat = (long*) malloc( nnz * sizeof(long) );
ibmat = (long*) malloc( ( npts + 1 ) * sizeof(long) );
jbmat = (long*) malloc( nnz * sizeof(long) );
icmat = (long*) malloc( ( npts + 1 ) * sizeof(long) );
jcmat = (long*) malloc( nnz * sizeof(long) );
icmatt = (long*) malloc( ( npts + 1 ) * sizeof(long) );
jcmatt = (long*) malloc( nnz * sizeof(long) );
ismat = (long*) malloc( ( npts + 1 ) * sizeof(long) );
jsmat = (long*) malloc( npts * npts * sizeof(long) );
itmat = (long*) malloc( ( npts + 1 ) * sizeof(long) );
jtmat = (long*) malloc( npts * npts * sizeof(long) );
list = (long*) malloc( ( npts + 1 ) * sizeof(long) );
temp = (double*) malloc( ( npts + 1 ) * sizeof(double) );
/* Allocate stuff; can't use stack for this garbage!!! */
vv = (double*) malloc( npts * npts * sizeof(double) );
ww = (double*) malloc( npts * npts * sizeof(double) );
pc = (double*) malloc( npts * sizeof(double) );
xv = (double*) malloc( npts * sizeof(double) );
xvh = (double*) malloc( npts * sizeof(double) );
rv = (double*) malloc( npts * sizeof(double) );
rvh = (double*) malloc( npts * sizeof(double) );
rrv = (double*) malloc( npts * sizeof(double) );
rrvh = (double*) malloc( npts * sizeof(double) );
pv = (double*) malloc( npts * sizeof(double) );
pvh = (double*) malloc( npts * sizeof(double) );
/* Allocate matrix storage */
amat = (double*) malloc( nnz * sizeof(double) );
bmat = (double*) malloc( nnz * sizeof(double) );
cmat = (double*) malloc( nnz * sizeof(double) );
cmatt = (double*) malloc( nnz * sizeof(double) );
smat = (double*) malloc( npts * npts * sizeof(double) );
tmat = (double*) malloc( npts * npts * sizeof(double) );
rhs = (double*) malloc( npts * sizeof(double) );
dv = (double*) malloc( npts * sizeof(double) );
/* Initialize the RKP basis */
rkp_init( &rk, npts, dim, deg, pts, dlt, gqw, val, cubic, 1.0 );
rkp_basis_generate_scaled_const( &rk );
rkp_wavelet_basis_generate_scaled_const( &rk );
/* Form the Laplace operator correctly with wavelets */
int ord[2] = { 2, 4 }; /* Indexes which contain the xx and yy second derivatives */
/* Build the matrices here to simplify things as much as possible */
for(i=0;i<nnz;i++) /* Don't need this many entries anymore */
amat[i] = 0.0, bmat[i] = 0.0;
for(i=0;i<npts;i++)
iamat[i] = -1, ibmat[i] = -1;
for(p=0,i=0;i<npts;i++)
{
for(j=0;j<npts;j++)
{
/* Check to see if window function at j is large enough to be nonzero */
xx = 0.0;
for(k=0;k<dim;k++)
xx += pow( pts[i*dim+k] - pts[j*dim+k], 2.0 );
if( xx > pow( dlt[j] * rk.wrad, 2.0 ) )
continue;
if( iamat[i] == -1 )
iamat[i] = p; /* The beginning of row i entries in amat */
if( ibmat[i] == -1 )
ibmat[i] = p;
jamat[p] = j;
jbmat[p] = j;
for(k=0;k<dim;k++)
amat[p] -= 2.0 * 0.5 * gqw[j] * rkp_wavelet_term_evaluate_node_scaled_const( &rk, j, ord[k], i ) / dlt[i] / dlt[i];
amat[p] += gqw[j] * rkp_term_evaluate_node_scaled_const( &rk, j, i ) * coulomb_potential( dim, pts + i * dim, ext.np, ext.pts );
bmat[p] = gqw[j] * rkp_term_evaluate_node_scaled_const( &rk, j, i );
++p;
}
}
iamat[npts] = p;
ibmat[npts] = p;
/* Save some garbage in case dumb shit happens */
smsave( "amat.oct", npts, npts, iamat, jamat, amat, 1 );
smsave( "bmat.oct", npts, npts, ibmat, jbmat, bmat, 1 );
fprintf( stderr, "nnz = %d\n", p );
fflush( stderr );
/* Generate a random initial state vector */
srand((unsigned)time(0));
/* Count the number of boundary nodes */
nb = 0;
for(i=0;i<npts;i++)
if( on_boundary( pts + i * dim ) == 1 )
++nb;
/* QR factorization first */
fprintf( stderr, "Running QR factorization... " );
fflush( stderr );
eigenvalue_qrfactorize( dim, npts, pts, ibmat, jbmat, bmat, rhs, vv );
fprintf( stderr, "Done.\n" );
fflush( stderr );
/* Now build the subspace projection matrix */
fprintf( stderr, "Building subspace projection matrix... " );
fflush( stderr );
eigenvalue_subprojmat( npts, nb, vv, ww );
fprintf( stderr, "Done.\n" );
fflush( stderr );
/* Save the projection matrix */
msave( "wmat.oct", npts - nb, npts, ww, 1 );
/* Build smat and tmat */
fprintf( stderr, "Building smat and tmat... " );
fflush( stderr );
sparse_symbmm( (long) npts, (long) npts, (long) npts,
ibmat, jbmat, iamat, jamat, ismat, jsmat, list );
sparse_dgemm( (long) npts, (long) npts, (long) npts,
ibmat, jbmat, bmat, iamat, jamat, amat, ismat, jsmat, smat, temp );
sparse_symbmm( (long) npts, (long) npts, (long) npts,
ibmat, jbmat, ibmat, jbmat, itmat, jtmat, list );
sparse_dgemm( (long) npts, (long) npts, (long) npts,
ibmat, jbmat, bmat, ibmat, jbmat, bmat, itmat, jtmat, tmat, temp );
fprintf( stderr, "Done.\n" );
fflush( stderr );
/* Initialize to a normalized random vector */
eigenvalue_initialize( npts, rhs );
/* Now subtract out all vectors in vv from rhs */
eigenvalue_project( npts, nb, vv, rhs );
/* Normalize first using tmat */
eigenvalue_normalize( npts, itmat, jtmat, tmat, rhs, temp );
/* Initialize the preconditioner to the identity */
for(i=0;i<npts;i++)
pc[i] = 1.0;
/* Solve the eigenvalue problem actually */
fprintf( stderr, "\n" );
fprintf( stderr, "Solving Jacobi-Davidson method:\n" );
eigenvalue_solver( npts, iamat, jamat, amat, ibmat, jbmat, bmat, icmat, jcmat, cmat,
icmatt, jcmatt, cmatt, ismat, jsmat, smat, itmat, jtmat, tmat,
rv, rvh, rrv, rrvh, pv, pvh, xv, xvh, dv, pc, rhs, temp, r, tol,
nb, b_pc, -0.145, vv );
/* Attempt constrained sparse generalized unsymmetric Lanczos biorthogonalization to solve for bottom few eigenvalues */
fprintf( stderr, "\n" );
fprintf( stderr, "Solving with constrained Lanczos method:\n" );
csgulanczoslp( npts, neig, iamat, jamat, amat, ibmat, jbmat, bmat, alpha, beta, gamma, NULL, NULL, nb, vv, 1e-10, 200, 0, &ret );
//csgulanczoslp( npts, neig, ibmat, jbmat, bmat, iamat, jamat, amat, alpha, beta, gamma, NULL, NULL, nb, vv, 1e-10, 1000, 0, &ret );
//sgulanczos( npts, neig, iamat, jamat, amat, ibmat, jbmat, bmat, alpha, beta, gamma, NULL, NULL, 1e-10, 200, 0, &ret );
fprintf( stderr, "lanczos ret = %d\n", ret );
treigtridqds( neig, alpha + 1, beta + 1, gamma + 1, 100000, ev, &ret, &ns );
complex_bubble_sort( neig, ev );
fprintf( stderr, "Reduction = %d Steps = %d\n", ret, ns );
for(i=0;i<neig;i++)
fprintf( stderr, "%15.7f+%15.7fi\n", ev[2*i+0], ev[2*i+1] );
/* Calculate actual eigenvalue */
eigenvalue_calculate( npts, iamat, jamat, amat, ibmat, jbmat, bmat, rhs, temp, &f );
fprintf( stderr, "RQ = %15.7f\n", f );
/* Copy the solution into the rk structure */
for(i=0;i<npts;i++)
rk.vals[i] = rhs[i];
/* Output the function */
if( plm )
{
fp = fopen( "plot", "w" );
for(i=0;i<pgx*pgy;i++)
{
fprintf( fp, "%15.7f%15.7f%15.7f\n", ppts[i*dim+0], ppts[i*dim+1], rkp_evaluate_scaled_const( &rk, ppts + i * dim, 0.2 ), 0.1 );
if( ( i + 1 ) % pgy == 0 )
fprintf( fp, "\n" );
}
fclose( fp );
}
else
{
fp = fopen( "plot", "w" );
for(i=0;i<npts;i++)
fprintf( fp, "%15.7f%15.7f%15.7f\n", pts[i*dim+0], pts[i*dim+1], rkp_evaluate_node_scaled_const( &rk, i ) );
}
free( pts );
free( dlt );
free( val );
free( gqw );
free( ppts );
return 0;
}
