void petsc_lobpcg_solve_c_(
Vec* u, /* prototype of a vector, not used */
int* num_eval, /* number of eigenvalues to compute */
int* maxit, /* maximum number of iterations */
int* niter, /* actual number of iterations */
double* atol, /* absolute error tolerance */
double* rtol, /* relative error tolerance */
double* eigenvalues, /* computed eigenvalues */
void *matmult_opA, /* Fortran Routine for operator A */
void *matmult_opB, /* Fortran routine for operator B */
void *matmult_opT, /* Fortran routine for operator T */
void *petsc_lobpcg_return_evec, /* Fortran routine gets eigenvectors */
void *petsc_lobpcg_initial_guess, /* Fortran routine for initial guess */
int* info) /* error code */
{
PetscErrorCode ierr; /* for PETSc return code */
mv_MultiVectorPtr eigenvectors; /* the eigenvectors */
PetscScalar * eigs; /* the eigenvalues */
PetscScalar * eigs_hist; /* history of eigenvalues */
double * resid; /* the residuals */
double * resid_hist; /* history of residuals */
int iterations; /* number of iterations */
int n_eigs; /* number of eigenvalues */
int i;
PetscTruth outpt=PETSC_FALSE; /* print evals and resids */
lobpcg_Tolerance lobpcg_tol; /* residual tolerance */
mv_InterfaceInterpreter ii; /* Interface Interpreter */
lobpcg_BLASLAPACKFunctions blap_fn; /* BLAS functions */
aux_data_struct aux_data; /* auxillary data */
/* set the number of eigenvalues to compute */
n_eigs = *num_eval;
/* set pointers to the Fortran callback functions */
/* type casting added For Ver 1.1 */
hold_matmult_opA =(void (*)(void *,void *,void *)) matmult_opA;
hold_matmult_opB =(void (*)(void *,void *,void *)) matmult_opB;
hold_matmult_opT =(void (*)(void *,void *,void *)) matmult_opT;
hold_petsc_lobpcg_initial_guess =(void (*)(void *)) petsc_lobpcg_initial_guess;
hold_petsc_lobpcg_return_evec = (void (*)(void *)) petsc_lobpcg_return_evec;
/* allocate memory for the eigenvalues, residuals and histories */
ierr = PetscMalloc(sizeof(PetscScalar)*n_eigs,&eigs);
ierr = PetscMalloc(sizeof(PetscScalar)*n_eigs*(*maxit+1),&eigs_hist);
ierr = PetscMalloc(sizeof(double)*n_eigs,&resid);
ierr = PetscMalloc(sizeof(double)*n_eigs*(*maxit+1),&resid_hist);
/* create the Interface Interpreter and put it in auxillary data */
PETSCSetupInterpreter( &ii );
aux_data.ii = ii;
/* set tolerances and BLAS routines */
lobpcg_tol.absolute = *atol;
lobpcg_tol.relative = *rtol;
#ifdef PETSC_USE_COMPLEX /* complex check added for Ver 1.1 */
blap_fn.zpotrf = PETSC_zpotrf_interface;
blap_fn.zhegv = PETSC_zsygv_interface;
#else
blap_fn.dpotrf = PETSC_dpotrf_interface;
blap_fn.dsygv = PETSC_dsygv_interface;
#endif
/* create the multivector for eigenvectors */
eigenvectors = mv_MultiVectorCreateFromSampleVector(&ii, n_eigs,*u);
/* set the initial guess. The second instance of eigenvectors in this
call isn't actually used, but something has to be passed in */
petsc_lobpcg_initial_guess_MultiVector(&aux_data,
mv_MultiVectorGetData(eigenvectors),
mv_MultiVectorGetData(eigenvectors));
/* call the lobpcg solver from BLOPEX */
#ifdef PETSC_USE_COMPLEX /* complex check added for Ver 1.1 */
ierr = lobpcg_solve_complex( eigenvectors,
&aux_data,
OperatorAMultiVector,
&aux_data,
OperatorBMultiVector,
&aux_data,
OperatorTMultiVector,
NULL,
blap_fn,
lobpcg_tol,
*maxit,
0, /* verbosity, use 2 for debugging */
&iterations,
(komplex *) eigs,
(komplex *) eigs_hist,
n_eigs,
resid,
resid_hist,
n_eigs
);
#else
ierr = lobpcg_solve_double( eigenvectors,
&aux_data,
OperatorAMultiVector,
&aux_data,
OperatorBMultiVector,
&aux_data,
OperatorTMultiVector,
NULL,
blap_fn,
lobpcg_tol,
*maxit,
0, /* verbosity, use 2 for debugging */
&iterations,
eigs,
eigs_hist,
n_eigs,
resid,
resid_hist,
n_eigs
);
#endif
/* set the return error code to lobpcg's error code */
*info = ierr;
/* set the number of iterations used */
*niter = iterations;
/* copy the eigenvalues to the return variable */
#ifdef PETSC_USE_COMPLEX /* complex check added for Ver 1.1 */
for (i=0;i<n_eigs;i++) eigenvalues[i] = PetscRealPart(eigs[i]);
#else
for (i=0;i<n_eigs;i++) eigenvalues[i] = eigs[i];
#endif
/* return the eigenvectors. The second instance of eigenvectors isn't used
here either */
petsc_lobpcg_return_evec_MultiVector(&aux_data,
mv_MultiVectorGetData(eigenvectors),
mv_MultiVectorGetData(eigenvectors));
/* printed output, for debugging */
if (outpt)
{
PetscPrintf(PETSC_COMM_WORLD,"Output from LOBPCG driver\n");
PetscPrintf(PETSC_COMM_WORLD," iterations: %d\n",iterations);
PetscPrintf(PETSC_COMM_WORLD," eigenvalues and residuals:\n");
for (i=0;i<n_eigs;i++)
{
ierr = PetscPrintf(PETSC_COMM_WORLD,"%e %e\n",PetscRealPart(eigs[i]),resid[i]);
}
/*
PetscPrintf(PETSC_COMM_WORLD,"Output from LOBPCG, eigenvalues history:\n");
for (j=0; j<iterations+1; j++)
for (i=0;i<n_eigs;i++)
{
ierr = PetscPrintf(PETSC_COMM_WORLD,"%e\n",*(eigs_hist+j*n_eigs+i));
}
PetscPrintf(PETSC_COMM_WORLD,"Output from LOBPCG, residual norms:\n");
for (i=0;i<n_eigs;i++)
{
ierr = PetscPrintf(PETSC_COMM_WORLD,"%e\n",resid[i]);
}
PetscPrintf(PETSC_COMM_WORLD,"Output from LOBPCG, residual norms history:\n");
for (j=0; j<iterations+1; j++)
for (i=0;i<n_eigs;i++)
{
ierr = PetscPrintf(PETSC_COMM_WORLD,"%e\n",*(resid_hist+j*n_eigs+i));
}
*/
}
/* free work space */
mv_MultiVectorDestroy(eigenvectors);
ierr = PetscFree(eigs);
ierr = PetscFree(eigs_hist);
ierr = PetscFree(resid);
ierr = PetscFree(resid_hist);
}
int main(int argc,char **args)
{
Vec u;
Mat A;
PetscErrorCode ierr;
mv_MultiVectorPtr eigenvectors;
PetscScalar * eigs;
PetscScalar * eigs_hist;
double * resid;
double * resid_hist;
int iterations;
PetscMPIInt rank;
int n_eigs = 1;
int seed = 1;
int i,j;
PetscLogDouble t1,t2,elapsed_time;
DA da;
double tol=1e-08;
PetscTruth option_present;
PetscTruth freepart=PETSC_FALSE;
PetscTruth full_output=PETSC_FALSE;
PetscInt m,n,p;
KSP ksp;
lobpcg_Tolerance lobpcg_tol;
int maxIt = 100;
mv_InterfaceInterpreter ii;
lobpcg_BLASLAPACKFunctions blap_fn;
aux_data_struct aux_data;
/*
PetscViewer viewer;
*/
PetscInt tmp_int;
mv_TempMultiVector * xe;
PetscInt N;
PetscScalar * xx;
PetscInitialize(&argc,&args,(char *)0,help);
ierr = PetscOptionsGetInt(PETSC_NULL,"-n_eigs",&tmp_int,&option_present);CHKERRQ(ierr);
if (option_present)
n_eigs = tmp_int;
ierr = PetscOptionsGetReal(PETSC_NULL,"-tol", &tol,PETSC_NULL); CHKERRQ(ierr);
ierr = PetscOptionsHasName(PETSC_NULL,"-freepart",&freepart); CHKERRQ(ierr);
ierr = PetscOptionsHasName(PETSC_NULL,"-full_out",&full_output); CHKERRQ(ierr);
ierr = PetscOptionsGetInt(PETSC_NULL,"-seed",&tmp_int,&option_present);CHKERRQ(ierr);
if (option_present)
seed = tmp_int;
ierr = PetscOptionsGetInt(PETSC_NULL,"-itr",&tmp_int,&option_present);CHKERRQ(ierr);
if (option_present)
maxIt = tmp_int;
if (seed<1)
seed=1;
/* we actually run our code twice: first time we solve small problem just to make sure
that all program code is actually loaded into memory; then we solve the problem
we are interested in; this trick is done for accurate timing
*/
PreLoadBegin(PETSC_TRUE,"grid and matrix assembly");
/* "create" the grid and stencil data; on first run we form small problem */
if (PreLoadIt==0)
{
/* small problem */
ierr=DACreate3d(PETSC_COMM_WORLD,DA_NONPERIODIC,DA_STENCIL_STAR,10,10,10,
1,PETSC_DECIDE,1,1,1,0,0,0,&da); CHKERRQ(ierr);
}
else
{
/* actual problem */
if (freepart) /* petsc determines partitioning */
{
ierr=DACreate3d(PETSC_COMM_WORLD,DA_NONPERIODIC,DA_STENCIL_STAR,-10,-10,-10,
PETSC_DECIDE,PETSC_DECIDE,PETSC_DECIDE,1,1,0,0,0,&da); CHKERRQ(ierr);
}
else /* (1,NP,1) partitioning */
{
ierr=DACreate3d(PETSC_COMM_WORLD,DA_NONPERIODIC,DA_STENCIL_STAR,-10,-10,-10,
1,PETSC_DECIDE,1,1,1,0,0,0,&da); CHKERRQ(ierr);
}
/* now we print what partitioning is chosen */
ierr=DAGetInfo(da,PETSC_NULL,PETSC_NULL,PETSC_NULL,PETSC_NULL,&m,
&n,&p,PETSC_NULL,PETSC_NULL,PETSC_NULL,PETSC_NULL); CHKERRQ(ierr);
PetscPrintf(PETSC_COMM_WORLD,"Partitioning: %u %u %u\n",m,n,p);
}
/* create matrix, whose nonzero structure and probably partitioning corresponds to
grid and stencil structure */
ierr=DAGetMatrix(da,MATMPIAIJ,&A); CHKERRQ(ierr);
/* fill the matrix with values. I intend to build 7-pt Laplas */
/* this procedure includes matrix assembly */
ierr=FillMatrix(da,A); CHKERRQ(ierr);
/*
PetscViewerBinaryOpen(PETSC_COMM_WORLD,"matrix.dat",FILE_MODE_WRITE,&viewer);
MatView(A,PETSC_VIEWER_STDOUT_WORLD);
PetscViewerDestroy(viewer);
*/
/*
Create parallel vectors.
- We form 1 vector from scratch and then duplicate as needed.
*/
ierr = DACreateGlobalVector(da,&u); CHKERRQ(ierr);
/* ierr = VecSetFromOptions(u);CHKERRQ(ierr); */
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create the linear solver and set various options
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/* Here we START measuring time for preconditioner setup */
PreLoadStage("preconditioner setup");
ierr = PetscGetTime(&t1);CHKERRQ(ierr);
/*
Create linear solver context
*/
ierr = KSPCreate(PETSC_COMM_WORLD,&ksp);CHKERRQ(ierr);
/*
Set operators. Here the matrix that defines the linear system
also serves as the preconditioning matrix.
*/
ierr = KSPSetOperators(ksp,A,A,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
/*
Set runtime options, e.g.,
-ksp_type <type> -pc_type <type> -ksp_monitor -ksp_rtol <rtol>
These options will override those specified above as long as
KSPSetFromOptions() is called _after_ any other customization
routines.
*/
ierr = KSPSetFromOptions(ksp);CHKERRQ(ierr);
/* probably this call actually builds the preconditioner */
ierr = KSPSetUp(ksp);CHKERRQ(ierr);
/* Here we STOP measuring time for preconditioner setup */
PreLoadStage("solution");
ierr = PetscGetTime(&t2);CHKERRQ(ierr);
elapsed_time=t2-t1;
if (PreLoadIt==1)
PetscPrintf(PETSC_COMM_WORLD,"Preconditioner setup, seconds: %f\n",elapsed_time);
/* request memory for eig-vals */
ierr = PetscMalloc(sizeof(PetscScalar)*n_eigs,&eigs); CHKERRQ(ierr);
/* request memory for eig-vals history */
ierr = PetscMalloc(sizeof(PetscScalar)*n_eigs*(maxIt+1),&eigs_hist); CHKERRQ(ierr);
/* request memory for resid. norms */
ierr = PetscMalloc(sizeof(double)*n_eigs,&resid); CHKERRQ(ierr);
/* request memory for resid. norms hist. */
ierr = PetscMalloc(sizeof(double)*n_eigs*(maxIt+1),&resid_hist); CHKERRQ(ierr);
LOBPCG_InitRandomContext();
MPI_Comm_rank(PETSC_COMM_WORLD,&rank);
PETSCSetupInterpreter( &ii );
eigenvectors = mv_MultiVectorCreateFromSampleVector(&ii, n_eigs,u);
xe = (mv_TempMultiVector *) mv_MultiVectorGetData( eigenvectors );
/*
VecView( (Vec)xe->vector[0],PETSC_VIEWER_STDOUT_WORLD);
*/
for (i=0; i<seed; i++) /* this cycle is to imitate changing random seed */
mv_MultiVectorSetRandom (eigenvectors, 1234);
/*
VecView( (Vec)xe->vector[0],PETSC_VIEWER_STDOUT_WORLD);
*/
VecGetSize( (Vec)xe->vector[0], &N );
N=mv_TempMultiVectorHeight( xe );
VecGetArray( (Vec)xe->vector[0],&xx);
lobpcg_tol.absolute = tol;
lobpcg_tol.relative = 1e-50;
#ifdef PETSC_USE_COMPLEX
blap_fn.zpotrf = PETSC_zpotrf_interface;
blap_fn.zhegv = PETSC_zsygv_interface;
#else
blap_fn.dpotrf = PETSC_dpotrf_interface;
blap_fn.dsygv = PETSC_dsygv_interface;
#endif
aux_data.A = A;
aux_data.ksp = ksp;
aux_data.ii = ii;
/* Here we START measuring time for solution process */
ierr = PetscGetTime(&t1);CHKERRQ(ierr);
#ifdef PETSC_USE_COMPLEX
lobpcg_solve_complex(
eigenvectors, /*input-initial guess of e-vectors */
&aux_data, /*input-matrix A */
OperatorAMultiVector, /*input-operator A */
NULL, /*input-matrix B */
NULL, /*input-operator B */
&aux_data, /*input-matrix T */
Precond_FnMultiVector, /*input-operator T */
NULL, /*input-matrix Y */
blap_fn, /*input-lapack functions */
lobpcg_tol, /*input-tolerances */
PreLoadIt? maxIt:1, /*input-max iterations */
!rank && PreLoadIt, /*input-verbosity level */
&iterations, /*output-actual iterations */
(komplex *) eigs, /*output-eigenvalues */
(komplex *) eigs_hist, /*output-eigenvalues history */
n_eigs, /*output-history global height */
resid, /*output-residual norms */
resid_hist , /*output-residual norms history */
n_eigs /*output-history global height */
);
#else
lobpcg_solve_double( eigenvectors,
&aux_data,
OperatorAMultiVector,
NULL,
NULL,
&aux_data,
Precond_FnMultiVector,
NULL,
blap_fn,
lobpcg_tol,
PreLoadIt? maxIt:1,
!rank && PreLoadIt,
&iterations,
eigs, /* eigenvalues; "lambda_values" should point to array
containing <blocksize> doubles where <blocksize> is the
width of multivector "blockVectorX" */
eigs_hist,
/* eigenvalues history; a pointer to the entries of the
<blocksize>-by-(<maxIterations>+1) matrix stored in
fortran-style. (i.e. column-wise) The matrix may be
a submatrix of a larger matrix, see next argument */
n_eigs, /* global height of the matrix (stored in fotran-style)
specified by previous argument */
resid,
/* residual norms; argument should point to
array of <blocksize> doubles */
resid_hist ,
/* residual norms history; a pointer to the entries of the
<blocksize>-by-(<maxIterations>+1) matrix stored in
fortran-style. (i.e. column-wise) The matrix may be
a submatrix of a larger matrix, see next argument */
n_eigs
/* global height of the matrix (stored in fotran-style)
specified by previous argument */
);
#endif
/* Here we STOP measuring time for solution process */
ierr = PetscGetTime(&t2);CHKERRQ(ierr);
elapsed_time=t2-t1;
if (PreLoadIt)
PetscPrintf(PETSC_COMM_WORLD,"Solution process, seconds: %e\n",elapsed_time);
if (PreLoadIt && full_output)
{
PetscPrintf(PETSC_COMM_WORLD,"Output from LOBPCG, eigenvalues:\n");
for (i=0;i<n_eigs;i++)
{
ierr = PetscPrintf(PETSC_COMM_WORLD,"%e\n",PetscRealPart(eigs[i]));
CHKERRQ(ierr);
}
PetscPrintf(PETSC_COMM_WORLD,"Output from LOBPCG, eigenvalues history:\n");
for (j=0; j<iterations+1; j++)
for (i=0;i<n_eigs;i++)
{
ierr = PetscPrintf(PETSC_COMM_WORLD,"%e\n",PetscRealPart(*(eigs_hist+j*n_eigs+i)));
CHKERRQ(ierr);
}
PetscPrintf(PETSC_COMM_WORLD,"Output from LOBPCG, residual norms:\n");
for (i=0;i<n_eigs;i++)
{
ierr = PetscPrintf(PETSC_COMM_WORLD,"%e\n",resid[i]);
CHKERRQ(ierr);
}
PetscPrintf(PETSC_COMM_WORLD,"Output from LOBPCG, residual norms history:\n");
for (j=0; j<iterations+1; j++)
for (i=0;i<n_eigs;i++)
{
ierr = PetscPrintf(PETSC_COMM_WORLD,"%e\n",*(resid_hist+j*n_eigs+i));
CHKERRQ(ierr);
}
}
/*
Free work space. All PETSc objects should be destroyed when they
are no longer needed.
*/
ierr = VecDestroy(u);CHKERRQ(ierr);
ierr = MatDestroy(A);CHKERRQ(ierr);
ierr = KSPDestroy(ksp);CHKERRQ(ierr);
ierr = DADestroy(da); CHKERRQ(ierr);
LOBPCG_DestroyRandomContext();
mv_MultiVectorDestroy(eigenvectors);
/* free memory used for eig-vals */
ierr = PetscFree(eigs); CHKERRQ(ierr);
ierr = PetscFree(eigs_hist); CHKERRQ(ierr);
ierr = PetscFree(resid); CHKERRQ(ierr);
ierr = PetscFree(resid_hist); CHKERRQ(ierr);
/*
Always call PetscFinalize() before exiting a program. This routine
- finalizes the PETSc libraries as well as MPI
- provides summary and diagnostic information if certain runtime
options are chosen (e.g., -log_summary).
*/
PreLoadEnd();
ierr = PetscFinalize();CHKERRQ(ierr);
return 0;
}
int
hypre_LOBPCGSolve( void *vdata,
mv_MultiVectorPtr con,
mv_MultiVectorPtr vec,
double* val )
{
hypre_LOBPCGData* data = vdata;
int (*precond)() = (data->precondFunctions).Precond;
void* opB = data->B;
void (*prec)( void*, void*, void* );
void (*operatorA)( void*, void*, void* );
void (*operatorB)( void*, void*, void* );
int maxit = lobpcg_maxIterations(data->lobpcgData);
int verb = lobpcg_verbosityLevel(data->lobpcgData);
int n = mv_MultiVectorWidth( vec );
lobpcg_BLASLAPACKFunctions blap_fn;
utilities_FortranMatrix* lambdaHistory;
utilities_FortranMatrix* residuals;
utilities_FortranMatrix* residualsHistory;
lambdaHistory = lobpcg_eigenvaluesHistory(data->lobpcgData);
residuals = lobpcg_residualNorms(data->lobpcgData);
residualsHistory = lobpcg_residualNormsHistory(data->lobpcgData);
utilities_FortranMatrixAllocateData( n, maxit + 1, lambdaHistory );
utilities_FortranMatrixAllocateData( n, 1, residuals );
utilities_FortranMatrixAllocateData( n, maxit + 1, residualsHistory );
if ( precond != NULL )
prec = hypre_LOBPCGMultiPreconditioner;
else
prec = NULL;
operatorA = hypre_LOBPCGMultiOperatorA;
if ( opB != NULL )
operatorB = hypre_LOBPCGMultiOperatorB;
else
operatorB = NULL;
blap_fn.dsygv = dsygv_interface;
blap_fn.dpotrf = dpotrf_interface;
lobpcg_solve_double( vec,
vdata, operatorA,
vdata, operatorB,
vdata, prec,
con,
blap_fn,
lobpcg_tolerance(data->lobpcgData), maxit, verb,
&(lobpcg_iterationNumber(data->lobpcgData)),
val,
utilities_FortranMatrixValues(lambdaHistory),
utilities_FortranMatrixGlobalHeight(lambdaHistory),
utilities_FortranMatrixValues(residuals),
utilities_FortranMatrixValues(residualsHistory),
utilities_FortranMatrixGlobalHeight(residualsHistory)
);
return hypre_error_flag;
}
