Actual source code: lapack.c
1: /*
2: This file implements a wrapper to the LAPACK eigenvalue subroutines.
3: Generalized problems are transformed to standard ones only if necessary.
5: - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
6: SLEPc - Scalable Library for Eigenvalue Problem Computations
7: Copyright (c) 2002-2013, Universitat Politecnica de Valencia, Spain
9: This file is part of SLEPc.
11: SLEPc is free software: you can redistribute it and/or modify it under the
12: terms of version 3 of the GNU Lesser General Public License as published by
13: the Free Software Foundation.
15: SLEPc is distributed in the hope that it will be useful, but WITHOUT ANY
16: WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
17: FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for
18: more details.
20: You should have received a copy of the GNU Lesser General Public License
21: along with SLEPc. If not, see <http://www.gnu.org/licenses/>.
22: - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
23: */
25: #include <slepc-private/epsimpl.h> /*I "slepceps.h" I*/
26: #include <slepcblaslapack.h>
30: PetscErrorCode EPSSetUp_LAPACK(EPS eps)
31: {
32: PetscErrorCode ierr,ierra,ierrb;
33: PetscBool isshift,denseok=PETSC_FALSE;
34: Mat A,B,OP,Adense,Bdense;
35: PetscScalar shift,*Ap,*Bp;
36: PetscInt i,ld,nmat;
37: KSP ksp;
38: PC pc;
39: Vec v;
42: eps->ncv = eps->n;
43: if (eps->mpd) { PetscInfo(eps,"Warning: parameter mpd ignored\n"); }
44: if (!eps->which) { EPSSetWhichEigenpairs_Default(eps); }
45: if (eps->balance!=EPS_BALANCE_NONE) { PetscInfo(eps,"Warning: balancing ignored\n"); }
46: if (eps->extraction) { PetscInfo(eps,"Warning: extraction type ignored\n"); }
47: EPSAllocateSolution(eps);
49: /* attempt to get dense representations of A and B separately */
50: PetscObjectTypeCompare((PetscObject)eps->st,STSHIFT,&isshift);
51: if (isshift) {
52: STGetNumMatrices(eps->st,&nmat);
53: STGetOperators(eps->st,0,&A);
54: if (nmat>1) { STGetOperators(eps->st,1,&B); }
55: PetscPushErrorHandler(PetscIgnoreErrorHandler,NULL);
56: ierra = SlepcMatConvertSeqDense(A,&Adense);
57: if (eps->isgeneralized) {
58: ierrb = SlepcMatConvertSeqDense(B,&Bdense);
59: } else {
60: ierrb = 0;
61: }
62: PetscPopErrorHandler();
63: denseok = (ierra == 0 && ierrb == 0)? PETSC_TRUE: PETSC_FALSE;
64: } else Adense = NULL;
66: /* setup DS */
67: if (denseok) {
68: if (eps->isgeneralized) {
69: if (eps->ishermitian) {
70: if (eps->ispositive) {
71: DSSetType(eps->ds,DSGHEP);
72: } else {
73: DSSetType(eps->ds,DSGNHEP); /* TODO: should be DSGHIEP */
74: }
75: } else {
76: DSSetType(eps->ds,DSGNHEP);
77: }
78: } else {
79: if (eps->ishermitian) {
80: DSSetType(eps->ds,DSHEP);
81: } else {
82: DSSetType(eps->ds,DSNHEP);
83: }
84: }
85: } else {
86: DSSetType(eps->ds,DSNHEP);
87: }
88: DSAllocate(eps->ds,eps->ncv);
89: DSGetLeadingDimension(eps->ds,&ld);
90: DSSetDimensions(eps->ds,eps->ncv,0,0,0);
92: if (denseok) {
93: STGetShift(eps->st,&shift);
94: if (shift != 0.0) {
95: MatShift(Adense,shift);
96: }
97: /* use dummy pc and ksp to avoid problems when B is not positive definite */
98: STGetKSP(eps->st,&ksp);
99: KSPSetType(ksp,KSPPREONLY);
100: KSPGetPC(ksp,&pc);
101: PCSetType(pc,PCNONE);
102: } else {
103: PetscInfo(eps,"Using slow explicit operator\n");
104: STComputeExplicitOperator(eps->st,&OP);
105: MatDestroy(&Adense);
106: SlepcMatConvertSeqDense(OP,&Adense);
107: }
109: /* fill DS matrices */
110: VecCreateSeqWithArray(PETSC_COMM_SELF,1,ld,NULL,&v);
111: DSGetArray(eps->ds,DS_MAT_A,&Ap);
112: for (i=0;i<ld;i++) {
113: VecPlaceArray(v,Ap+i*ld);
114: MatGetColumnVector(Adense,v,i);
115: VecResetArray(v);
116: }
117: DSRestoreArray(eps->ds,DS_MAT_A,&Ap);
118: if (denseok && eps->isgeneralized) {
119: DSGetArray(eps->ds,DS_MAT_B,&Bp);
120: for (i=0;i<ld;i++) {
121: VecPlaceArray(v,Bp+i*ld);
122: MatGetColumnVector(Bdense,v,i);
123: VecResetArray(v);
124: }
125: DSRestoreArray(eps->ds,DS_MAT_B,&Bp);
126: }
127: VecDestroy(&v);
128: MatDestroy(&Adense);
129: if (!denseok) { MatDestroy(&OP); }
130: if (denseok && eps->isgeneralized) { MatDestroy(&Bdense); }
131: return(0);
132: }
136: PetscErrorCode EPSSolve_LAPACK(EPS eps)
137: {
139: PetscInt n=eps->n,i,low,high;
140: PetscScalar *array,*pX,*pY;
143: DSSolve(eps->ds,eps->eigr,eps->eigi);
144: DSSort(eps->ds,eps->eigr,eps->eigi,NULL,NULL,NULL);
146: /* right eigenvectors */
147: DSVectors(eps->ds,DS_MAT_X,NULL,NULL);
148: DSGetArray(eps->ds,DS_MAT_X,&pX);
149: for (i=0;i<eps->ncv;i++) {
150: VecGetOwnershipRange(eps->V[i],&low,&high);
151: VecGetArray(eps->V[i],&array);
152: PetscMemcpy(array,pX+i*n+low,(high-low)*sizeof(PetscScalar));
153: VecRestoreArray(eps->V[i],&array);
154: }
155: DSRestoreArray(eps->ds,DS_MAT_X,&pX);
157: /* left eigenvectors */
158: if (eps->leftvecs) {
159: DSVectors(eps->ds,DS_MAT_Y,NULL,NULL);
160: DSGetArray(eps->ds,DS_MAT_Y,&pY);
161: for (i=0;i<eps->ncv;i++) {
162: VecGetOwnershipRange(eps->W[i],&low,&high);
163: VecGetArray(eps->W[i],&array);
164: PetscMemcpy(array,pY+i*n+low,(high-low)*sizeof(PetscScalar));
165: VecRestoreArray(eps->W[i],&array);
166: }
167: DSRestoreArray(eps->ds,DS_MAT_Y,&pY);
168: }
169: eps->nconv = eps->ncv;
170: eps->its = 1;
171: eps->reason = EPS_CONVERGED_TOL;
172: return(0);
173: }
177: PetscErrorCode EPSReset_LAPACK(EPS eps)
178: {
182: EPSFreeSolution(eps);
183: return(0);
184: }
188: PETSC_EXTERN PetscErrorCode EPSCreate_LAPACK(EPS eps)
189: {
191: eps->ops->solve = EPSSolve_LAPACK;
192: eps->ops->setup = EPSSetUp_LAPACK;
193: eps->ops->reset = EPSReset_LAPACK;
194: eps->ops->backtransform = EPSBackTransform_Default;
195: eps->ops->computevectors = EPSComputeVectors_Default;
196: return(0);
197: }