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: }