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