1: /*
2: - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
3: SLEPc - Scalable Library for Eigenvalue Problem Computations
4: Copyright (c) 2002-, 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 orthogonalization routines
12: */
14: #include <slepc/private/bvimpl.h> 16: /*
17: BV_NormVecOrColumn - Compute the 2-norm of the working vector, irrespective of
18: whether it is in a column or not
19: */
20: static inline PetscErrorCode BV_NormVecOrColumn(BV bv,PetscInt j,Vec v,PetscReal *nrm) 21: {
22: if (v) BVNormVec(bv,v,NORM_2,nrm);
23: else BVNormColumn(bv,j,NORM_2,nrm);
24: PetscFunctionReturn(0);
25: }
27: /*
28: BVDotColumnInc - Same as BVDotColumn() but also including column j, which
29: is multiplied by itself
30: */
31: static inline PetscErrorCode BVDotColumnInc(BV X,PetscInt j,PetscScalar *q) 32: {
33: PetscInt ksave;
34: Vec y;
36: PetscLogEventBegin(BV_DotVec,X,0,0,0);
37: ksave = X->k;
38: X->k = j+1;
39: BVGetColumn(X,j,&y);
40: (*X->ops->dotvec)(X,y,q);
41: BVRestoreColumn(X,j,&y);
42: X->k = ksave;
43: PetscLogEventEnd(BV_DotVec,X,0,0,0);
44: PetscFunctionReturn(0);
45: }
47: /*
48: BVOrthogonalizeMGS1 - Compute one step of Modified Gram-Schmidt
49: */
50: static PetscErrorCode BVOrthogonalizeMGS1(BV bv,PetscInt j,Vec v,PetscBool *which,PetscScalar *h,PetscScalar *c,PetscReal *onrm,PetscReal *nrm) 51: {
52: PetscInt i;
53: PetscScalar dot;
54: PetscBool indef=bv->indef;
55: Vec vi,z,w=v;
56: const PetscScalar *omega;
58: if (!v) BVGetColumn(bv,j,&w);
59: if (onrm) BVNormVec(bv,w,NORM_2,onrm);
60: z = w;
61: if (indef) VecGetArrayRead(bv->omega,&omega);
62: for (i=-bv->nc;i<j;i++) {
63: if (which && i>=0 && !which[i]) continue;
64: BVGetColumn(bv,i,&vi);
65: /* h_i = (v, v_i) */
66: if (bv->matrix) {
67: BV_IPMatMult(bv,w);
68: z = bv->Bx;
69: }
70: VecDot(z,vi,&dot);
71: /* v <- v - h_i v_i */
72: BV_SetValue(bv,i,0,c,dot);
73: if (indef) dot /= PetscRealPart(omega[bv->nc+i]);
74: VecAXPY(w,-dot,vi);
75: BVRestoreColumn(bv,i,&vi);
76: }
77: if (nrm) BVNormVec(bv,w,NORM_2,nrm);
78: if (!v) BVRestoreColumn(bv,j,&w);
79: BV_AddCoefficients(bv,j,h,c);
80: if (indef) VecRestoreArrayRead(bv->omega,&omega);
81: PetscFunctionReturn(0);
82: }
84: /*
85: BVOrthogonalizeCGS1 - Compute |v'| (estimated), |v| and one step of CGS with
86: only one global synchronization
87: */
88: static PetscErrorCode BVOrthogonalizeCGS1(BV bv,PetscInt j,Vec v,PetscBool *which,PetscScalar *h,PetscScalar *c,PetscReal *onorm,PetscReal *norm) 89: {
90: PetscReal sum,beta;
92: /* h = W^* v ; alpha = (v, v) */
93: bv->k = j;
94: if (onorm || norm) {
95: if (!v) {
96: BVDotColumnInc(bv,j,c);
97: BV_SquareRoot(bv,j,c,&beta);
98: } else {
99: BVDotVec(bv,v,c);
100: BVNormVec(bv,v,NORM_2,&beta);
101: }
102: } else {
103: if (!v) BVDotColumn(bv,j,c);
104: else BVDotVec(bv,v,c);
105: }
107: /* q = v - V h */
108: if (PetscUnlikely(bv->indef)) BV_ApplySignature(bv,j,c,PETSC_TRUE);
109: if (!v) BVMultColumn(bv,-1.0,1.0,j,c);
110: else BVMultVec(bv,-1.0,1.0,v,c);
111: if (PetscUnlikely(bv->indef)) BV_ApplySignature(bv,j,c,PETSC_FALSE);
113: /* compute |v| */
114: if (onorm) *onorm = beta;
116: if (norm) {
117: if (PetscUnlikely(bv->indef)) BV_NormVecOrColumn(bv,j,v,norm);
118: else {
119: /* estimate |v'| from |v| */
120: BV_SquareSum(bv,j,c,&sum);
121: *norm = beta*beta-sum;
122: if (PetscUnlikely(*norm <= 0.0)) BV_NormVecOrColumn(bv,j,v,norm);
123: else *norm = PetscSqrtReal(*norm);
124: }
125: }
126: BV_AddCoefficients(bv,j,h,c);
127: PetscFunctionReturn(0);
128: }
130: #define BVOrthogonalizeGS1(a,b,c,d,e,f,g,h) ((bv->ops->gramschmidt)?(*bv->ops->gramschmidt):(mgs?BVOrthogonalizeMGS1:BVOrthogonalizeCGS1))(a,b,c,d,e,f,g,h)132: /*
133: BVOrthogonalizeGS - Orthogonalize with (classical or modified) Gram-Schmidt
135: j - the index of the column to orthogonalize (cannot use both j and v)
136: v - the vector to orthogonalize (cannot use both j and v)
137: which - logical array indicating selected columns (only used in MGS)
138: norm - (optional) norm of the vector after being orthogonalized
139: lindep - (optional) flag indicating possible linear dependence
140: */
141: static PetscErrorCode BVOrthogonalizeGS(BV bv,PetscInt j,Vec v,PetscBool *which,PetscReal *norm,PetscBool *lindep)142: {
143: PetscScalar *h,*c,*omega;
144: PetscReal onrm,nrm;
145: PetscInt k,l;
146: PetscBool mgs,dolindep,signature;
148: if (v) {
149: k = bv->k;
150: h = bv->h;
151: c = bv->c;
152: } else {
153: k = j;
154: h = NULL;
155: c = NULL;
156: }
158: mgs = (bv->orthog_type==BV_ORTHOG_MGS)? PETSC_TRUE: PETSC_FALSE;
160: /* if indefinite inner product, skip the computation of lindep */
161: if (bv->indef && lindep) *lindep = PETSC_FALSE;
162: dolindep = (!bv->indef && lindep)? PETSC_TRUE: PETSC_FALSE;
164: /* if indefinite and we are orthogonalizing a column, the norm must always be computed */
165: signature = (bv->indef && !v)? PETSC_TRUE: PETSC_FALSE;
167: BV_CleanCoefficients(bv,k,h);
169: switch (bv->orthog_ref) {
171: case BV_ORTHOG_REFINE_IFNEEDED:
172: BVOrthogonalizeGS1(bv,k,v,which,h,c,&onrm,&nrm);
173: /* repeat if ||q|| < eta ||h|| */
174: l = 1;
175: while (l<3 && nrm && PetscAbsReal(nrm) < bv->orthog_eta*PetscAbsReal(onrm)) {
176: l++;
177: if (mgs||bv->indef) onrm = nrm;
178: BVOrthogonalizeGS1(bv,k,v,which,h,c,(mgs||bv->indef)?NULL:&onrm,&nrm);
179: }
180: /* linear dependence check: criterion not satisfied in the last iteration */
181: if (dolindep) *lindep = PetscNot(nrm && PetscAbsReal(nrm) >= bv->orthog_eta*PetscAbsReal(onrm));
182: break;
184: case BV_ORTHOG_REFINE_NEVER:
185: BVOrthogonalizeGS1(bv,k,v,which,h,c,NULL,NULL);
186: /* compute ||v|| */
187: if (norm || dolindep || signature) BV_NormVecOrColumn(bv,k,v,&nrm);
188: /* linear dependence check: just test for exactly zero norm */
189: if (dolindep) *lindep = PetscNot(nrm);
190: break;
192: case BV_ORTHOG_REFINE_ALWAYS:
193: BVOrthogonalizeGS1(bv,k,v,which,h,c,NULL,NULL);
194: BVOrthogonalizeGS1(bv,k,v,which,h,c,dolindep?&onrm:NULL,(norm||dolindep||signature)?&nrm:NULL);
195: /* linear dependence check: criterion not satisfied in the second iteration */
196: if (dolindep) *lindep = PetscNot(nrm && PetscAbsReal(nrm) >= bv->orthog_eta*PetscAbsReal(onrm));
197: break;
198: }
199: if (signature) {
200: VecGetArray(bv->omega,&omega);
201: omega[bv->nc+k] = (nrm<0.0)? -1.0: 1.0;
202: VecRestoreArray(bv->omega,&omega);
203: }
204: if (norm) {
205: *norm = nrm;
206: if (!v) { /* store norm value next to the orthogonalization coefficients */
207: if (dolindep && *lindep) BV_SetValue(bv,k,k,h,0.0);
208: else BV_SetValue(bv,k,k,h,nrm);
209: }
210: }
211: PetscFunctionReturn(0);
212: }
214: /*@
215: BVOrthogonalizeVec - Orthogonalize a given vector with respect to all
216: active columns.
218: Collective on bv
220: Input Parameters:
221: + bv - the basis vectors context
222: - v - the vector
224: Output Parameters:
225: + H - (optional) coefficients computed during orthogonalization
226: . norm - (optional) norm of the vector after being orthogonalized
227: - lindep - (optional) flag indicating that refinement did not improve the quality
228: of orthogonalization
230: Notes:
231: This function is equivalent to BVOrthogonalizeColumn() but orthogonalizes
232: a vector as an argument rather than taking one of the BV columns. The
233: vector is orthogonalized against all active columns (k) and the constraints.
234: If H is given, it must have enough space to store k-l coefficients, where l
235: is the number of leading columns.
237: In the case of an indefinite inner product, the lindep parameter is not
238: computed (set to false).
240: Level: advanced
242: .seealso: BVOrthogonalizeColumn(), BVSetOrthogonalization(), BVSetActiveColumns(), BVGetNumConstraints()
243: @*/
244: PetscErrorCode BVOrthogonalizeVec(BV bv,Vec v,PetscScalar *H,PetscReal *norm,PetscBool *lindep)245: {
246: PetscInt ksave,lsave;
251: BVCheckSizes(bv,1);
255: PetscLogEventBegin(BV_OrthogonalizeVec,bv,0,0,0);
256: ksave = bv->k;
257: lsave = bv->l;
258: bv->l = -bv->nc; /* must also orthogonalize against constraints and leading columns */
259: BV_AllocateCoeffs(bv);
260: BV_AllocateSignature(bv);
261: BVOrthogonalizeGS(bv,0,v,NULL,norm,lindep);
262: bv->k = ksave;
263: bv->l = lsave;
264: if (H) BV_StoreCoefficients(bv,bv->k,bv->h,H);
265: PetscLogEventEnd(BV_OrthogonalizeVec,bv,0,0,0);
266: PetscFunctionReturn(0);
267: }
269: /*@
270: BVOrthogonalizeColumn - Orthogonalize one of the column vectors with respect to
271: the previous ones.
273: Collective on bv
275: Input Parameters:
276: + bv - the basis vectors context
277: - j - index of column to be orthogonalized
279: Output Parameters:
280: + H - (optional) coefficients computed during orthogonalization
281: . norm - (optional) norm of the vector after being orthogonalized
282: - lindep - (optional) flag indicating that refinement did not improve the quality
283: of orthogonalization
285: Notes:
286: This function applies an orthogonal projector to project vector V[j] onto
287: the orthogonal complement of the span of the columns V[0..j-1],
288: where V[.] are the vectors of BV. The columns V[0..j-1] are assumed to be
289: mutually orthonormal.
291: Leading columns V[0..l-1] also participate in the orthogonalization, as well
292: as the constraints. If H is given, it must have enough space to store
293: j-l+1 coefficients (the last coefficient will contain the value norm, unless
294: the norm argument is NULL).
296: If a non-standard inner product has been specified with BVSetMatrix(),
297: then the vector is B-orthogonalized, using the non-standard inner product
298: defined by matrix B. The output vector satisfies V[j]'*B*V[0..j-1] = 0.
300: This routine does not normalize the resulting vector, see BVOrthonormalizeColumn().
302: In the case of an indefinite inner product, the lindep parameter is not
303: computed (set to false).
305: Level: advanced
307: .seealso: BVSetOrthogonalization(), BVSetMatrix(), BVSetActiveColumns(), BVOrthogonalize(), BVOrthogonalizeVec(), BVGetNumConstraints(), BVOrthonormalizeColumn()
308: @*/
309: PetscErrorCode BVOrthogonalizeColumn(BV bv,PetscInt j,PetscScalar *H,PetscReal *norm,PetscBool *lindep)310: {
311: PetscInt ksave,lsave;
316: BVCheckSizes(bv,1);
320: PetscLogEventBegin(BV_OrthogonalizeVec,bv,0,0,0);
321: ksave = bv->k;
322: lsave = bv->l;
323: bv->l = -bv->nc; /* must also orthogonalize against constraints and leading columns */
324: if (!bv->buffer) BVGetBufferVec(bv,&bv->buffer);
325: BV_AllocateSignature(bv);
326: BVOrthogonalizeGS(bv,j,NULL,NULL,norm,lindep);
327: bv->k = ksave;
328: bv->l = lsave;
329: if (H) BV_StoreCoefficients(bv,j,NULL,H);
330: PetscLogEventEnd(BV_OrthogonalizeVec,bv,0,0,0);
331: PetscObjectStateIncrease((PetscObject)bv);
332: PetscFunctionReturn(0);
333: }
335: /*@
336: BVOrthonormalizeColumn - Orthonormalize one of the column vectors with respect to
337: the previous ones.
339: Collective on bv
341: Input Parameters:
342: + bv - the basis vectors context
343: . j - index of column to be orthonormalized
344: - replace - whether it is allowed to set the vector randomly
346: Output Parameters:
347: + norm - (optional) norm of the vector after orthogonalization and before normalization
348: - lindep - (optional) flag indicating that linear dependence was determined during
349: orthogonalization
351: Notes:
352: This is equivalent to a call to BVOrthogonalizeColumn() followed by a
353: call to BVScaleColumn() with the reciprocal of the norm.
355: This function first orthogonalizes vector V[j] with respect to V[0..j-1],
356: where V[.] are the vectors of BV. A byproduct of this computation is norm,
357: the norm of the vector after orthogonalization. Secondly, it scales the
358: vector with 1/norm, so that the resulting vector has unit norm.
360: If after orthogonalization the vector V[j] is exactly zero, it cannot be normalized
361: because norm=0. In that case, it could be left as zero or replaced by a random
362: vector that is then orthonormalized. The latter is achieved by setting the
363: argument replace to TRUE. The vector will be replaced by a random vector also
364: if lindep was set to TRUE, even if the norm is not exactly zero.
366: If the vector has been replaced by a random vector, the output arguments norm and
367: lindep will be set according to the orthogonalization of this new vector.
369: Level: advanced
371: .seealso: BVOrthogonalizeColumn(), BVScaleColumn()
372: @*/
373: PetscErrorCode BVOrthonormalizeColumn(BV bv,PetscInt j,PetscBool replace,PetscReal *norm,PetscBool *lindep)374: {
375: PetscScalar alpha;
376: PetscReal nrm;
377: PetscInt ksave,lsave;
378: PetscBool lndep;
383: BVCheckSizes(bv,1);
387: /* orthogonalize */
388: PetscLogEventBegin(BV_OrthogonalizeVec,bv,0,0,0);
389: ksave = bv->k;
390: lsave = bv->l;
391: bv->l = -bv->nc; /* must also orthogonalize against constraints and leading columns */
392: if (!bv->buffer) BVGetBufferVec(bv,&bv->buffer);
393: BV_AllocateSignature(bv);
394: BVOrthogonalizeGS(bv,j,NULL,NULL,&nrm,&lndep);
395: if (replace && (nrm==0.0 || lndep)) {
396: PetscInfo(bv,"Vector was linearly dependent, generating a new random vector\n");
397: BVSetRandomColumn(bv,j);
398: BVOrthogonalizeGS(bv,j,NULL,NULL,&nrm,&lndep);
399: if (nrm==0.0 || lndep) { /* yet another attempt */
400: BVSetRandomColumn(bv,j);
401: BVOrthogonalizeGS(bv,j,NULL,NULL,&nrm,&lndep);
402: }
403: }
404: bv->k = ksave;
405: bv->l = lsave;
406: PetscLogEventEnd(BV_OrthogonalizeVec,bv,0,0,0);
408: /* scale */
409: if (nrm!=1.0 && nrm!=0.0) {
410: alpha = 1.0/nrm;
411: PetscLogEventBegin(BV_Scale,bv,0,0,0);
412: if (bv->n) (*bv->ops->scale)(bv,j,alpha);
413: PetscLogEventEnd(BV_Scale,bv,0,0,0);
414: }
415: if (norm) *norm = nrm;
416: if (lindep) *lindep = lndep;
417: PetscObjectStateIncrease((PetscObject)bv);
418: PetscFunctionReturn(0);
419: }
421: /*@
422: BVOrthogonalizeSomeColumn - Orthogonalize one of the column vectors with
423: respect to some of the previous ones.
425: Collective on bv
427: Input Parameters:
428: + bv - the basis vectors context
429: . j - index of column to be orthogonalized
430: - which - logical array indicating selected columns
432: Output Parameters:
433: + H - (optional) coefficients computed during orthogonalization
434: . norm - (optional) norm of the vector after being orthogonalized
435: - lindep - (optional) flag indicating that refinement did not improve the quality
436: of orthogonalization
438: Notes:
439: This function is similar to BVOrthogonalizeColumn(), but V[j] is
440: orthogonalized only against columns V[i] having which[i]=PETSC_TRUE.
441: The length of array which must be j at least.
443: The use of this operation is restricted to MGS orthogonalization type.
445: In the case of an indefinite inner product, the lindep parameter is not
446: computed (set to false).
448: Level: advanced
450: .seealso: BVOrthogonalizeColumn(), BVSetOrthogonalization()
451: @*/
452: PetscErrorCode BVOrthogonalizeSomeColumn(BV bv,PetscInt j,PetscBool *which,PetscScalar *H,PetscReal *norm,PetscBool *lindep)453: {
454: PetscInt ksave,lsave;
460: BVCheckSizes(bv,1);
465: PetscLogEventBegin(BV_OrthogonalizeVec,bv,0,0,0);
466: ksave = bv->k;
467: lsave = bv->l;
468: bv->l = -bv->nc; /* must also orthogonalize against constraints and leading columns */
469: if (!bv->buffer) BVGetBufferVec(bv,&bv->buffer);
470: BV_AllocateSignature(bv);
471: BVOrthogonalizeGS(bv,j,NULL,which,norm,lindep);
472: bv->k = ksave;
473: bv->l = lsave;
474: if (H) BV_StoreCoefficients(bv,j,NULL,H);
475: PetscLogEventEnd(BV_OrthogonalizeVec,bv,0,0,0);
476: PetscObjectStateIncrease((PetscObject)bv);
477: PetscFunctionReturn(0);
478: }
480: /*
481: Block Gram-Schmidt: V2 = V2 - V1*R12, where R12 = V1'*V2
482: */
483: static PetscErrorCode BVOrthogonalize_BlockGS(BV V,Mat R)484: {
485: BV V1;
487: BVGetSplit(V,&V1,NULL);
488: BVDot(V,V1,R);
489: BVMult(V,-1.0,1.0,V1,R);
490: BVRestoreSplit(V,&V1,NULL);
491: PetscFunctionReturn(0);
492: }
494: /*
495: Orthogonalize a set of vectors with Gram-Schmidt, column by column.
496: */
497: static PetscErrorCode BVOrthogonalize_GS(BV V,Mat R)498: {
499: PetscScalar *r=NULL;
500: PetscReal norm;
501: PetscInt j,ldr,lsave;
502: Vec v,w;
504: if (R) {
505: MatGetSize(R,&ldr,NULL);
506: MatDenseGetArray(R,&r);
507: }
508: if (V->matrix) {
509: BVGetCachedBV(V,&V->cached);
510: BVSetActiveColumns(V->cached,V->l,V->k);
511: }
512: for (j=V->l;j<V->k;j++) {
513: if (V->matrix && V->orthog_type==BV_ORTHOG_MGS) { /* fill cached BV */
514: BVGetColumn(V->cached,j,&v);
515: BVGetColumn(V,j,&w);
516: MatMult(V->matrix,w,v);
517: BVRestoreColumn(V,j,&w);
518: BVRestoreColumn(V->cached,j,&v);
519: }
520: if (R) {
521: BVOrthogonalizeColumn(V,j,NULL,&norm,NULL);
522: lsave = V->l;
523: V->l = -V->nc;
524: BV_StoreCoefficients(V,j,NULL,r+j*ldr);
525: V->l = lsave;
526: r[j+j*ldr] = norm;
527: } else BVOrthogonalizeColumn(V,j,NULL,&norm,NULL);
529: if (V->matrix && V->orthog_type==BV_ORTHOG_CGS) { /* fill cached BV */
530: BVGetColumn(V->cached,j,&v);
531: VecCopy(V->Bx,v);
532: BVRestoreColumn(V->cached,j,&v);
533: }
534: BVScaleColumn(V,j,1.0/norm);
535: }
536: if (R) MatDenseRestoreArray(R,&r);
537: PetscFunctionReturn(0);
538: }
540: /*
541: BV_GetBufferMat - Create auxiliary seqdense matrix that wraps the bv->buffer.
542: */
543: static inline PetscErrorCode BV_GetBufferMat(BV bv)544: {
545: PetscInt ld;
546: PetscScalar *array;
548: if (!bv->Abuffer) {
549: if (!bv->buffer) BVGetBufferVec(bv,&bv->buffer);
550: ld = bv->m+bv->nc;
551: VecGetArray(bv->buffer,&array);
552: MatCreateSeqDense(PETSC_COMM_SELF,ld,bv->m,array,&bv->Abuffer);
553: VecRestoreArray(bv->buffer,&array);
554: PetscLogObjectParent((PetscObject)bv,(PetscObject)bv->Abuffer);
555: }
556: PetscFunctionReturn(0);
557: }
559: /*
560: BV_StoreCoeffsBlock_Default - Copy the contents of the BV buffer to a dense Mat
561: provided by the caller. Only columns l:k-1 are copied, restricting to the upper
562: triangular part if tri=PETSC_TRUE.
563: */
564: static inline PetscErrorCode BV_StoreCoeffsBlock_Default(BV bv,Mat R,PetscBool tri)565: {
566: const PetscScalar *bb;
567: PetscScalar *rr;
568: PetscInt j,ldr,ldb;
570: MatGetSize(R,&ldr,NULL);
571: MatDenseGetArray(R,&rr);
572: ldb = bv->m+bv->nc;
573: VecGetArrayRead(bv->buffer,&bb);
574: for (j=bv->l;j<bv->k;j++) PetscArraycpy(rr+j*ldr,bb+j*ldb,(tri?(j+1):bv->k)+bv->nc);
575: VecRestoreArrayRead(bv->buffer,&bb);
576: MatDenseRestoreArray(R,&rr);
577: PetscFunctionReturn(0);
578: }
580: /*
581: Orthogonalize a set of vectors with Cholesky: R=chol(V'*V), Q=V*inv(R)
582: */
583: static PetscErrorCode BVOrthogonalize_Chol(BV V,Mat Rin)584: {
585: Mat R,S;
587: BV_GetBufferMat(V);
588: R = V->Abuffer;
589: if (Rin) S = Rin; /* use Rin as a workspace for S */
590: else S = R;
591: if (V->l) BVOrthogonalize_BlockGS(V,R);
592: BVDot(V,V,R);
593: BVMatCholInv_LAPACK_Private(V,R,S);
594: BVMultInPlace(V,S,V->l,V->k);
595: if (Rin) BV_StoreCoeffsBlock_Default(V,Rin,PETSC_TRUE);
596: PetscFunctionReturn(0);
597: }
599: /*
600: Orthogonalize a set of vectors with the Tall-Skinny QR method
601: */
602: static PetscErrorCode BVOrthogonalize_TSQR(BV V,Mat Rin)603: {
604: PetscScalar *pv,*r=NULL;
605: PetscInt ldr;
606: Mat R;
608: BV_GetBufferMat(V);
609: R = V->Abuffer;
610: if (V->l) BVOrthogonalize_BlockGS(V,R);
611: MatGetSize(R,&ldr,NULL);
612: MatDenseGetArray(R,&r);
613: BVGetArray(V,&pv);
614: BVOrthogonalize_LAPACK_TSQR(V,V->n,V->k-V->l,pv+(V->nc+V->l)*V->n,r+V->l*ldr+V->l,ldr);
615: BVRestoreArray(V,&pv);
616: MatDenseRestoreArray(R,&r);
617: if (Rin) BV_StoreCoeffsBlock_Default(V,Rin,PETSC_TRUE);
618: PetscFunctionReturn(0);
619: }
621: /*
622: Orthogonalize a set of vectors with TSQR, but computing R only, then doing Q=V*inv(R)
623: */
624: static PetscErrorCode BVOrthogonalize_TSQRCHOL(BV V,Mat Rin)625: {
626: PetscScalar *pv,*r=NULL;
627: PetscInt ldr;
628: Mat R,S;
630: BV_GetBufferMat(V);
631: R = V->Abuffer;
632: if (Rin) S = Rin; /* use Rin as a workspace for S */
633: else S = R;
634: if (V->l) BVOrthogonalize_BlockGS(V,R);
635: MatGetSize(R,&ldr,NULL);
636: MatDenseGetArray(R,&r);
637: BVGetArray(V,&pv);
638: BVOrthogonalize_LAPACK_TSQR_OnlyR(V,V->n,V->k-V->l,pv+(V->nc+V->l)*V->n,r+V->l*ldr+V->l,ldr);
639: BVRestoreArray(V,&pv);
640: MatDenseRestoreArray(R,&r);
641: BVMatTriInv_LAPACK_Private(V,R,S);
642: BVMultInPlace(V,S,V->l,V->k);
643: if (Rin) BV_StoreCoeffsBlock_Default(V,Rin,PETSC_TRUE);
644: PetscFunctionReturn(0);
645: }
647: /*
648: Orthogonalize a set of vectors with SVQB
649: */
650: static PetscErrorCode BVOrthogonalize_SVQB(BV V,Mat Rin)651: {
652: Mat R,S;
654: BV_GetBufferMat(V);
655: R = V->Abuffer;
656: if (Rin) S = Rin; /* use Rin as a workspace for S */
657: else S = R;
658: if (V->l) BVOrthogonalize_BlockGS(V,R);
659: BVDot(V,V,R);
660: BVMatSVQB_LAPACK_Private(V,R,S);
661: BVMultInPlace(V,S,V->l,V->k);
662: if (Rin) BV_StoreCoeffsBlock_Default(V,Rin,PETSC_FALSE);
663: PetscFunctionReturn(0);
664: }
666: /*@
667: BVOrthogonalize - Orthogonalize all columns (starting from the leading ones),
668: that is, compute the QR decomposition.
670: Collective on V
672: Input Parameters:
673: + V - basis vectors to be orthogonalized (or B-orthogonalized), modified on output
674: - R - a sequential dense matrix (or NULL), on output the triangular factor of
675: the QR decomposition
677: Notes:
678: On input, matrix R must be a square sequential dense Mat, with at least as many
679: rows and columns as the number of active columns of V. The output satisfies
680: V0 = V*R (where V0 represent the input V) and V'*V = I (or V'*B*V = I if an
681: inner product matrix B has been specified with BVSetMatrix()).
683: If V has leading columns, then they are not modified (are assumed to be already
684: orthonormal) and the leading columns of R are not referenced. Let the
685: decomposition be
686: .vb
687: [ V01 V02 ] = [ V1 V2 ] [ R11 R12 ]
688: [ 0 R22 ]
689: .ve
690: then V1 is left unchanged (equal to V01) as well as R11 (it should satisfy
691: V01 = V1*R11).
693: Can pass NULL if R is not required.
695: The method to be used for block orthogonalization can be set with
696: BVSetOrthogonalization(). If set to GS, the computation is done column by
697: column with successive calls to BVOrthogonalizeColumn(). Note that in the
698: SVQB method the R factor is not upper triangular.
700: If V is rank-deficient or very ill-conditioned, that is, one or more columns are
701: (almost) linearly dependent with respect to the rest, then the algorithm may
702: break down or result in larger numerical error. Linearly dependent columns are
703: essentially replaced by random directions, and the corresponding diagonal entry
704: in R is set to (nearly) zero.
706: Level: intermediate
708: .seealso: BVOrthogonalizeColumn(), BVOrthogonalizeVec(), BVSetMatrix(), BVSetActiveColumns(), BVSetOrthogonalization(), BVOrthogBlockType709: @*/
710: PetscErrorCode BVOrthogonalize(BV V,Mat R)711: {
712: PetscInt m,n;
716: BVCheckSizes(V,1);
717: if (R) {
721: MatGetSize(R,&m,&n);
724: }
727: PetscLogEventBegin(BV_Orthogonalize,V,R,0,0);
728: switch (V->orthog_block) {
729: case BV_ORTHOG_BLOCK_GS: /* proceed column by column with Gram-Schmidt */
730: BVOrthogonalize_GS(V,R);
731: break;
732: case BV_ORTHOG_BLOCK_CHOL:
733: BVOrthogonalize_Chol(V,R);
734: break;
735: case BV_ORTHOG_BLOCK_TSQR:
737: BVOrthogonalize_TSQR(V,R);
738: break;
739: case BV_ORTHOG_BLOCK_TSQRCHOL:
741: BVOrthogonalize_TSQRCHOL(V,R);
742: break;
743: case BV_ORTHOG_BLOCK_SVQB:
744: BVOrthogonalize_SVQB(V,R);
745: break;
746: }
747: PetscLogEventEnd(BV_Orthogonalize,V,R,0,0);
748: PetscObjectStateIncrease((PetscObject)V);
749: PetscFunctionReturn(0);
750: }