Actual source code: lapack.c

  2: /*                       
  3:        This file implements a wrapper to the LAPACK eigenvalue subroutines.
  4:        Generalized problems are transformed to standard ones only if necessary.
  5: */
 6:  #include src/eps/epsimpl.h
 7:  #include slepcblaslapack.h

  9: typedef struct {
 10:   Mat OP,A,B;
 11: } EPS_LAPACK;

 15: PetscErrorCode EPSSetUp_LAPACK(EPS eps)
 16: {
 17:   PetscErrorCode ierr,ierra,ierrb;
 18:   PetscInt       N;
 19:   EPS_LAPACK     *la = (EPS_LAPACK *)eps->data;
 20:   PetscTruth     flg;
 21:   Mat            A,B;
 22:   PetscScalar    shift;
 23: 
 25:   VecGetSize(eps->vec_initial,&N);
 26:   if (eps->nev<1 || eps->nev>N) SETERRQ(1,"Wrong value of nev");
 27:   eps->ncv = N;

 29:   if (la->OP) { MatDestroy(la->OP); }
 30:   if (la->A) { MatDestroy(la->A); }
 31:   if (la->B) { MatDestroy(la->B); }

 33:   PetscTypeCompare((PetscObject)eps->OP,STSHIFT,&flg);
 34:   STGetOperators(eps->OP,&A,&B);
 35: 
 36:   if (flg) {
 37:     la->OP = PETSC_NULL;
 38:     PetscPushErrorHandler(SlepcQuietErrorHandler,PETSC_NULL);
 39:     ierra = SlepcMatConvertSeqDense(A,&la->A);
 40:     if (eps->isgeneralized) {
 41:       ierrb = SlepcMatConvertSeqDense(B,&la->B);
 42:     } else {
 43:       ierrb = 0;
 44:       la->B = PETSC_NULL;
 45:     }
 46:     PetscPopErrorHandler();
 47:     if (ierra == 0 && ierrb == 0) {
 48:       STGetShift(eps->OP,&shift);
 49:       if (shift != 0.0) {
 50:         MatShift(la->A,shift);
 51:       }
 52:       EPSAllocateSolutionContiguous(eps);
 53:       return(0);
 54:     }
 55:   }
 56:   PetscInfo(eps,"Using slow explicit operator\n");
 57:   la->A = PETSC_NULL;
 58:   la->B = PETSC_NULL;
 59:   STComputeExplicitOperator(eps->OP,&la->OP);
 60:   PetscTypeCompare((PetscObject)la->OP,MATSEQDENSE,&flg);
 61:   if (!flg) {
 62:     SlepcMatConvertSeqDense(la->OP,&la->OP);
 63:   }
 64:   EPSAllocateSolutionContiguous(eps);
 65:   return(0);
 66: }

 70: PetscErrorCode EPSSolve_LAPACK(EPS eps)
 71: {
 73:   PetscInt       n,i,low,high;
 74:   PetscMPIInt    size;
 75:   PetscScalar    *array,*arrayb,*pV,*pW;
 76:   PetscReal      *w;
 77:   EPS_LAPACK     *la = (EPS_LAPACK *)eps->data;
 78:   MPI_Comm       comm = eps->comm;
 79: 
 81:   MPI_Comm_size(comm,&size);
 82: 
 83:   VecGetSize(eps->vec_initial,&n);

 85:   if (size == 1) {
 86:     VecGetArray(eps->V[0],&pV);
 87:   } else {
 88:     PetscMalloc(sizeof(PetscScalar)*n*n,&pV);
 89:   }
 90:   if (eps->solverclass == EPS_TWO_SIDE && (la->OP || !eps->ishermitian)) {
 91:     if (size == 1) {
 92:       VecGetArray(eps->W[0],&pW);
 93:     } else {
 94:       PetscMalloc(sizeof(PetscScalar)*n*n,&pW);
 95:     }
 96:   } else pW = PETSC_NULL;
 97: 
 98: 
 99:   if (la->OP) {
100:     MatGetArray(la->OP,&array);
101:     EPSDenseNHEP(n,array,eps->eigr,eps->eigi,pV,pW);
102:     MatRestoreArray(la->OP,&array);
103:   } else if (eps->ishermitian) {
104: #if defined(PETSC_USE_COMPLEX)
105:     PetscMalloc(n*sizeof(PetscReal),&w);
106: #else
107:     w = eps->eigr;
108: #endif
109:     MatGetArray(la->A,&array);
110:     if (!eps->isgeneralized) {
111:       EPSDenseHEP(n,array,n,w,pV);
112:     } else {
113:       MatGetArray(la->B,&arrayb);
114:       EPSDenseGHEP(n,array,arrayb,w,pV);
115:       MatRestoreArray(la->B,&arrayb);
116:     }
117:     MatRestoreArray(la->A,&array);
118: #if defined(PETSC_USE_COMPLEX)
119:     for (i=0;i<n;i++) {
120:       eps->eigr[i] = w[i];
121:     }
122:     PetscFree(w);
123: #endif    
124:   } else {
125:     MatGetArray(la->A,&array);
126:     if (!eps->isgeneralized) {
127:       EPSDenseNHEP(n,array,eps->eigr,eps->eigi,pV,pW);
128:     } else {
129:       MatGetArray(la->B,&arrayb);
130:       EPSDenseGNHEP(n,array,arrayb,eps->eigr,eps->eigi,pV,pW);
131:       MatRestoreArray(la->B,&arrayb);
132:     }
133:     MatRestoreArray(la->A,&array);
134:   }

136:   if (size == 1) {
137:     VecRestoreArray(eps->V[0],&pV);
138:   } else {
139:     for (i=0; i<eps->ncv; i++) {
140:       VecGetOwnershipRange(eps->V[i], &low, &high);
141:       VecGetArray(eps->V[i], &array);
142:       PetscMemcpy(array, pV+i*n+low, (high-low)*sizeof(PetscScalar));
143:       VecRestoreArray(eps->V[i], &array);
144:     }
145:     PetscFree(pV);
146:   }
147:   if (pW) {
148:     if (size == 1) {
149:       VecRestoreArray(eps->W[0],&pW);
150:     } else {
151:       for (i=0; i<eps->ncv; i++) {
152:         VecGetOwnershipRange(eps->W[i], &low, &high);
153:         VecGetArray(eps->W[i], &array);
154:         PetscMemcpy(array, pW+i*n+low, (high-low)*sizeof(PetscScalar));
155:         VecRestoreArray(eps->W[i], &array);
156:       }
157:       PetscFree(pW);
158:     }
159:   }

161:   eps->nconv = eps->ncv;
162:   eps->its   = 1;
163:   eps->reason = EPS_CONVERGED_TOL;
164: 
165:   return(0);
166: }

170: PetscErrorCode EPSDestroy_LAPACK(EPS eps)
171: {
173:   EPS_LAPACK     *la = (EPS_LAPACK *)eps->data;

177:   if (la->OP) { MatDestroy(la->OP); }
178:   if (la->A) { MatDestroy(la->A); }
179:   if (la->B) { MatDestroy(la->B); }
180:   PetscFree(eps->data);
181:   EPSFreeSolutionContiguous(eps);
182:   return(0);
183: }

188: PetscErrorCode EPSCreate_LAPACK(EPS eps)
189: {
191:   EPS_LAPACK     *la;

194:   PetscNew(EPS_LAPACK,&la);
195:   PetscLogObjectMemory(eps,sizeof(EPS_LAPACK));
196:   eps->data                      = (void *) la;
197:   eps->ops->solve                = EPSSolve_LAPACK;
198:   eps->ops->solvets              = EPSSolve_LAPACK;
199:   eps->ops->setup                = EPSSetUp_LAPACK;
200:   eps->ops->destroy              = EPSDestroy_LAPACK;
201:   eps->ops->backtransform        = EPSBackTransform_Default;
202:   eps->ops->computevectors       = EPSComputeVectors_Default;
203:   return(0);
204: }