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: PetscBLASInt itype_, n_, lda_, ldb_, lwork_, info_;
62: itype_ = *itype;
63: n_ = *n;
64: lda_ = *lda;
65: ldb_ = *ldb;
66: lwork_ = *lwork;
67: info_ = *info;
69: #ifdef PETSC_USE_COMPLEX
70: #else
71: LAPACKsygv_(&itype_, jobz, uplo, &n_, (PetscScalar*)a, &lda_,
72: (PetscScalar*)b, &ldb_, (PetscScalar*)w, (PetscScalar*)work, &lwork_, &info_);
73: #endif
75: *info = info_;
76: return 0;
78: }
80: BlopexInt PETSC_zsygv_interface (BlopexInt *itype, char *jobz, char *uplo, BlopexInt *
81: n, komplex *a, BlopexInt *lda, komplex *b, BlopexInt *ldb,
82: double *w, komplex *work, BlopexInt *lwork, double *rwork, BlopexInt *info)
83: {
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: #ifdef PETSC_USE_COMPLEX
94: LAPACKsygv_(&itype_, jobz, uplo, &n_, (PetscScalar*)a, &lda_,
95: (PetscScalar*)b, &ldb_, (PetscReal*)w, (PetscScalar*)work, &lwork_, (PetscReal*)rwork, &info_);
96: #endif
98: *info = info_;
99: return 0;
101: }
103: void *
104: PETSC_MimicVector( void *vvector )
105: {
106: PetscErrorCode ierr;
107: Vec temp;
109: ierr=VecDuplicate((Vec) vvector, &temp );
110: assert (ierr==0);
111: return ((void *)temp);
112: }
114: BlopexInt
115: PETSC_DestroyVector( void *vvector )
116: {
118: Vec v=(Vec)vvector;
120: ierr=VecDestroy(&v);
121: return(0);
122: }
124: BlopexInt
125: PETSC_InnerProd( void *x, void *y, void *result )
126: {
127: PetscErrorCode ierr;
129: ierr=VecDot( (Vec)x, (Vec)y, (PetscScalar *) result);
130: assert(ierr==0);
131: return (0);
132: }
134: BlopexInt
135: PETSC_CopyVector( void *x, void *y )
136: {
137: PetscErrorCode ierr;
139: VecCopy( (Vec)x, (Vec)y );
140: return(0);
141: }
143: BlopexInt
144: PETSC_ClearVector( void *x )
145: {
146: PetscErrorCode ierr;
148: VecSet((Vec)x, 0.0);
149: return(0);
150: }
152: BlopexInt
153: PETSC_SetRandomValues( void* v, BlopexInt seed )
154: {
157: /* note: without previous call to LOBPCG_InitRandomContext LOBPCG_RandomContext will be null,
158: and VecSetRandom will use internal petsc random context */
160: VecSetRandom((Vec)v, LOBPCG_RandomContext);
162: return(0);
163: }
165: BlopexInt
166: PETSC_ScaleVector( double alpha, void *x)
167: {
170: VecScale ((Vec)x, alpha);
171: return(0);
172: }
174: BlopexInt
175: PETSC_Axpy( void *alpha,
176: void *x,
177: void *y )
178: {
181: VecAXPY( (Vec)y, *(PetscScalar *)alpha, (Vec)x );
182: return(0);
183: }
184: BlopexInt
185: PETSC_VectorSize( void *x )
186: {
187: PetscInt N;
188: VecGetSize( (Vec)x, &N );
189: return(N);
190: }
192: int
193: LOBPCG_InitRandomContext(MPI_Comm comm)
194: {
196: /* PetscScalar rnd_bound = 1.0; */
198: PetscRandomCreate(comm,&LOBPCG_RandomContext);
200: return 0;
201: }
203: int
204: LOBPCG_SetFromOptionsRandomContext(void)
205: {
207: PetscRandomSetFromOptions(LOBPCG_RandomContext);
209: #ifdef PETSC_USE_COMPLEX
210: #ifdef PETSC_CLANGUAGE_CXX
211: PetscRandomSetInterval(LOBPCG_RandomContext,(PetscScalar) complex<double>(-1,-1),(PetscScalar)complex<double>(1,1));
212: #else
213: PetscRandomSetInterval(LOBPCG_RandomContext,(PetscScalar)-1.0-1.0*I,(PetscScalar)1.0+1.0*I);
214: #endif
215: #else
216: PetscRandomSetInterval(LOBPCG_RandomContext,(PetscScalar)-1.0,(PetscScalar)1.0);
217: #endif
218:
220: return 0;
221: }
223: int
224: LOBPCG_DestroyRandomContext(void)
225: {
228: PetscRandomDestroy(&LOBPCG_RandomContext);
229:
230: return 0;
231: }
233: int
234: PETSCSetupInterpreter( mv_InterfaceInterpreter *i )
235: {
237: i->CreateVector = PETSC_MimicVector;
238: i->DestroyVector = PETSC_DestroyVector;
239: i->InnerProd = PETSC_InnerProd;
240: i->CopyVector = PETSC_CopyVector;
241: i->ClearVector = PETSC_ClearVector;
242: i->SetRandomValues = PETSC_SetRandomValues;
243: i->ScaleVector = PETSC_ScaleVector;
244: i->Axpy = PETSC_Axpy;
245: i->VectorSize = PETSC_VectorSize;
247: /* Multivector part */
248:
249: i->CreateMultiVector = mv_TempMultiVectorCreateFromSampleVector;
250: i->CopyCreateMultiVector = mv_TempMultiVectorCreateCopy;
251: i->DestroyMultiVector = mv_TempMultiVectorDestroy;
253: i->Width = mv_TempMultiVectorWidth;
254: i->Height = mv_TempMultiVectorHeight;
255: i->SetMask = mv_TempMultiVectorSetMask;
256: i->CopyMultiVector = mv_TempMultiVectorCopy;
257: i->ClearMultiVector = mv_TempMultiVectorClear;
258: i->SetRandomVectors = mv_TempMultiVectorSetRandom;
259: i->Eval = mv_TempMultiVectorEval;
261: #ifdef PETSC_USE_COMPLEX
262: i->MultiInnerProd = mv_TempMultiVectorByMultiVector_complex;
263: i->MultiInnerProdDiag = mv_TempMultiVectorByMultiVectorDiag_complex;
264: i->MultiVecMat = mv_TempMultiVectorByMatrix_complex;
265: i->MultiVecMatDiag = mv_TempMultiVectorByDiagonal_complex;
266: i->MultiAxpy = mv_TempMultiVectorAxpy_complex;
267: i->MultiXapy = mv_TempMultiVectorXapy_complex;
268: #else
269: i->MultiInnerProd = mv_TempMultiVectorByMultiVector;
270: i->MultiInnerProdDiag = mv_TempMultiVectorByMultiVectorDiag;
271: i->MultiVecMat = mv_TempMultiVectorByMatrix;
272: i->MultiVecMatDiag = mv_TempMultiVectorByDiagonal;
273: i->MultiAxpy = mv_TempMultiVectorAxpy;
274: i->MultiXapy = mv_TempMultiVectorXapy;
275: #endif
277: return 0;
278: }