Actual source code: bvbiorthog.c
slepc-3.15.0 2021-03-31
1: /*
2: - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
3: SLEPc - Scalable Library for Eigenvalue Problem Computations
4: Copyright (c) 2002-2021, Universitat Politecnica de Valencia, Spain
6: This file is part of SLEPc.
7: SLEPc is distributed under a 2-clause BSD license (see LICENSE).
8: - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
9: */
10: /*
11: BV bi-orthogonalization routines
12: */
14: #include <slepc/private/bvimpl.h>
16: /*
17: BVBiorthogonalizeMGS1 - Compute one step of Modified Gram-Schmidt bi-orthogonalization
18: */
19: static PetscErrorCode BVBiorthogonalizeMGS1(BV V,BV W,Vec v,PetscScalar *h,PetscScalar *c)
20: {
22: PetscInt i;
23: PetscScalar dot;
24: Vec vi,wi;
27: for (i=-V->nc;i<V->k;i++) {
28: BVGetColumn(W,i,&wi);
29: /* h_i = (v, w_i) */
30: VecDot(v,wi,&dot);
31: BVRestoreColumn(W,i,&wi);
32: /* v <- v - h_i v_i */
33: BV_SetValue(V,i,0,c,dot);
34: BVGetColumn(V,i,&vi);
35: VecAXPY(v,-dot,vi);
36: BVRestoreColumn(V,i,&vi);
37: }
38: BV_AddCoefficients(V,V->k,h,c);
39: return(0);
40: }
42: /*
43: BVBiorthogonalizeCGS1 - Compute one step of CGS bi-orthogonalization: v = (I-V*W')*v
44: */
45: static PetscErrorCode BVBiorthogonalizeCGS1(BV V,BV W,Vec v,PetscScalar *h,PetscScalar *c)
46: {
50: /* h = W'*v */
51: BVDotVec(W,v,c);
53: /* v = v - V h */
54: BVMultVec(V,-1.0,1.0,v,c);
56: BV_AddCoefficients(V,V->k,h,c);
57: return(0);
58: }
60: #define BVBiorthogonalizeGS1(a,b,c,d,e) ((V->orthog_type==BV_ORTHOG_MGS)?BVBiorthogonalizeMGS1:BVBiorthogonalizeCGS1)(a,b,c,d,e)
62: /*
63: BVBiorthogonalizeGS - Orthogonalize with (classical or modified) Gram-Schmidt
65: V, W - the two basis vectors objects
66: v - the vector to bi-orthogonalize
67: */
68: static PetscErrorCode BVBiorthogonalizeGS(BV V,BV W,Vec v)
69: {
71: PetscScalar *h,*c;
74: h = V->h;
75: c = V->c;
76: BV_CleanCoefficients(V,V->k,h);
77: BVBiorthogonalizeGS1(V,W,v,h,c);
78: if (V->orthog_ref!=BV_ORTHOG_REFINE_NEVER) {
79: BVBiorthogonalizeGS1(V,W,v,h,c);
80: }
81: return(0);
82: }
84: /*@
85: BVBiorthogonalizeColumn - Bi-orthogonalize a column of two BV objects.
87: Collective on V
89: Input Parameters:
90: + V,W - two basis vectors contexts
91: - j - index of column to be bi-orthonormalized
93: Notes:
94: This function bi-orthogonalizes vectors V[j],W[j] against W[0..j-1],
95: and V[0..j-1], respectively, so that W[0..j]'*V[0..j] = diagonal.
97: Level: advanced
99: .seealso: BVOrthogonalizeColumn(), BVBiorthonormalizeColumn()
100: @*/
101: PetscErrorCode BVBiorthogonalizeColumn(BV V,BV W,PetscInt j)
102: {
104: PetscInt ksavev,lsavev,ksavew,lsavew;
105: Vec y,z;
112: BVCheckSizes(V,1);
114: BVCheckSizes(W,2);
116: if (j<0) SETERRQ(PetscObjectComm((PetscObject)V),PETSC_ERR_ARG_OUTOFRANGE,"Index j must be non-negative");
117: if (j>=V->m) SETERRQ2(PetscObjectComm((PetscObject)V),PETSC_ERR_ARG_OUTOFRANGE,"Index j=%D but V only has %D columns",j,V->m);
118: if (j>=W->m) SETERRQ2(PetscObjectComm((PetscObject)V),PETSC_ERR_ARG_OUTOFRANGE,"Index j=%D but W only has %D columns",j,W->m);
119: if (V->n!=W->n) SETERRQ2(PetscObjectComm((PetscObject)V),PETSC_ERR_ARG_INCOMP,"Mismatching local dimension V %D, W %D",V->n,W->n);
120: if (V->matrix || W->matrix) SETERRQ(PetscObjectComm((PetscObject)V),PETSC_ERR_ARG_WRONGSTATE,"V,W must not have an inner product matrix");
121: if (V->nc || W->nc) SETERRQ(PetscObjectComm((PetscObject)V),PETSC_ERR_ARG_WRONGSTATE,"V,W cannot have different number of constraints");
122: if (V->ops->gramschmidt || W->ops->gramschmidt) SETERRQ(PetscObjectComm((PetscObject)V),PETSC_ERR_SUP,"Object has a special GS function");
124: /* bi-orthogonalize */
125: PetscLogEventBegin(BV_OrthogonalizeVec,V,0,0,0);
126: ksavev = V->k;
127: lsavev = V->l;
128: ksavew = W->k;
129: lsavew = W->l;
130: V->k = j;
131: V->l = -V->nc; /* must also bi-orthogonalize against constraints and leading columns */
132: W->k = j;
133: W->l = -W->nc;
134: BV_AllocateCoeffs(V);
135: BV_AllocateCoeffs(W);
136: BVGetColumn(V,j,&y);
137: BVBiorthogonalizeGS(V,W,y);
138: BVRestoreColumn(V,j,&y);
139: BVGetColumn(W,j,&z);
140: BVBiorthogonalizeGS(W,V,z);
141: BVRestoreColumn(W,j,&z);
142: V->k = ksavev;
143: V->l = lsavev;
144: W->k = ksavew;
145: W->l = lsavew;
146: PetscLogEventEnd(BV_OrthogonalizeVec,V,0,0,0);
147: PetscObjectStateIncrease((PetscObject)V);
148: PetscObjectStateIncrease((PetscObject)W);
149: return(0);
150: }
152: /*@
153: BVBiorthonormalizeColumn - Bi-orthonormalize a column of two BV objects.
155: Collective on V
157: Input Parameters:
158: + V,W - two basis vectors contexts
159: - j - index of column to be bi-orthonormalized
161: Output Parameters:
162: . delta - (optional) value used for normalization
164: Notes:
165: This function first bi-orthogonalizes vectors V[j],W[j] against W[0..j-1],
166: and V[0..j-1], respectively. Then, it scales the vectors with 1/delta, so
167: that the resulting vectors satisfy W[j]'*V[j] = 1.
169: Level: advanced
171: .seealso: BVOrthonormalizeColumn(), BVBiorthogonalizeColumn()
172: @*/
173: PetscErrorCode BVBiorthonormalizeColumn(BV V,BV W,PetscInt j,PetscReal *delta)
174: {
176: PetscScalar alpha;
177: PetscReal deltat;
178: PetscInt ksavev,lsavev,ksavew,lsavew;
179: Vec y,z;
186: BVCheckSizes(V,1);
188: BVCheckSizes(W,2);
190: if (j<0) SETERRQ(PetscObjectComm((PetscObject)V),PETSC_ERR_ARG_OUTOFRANGE,"Index j must be non-negative");
191: if (j>=V->m) SETERRQ2(PetscObjectComm((PetscObject)V),PETSC_ERR_ARG_OUTOFRANGE,"Index j=%D but V only has %D columns",j,V->m);
192: if (j>=W->m) SETERRQ2(PetscObjectComm((PetscObject)V),PETSC_ERR_ARG_OUTOFRANGE,"Index j=%D but W only has %D columns",j,W->m);
193: if (V->n!=W->n) SETERRQ2(PetscObjectComm((PetscObject)V),PETSC_ERR_ARG_INCOMP,"Mismatching local dimension V %D, W %D",V->n,W->n);
194: if (V->matrix || W->matrix) SETERRQ(PetscObjectComm((PetscObject)V),PETSC_ERR_ARG_WRONGSTATE,"V,W must not have an inner product matrix");
195: if (V->nc || W->nc) SETERRQ(PetscObjectComm((PetscObject)V),PETSC_ERR_ARG_WRONGSTATE,"V,W cannot have different number of constraints");
196: if (V->ops->gramschmidt || W->ops->gramschmidt) SETERRQ(PetscObjectComm((PetscObject)V),PETSC_ERR_SUP,"Object has a special GS function");
198: /* bi-orthogonalize */
199: PetscLogEventBegin(BV_OrthogonalizeVec,V,0,0,0);
200: ksavev = V->k;
201: lsavev = V->l;
202: ksavew = W->k;
203: lsavew = W->l;
204: V->k = j;
205: V->l = -V->nc; /* must also bi-orthogonalize against constraints and leading columns */
206: W->k = j;
207: W->l = -W->nc;
208: BV_AllocateCoeffs(V);
209: BV_AllocateCoeffs(W);
210: BVGetColumn(V,j,&y);
211: BVBiorthogonalizeGS(V,W,y);
212: BVRestoreColumn(V,j,&y);
213: BVGetColumn(W,j,&z);
214: BVBiorthogonalizeGS(W,V,z);
215: BVRestoreColumn(W,j,&z);
216: V->k = ksavev;
217: V->l = lsavev;
218: W->k = ksavew;
219: W->l = lsavew;
220: PetscLogEventEnd(BV_OrthogonalizeVec,V,0,0,0);
222: /* scale */
223: PetscLogEventBegin(BV_Scale,V,0,0,0);
224: BVGetColumn(V,j,&y);
225: BVGetColumn(W,j,&z);
226: VecDot(z,y,&alpha);
227: BVRestoreColumn(V,j,&y);
228: BVRestoreColumn(W,j,&z);
229: deltat = PetscSqrtReal(PetscAbsScalar(alpha));
230: if (V->n) { (*V->ops->scale)(V,j,1.0/PetscConj(alpha/deltat)); }
231: if (W->n) { (*W->ops->scale)(W,j,1.0/deltat); }
232: PetscLogEventEnd(BV_Scale,V,0,0,0);
233: if (delta) *delta = deltat;
234: PetscObjectStateIncrease((PetscObject)V);
235: PetscObjectStateIncrease((PetscObject)W);
236: return(0);
237: }