Actual source code: petsc-interface.c
1: /* @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ */
2: /* @@@ BLOPEX (version 1.1) LGPL Version 2.1 or above.See www.gnu.org. */
3: /* @@@ Copyright 2010 BLOPEX team http://code.google.com/p/blopex/ */
4: /* @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ */
5: /* This code was developed by Merico Argentati, Andrew Knyazev, Ilya Lashuk and Evgueni Ovtchinnikov */
7: #include <petscsys.h>
8: #include <petscvec.h>
9: #include <petscmat.h>
10: #include <assert.h>
11: #include <petscblaslapack.h>
12: #include "blopex_interpreter.h"
13: #include "blopex_temp_multivector.h"
15: #ifdef PETSC_USE_COMPLEX
16: #ifdef PETSC_CLANGUAGE_CXX
17: #include <complex>
18: using namespace std;
19: #endif
20: #endif
22: static PetscRandom LOBPCG_RandomContext = PETSC_NULL;
24: typedef struct {double real, imag;} komplex;
26: BlopexInt PETSC_dpotrf_interface (char *uplo, BlopexInt *n, double *a, BlopexInt * lda, BlopexInt *info)
27: {
28: PetscBLASInt n_, lda_, info_;
30: /* type conversion */
31: n_ = *n;
32: lda_ = *lda;
33: info_ = *info;
35: LAPACKpotrf_(uplo, &n_, (PetscScalar*)a, &lda_, &info_);
37: *info = info_;
38: return 0;
39: }
41: BlopexInt PETSC_zpotrf_interface (char *uplo, BlopexInt *n, komplex *a, BlopexInt * lda, BlopexInt *info)
42: {
43: PetscBLASInt n_, lda_, info_;
45: /* type conversion */
46: n_ = *n;
47: lda_ = *lda;
48: info_ = *info;
50: LAPACKpotrf_(uplo, &n_, (PetscScalar*)a, &lda_, &info_);
52: *info = info_;
53: return 0;
54: }
56: BlopexInt PETSC_dsygv_interface (BlopexInt *itype, char *jobz, char *uplo, BlopexInt *
57: n, double *a, BlopexInt *lda, double *b, BlopexInt *ldb,
58: double *w, double *work, BlopexInt *lwork, BlopexInt *info)
59: {
60: #ifndef PETSC_USE_COMPLEX
61: PetscBLASInt itype_, n_, lda_, ldb_, lwork_, info_;
63: itype_ = *itype;
64: n_ = *n;
65: lda_ = *lda;
66: ldb_ = *ldb;
67: lwork_ = *lwork;
68: info_ = *info;
70: LAPACKsygv_(&itype_, jobz, uplo, &n_, (PetscScalar*)a, &lda_,
71: (PetscScalar*)b, &ldb_, (PetscScalar*)w, (PetscScalar*)work, &lwork_, &info_);
73: *info = info_;
74: #endif
75: return 0;
77: }
79: BlopexInt PETSC_zsygv_interface (BlopexInt *itype, char *jobz, char *uplo, BlopexInt *
80: n, komplex *a, BlopexInt *lda, komplex *b, BlopexInt *ldb,
81: double *w, komplex *work, BlopexInt *lwork, double *rwork, BlopexInt *info)
82: {
83: #ifdef PETSC_USE_COMPLEX
84: PetscBLASInt itype_, n_, lda_, ldb_, lwork_, info_;
86: itype_ = *itype;
87: n_ = *n;
88: lda_ = *lda;
89: ldb_ = *ldb;
90: lwork_ = *lwork;
91: info_ = *info;
93: LAPACKsygv_(&itype_, jobz, uplo, &n_, (PetscScalar*)a, &lda_,
94: (PetscScalar*)b, &ldb_, (PetscReal*)w, (PetscScalar*)work, &lwork_, (PetscReal*)rwork, &info_);
96: *info = info_;
97: #endif
98: return 0;
100: }
102: void *
103: PETSC_MimicVector( void *vvector )
104: {
105: PetscErrorCode ierr;
106: Vec temp;
108: ierr=VecDuplicate((Vec) vvector, &temp );
109: assert (ierr==0);
110: return ((void *)temp);
111: }
113: BlopexInt
114: PETSC_DestroyVector( void *vvector )
115: {
117: Vec v=(Vec)vvector;
119: ierr=VecDestroy(&v);
120: return(0);
121: }
123: BlopexInt
124: PETSC_InnerProd( void *x, void *y, void *result )
125: {
126: PetscErrorCode ierr;
128: ierr=VecDot( (Vec)x, (Vec)y, (PetscScalar *) result);
129: assert(ierr==0);
130: return (0);
131: }
133: BlopexInt
134: PETSC_CopyVector( void *x, void *y )
135: {
136: PetscErrorCode ierr;
138: VecCopy( (Vec)x, (Vec)y );
139: return(0);
140: }
142: BlopexInt
143: PETSC_ClearVector( void *x )
144: {
145: PetscErrorCode ierr;
147: VecSet((Vec)x, 0.0);
148: return(0);
149: }
151: BlopexInt
152: PETSC_SetRandomValues( void* v, BlopexInt seed )
153: {
156: /* note: without previous call to LOBPCG_InitRandomContext LOBPCG_RandomContext will be null,
157: and VecSetRandom will use internal petsc random context */
159: VecSetRandom((Vec)v, LOBPCG_RandomContext);
161: return(0);
162: }
164: BlopexInt
165: PETSC_ScaleVector( double alpha, void *x)
166: {
169: VecScale ((Vec)x, alpha);
170: return(0);
171: }
173: BlopexInt
174: PETSC_Axpy( void *alpha,
175: void *x,
176: void *y )
177: {
180: VecAXPY( (Vec)y, *(PetscScalar *)alpha, (Vec)x );
181: return(0);
182: }
183: BlopexInt
184: PETSC_VectorSize( void *x )
185: {
186: PetscInt N;
187: VecGetSize( (Vec)x, &N );
188: return(N);
189: }
191: int
192: LOBPCG_InitRandomContext(MPI_Comm comm,PetscRandom rand)
193: {
195: /* PetscScalar rnd_bound = 1.0; */
197: if (rand) {
198: PetscObjectReference((PetscObject)rand);
199: PetscRandomDestroy(&LOBPCG_RandomContext);
200: LOBPCG_RandomContext = rand;
201: } else {
202: PetscRandomCreate(comm,&LOBPCG_RandomContext);
203: }
205: return 0;
206: }
208: int
209: LOBPCG_SetFromOptionsRandomContext(void)
210: {
212: PetscRandomSetFromOptions(LOBPCG_RandomContext);
214: #ifdef PETSC_USE_COMPLEX
215: #ifdef PETSC_CLANGUAGE_CXX
216: PetscRandomSetInterval(LOBPCG_RandomContext,(PetscScalar) complex<double>(-1,-1),(PetscScalar)complex<double>(1,1));
217: #else
218: PetscRandomSetInterval(LOBPCG_RandomContext,(PetscScalar)-1.0-1.0*I,(PetscScalar)1.0+1.0*I);
219: #endif
220: #else
221: PetscRandomSetInterval(LOBPCG_RandomContext,(PetscScalar)-1.0,(PetscScalar)1.0);
222: #endif
223:
225: return 0;
226: }
228: int
229: LOBPCG_DestroyRandomContext(void)
230: {
233: PetscRandomDestroy(&LOBPCG_RandomContext);
234:
235: return 0;
236: }
238: int
239: PETSCSetupInterpreter( mv_InterfaceInterpreter *i )
240: {
242: i->CreateVector = PETSC_MimicVector;
243: i->DestroyVector = PETSC_DestroyVector;
244: i->InnerProd = PETSC_InnerProd;
245: i->CopyVector = PETSC_CopyVector;
246: i->ClearVector = PETSC_ClearVector;
247: i->SetRandomValues = PETSC_SetRandomValues;
248: i->ScaleVector = PETSC_ScaleVector;
249: i->Axpy = PETSC_Axpy;
250: i->VectorSize = PETSC_VectorSize;
252: /* Multivector part */
253:
254: i->CreateMultiVector = mv_TempMultiVectorCreateFromSampleVector;
255: i->CopyCreateMultiVector = mv_TempMultiVectorCreateCopy;
256: i->DestroyMultiVector = mv_TempMultiVectorDestroy;
258: i->Width = mv_TempMultiVectorWidth;
259: i->Height = mv_TempMultiVectorHeight;
260: i->SetMask = mv_TempMultiVectorSetMask;
261: i->CopyMultiVector = mv_TempMultiVectorCopy;
262: i->ClearMultiVector = mv_TempMultiVectorClear;
263: i->SetRandomVectors = mv_TempMultiVectorSetRandom;
264: i->Eval = mv_TempMultiVectorEval;
266: #ifdef PETSC_USE_COMPLEX
267: i->MultiInnerProd = mv_TempMultiVectorByMultiVector_complex;
268: i->MultiInnerProdDiag = mv_TempMultiVectorByMultiVectorDiag_complex;
269: i->MultiVecMat = mv_TempMultiVectorByMatrix_complex;
270: i->MultiVecMatDiag = mv_TempMultiVectorByDiagonal_complex;
271: i->MultiAxpy = mv_TempMultiVectorAxpy_complex;
272: i->MultiXapy = mv_TempMultiVectorXapy_complex;
273: #else
274: i->MultiInnerProd = mv_TempMultiVectorByMultiVector;
275: i->MultiInnerProdDiag = mv_TempMultiVectorByMultiVectorDiag;
276: i->MultiVecMat = mv_TempMultiVectorByMatrix;
277: i->MultiVecMatDiag = mv_TempMultiVectorByDiagonal;
278: i->MultiAxpy = mv_TempMultiVectorAxpy;
279: i->MultiXapy = mv_TempMultiVectorXapy;
280: #endif
282: return 0;
283: }