1: /*
2: - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
3: SLEPc - Scalable Library for Eigenvalue Problem Computations
4: Copyright (c) 2002-2017, 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> /*I "slepcbv.h" I*/
15: #include <slepcblaslapack.h>
17: /*
18: BV_CleanCoefficients_Default - Sets to zero all entries of column j of the bv buffer
19: */
20: PETSC_STATIC_INLINE PetscErrorCode BV_CleanCoefficients_Default(BV bv,PetscInt j,PetscScalar *h) 21: {
23: PetscScalar *hh=h,*a;
24: PetscInt i;
27: if (!h) {
28: VecGetArray(bv->buffer,&a);
29: hh = a + j*(bv->nc+bv->m);
30: }
31: for (i=0;i<bv->nc+j;i++) hh[i] = 0.0;
32: if (!h) { VecRestoreArray(bv->buffer,&a); }
33: return(0);
34: }
36: /*
37: BV_AddCoefficients_Default - Add the contents of the scratch (0-th column) of the bv buffer
38: into column j of the bv buffer
39: */
40: PETSC_STATIC_INLINE PetscErrorCode BV_AddCoefficients_Default(BV bv,PetscInt j,PetscScalar *h,PetscScalar *c) 41: {
43: PetscScalar *hh=h,*cc=c;
44: PetscInt i;
47: if (!h) {
48: VecGetArray(bv->buffer,&cc);
49: hh = cc + j*(bv->nc+bv->m);
50: }
51: for (i=0;i<bv->nc+j;i++) hh[i] += cc[i];
52: if (!h) { VecRestoreArray(bv->buffer,&cc); }
53: return(0);
54: }
56: /*
57: BV_SetValue_Default - Sets value in row j (counted after the constraints) of column k
58: of the coefficients array
59: */
60: PETSC_STATIC_INLINE PetscErrorCode BV_SetValue_Default(BV bv,PetscInt j,PetscInt k,PetscScalar *h,PetscScalar value) 61: {
63: PetscScalar *hh=h,*a;
66: if (!h) {
67: VecGetArray(bv->buffer,&a);
68: hh = a + k*(bv->nc+bv->m);
69: }
70: hh[bv->nc+j] = value;
71: if (!h) { VecRestoreArray(bv->buffer,&a); }
72: return(0);
73: }
75: /*
76: BV_SquareSum_Default - Returns the value h'*h, where h represents the contents of the
77: coefficients array (up to position j)
78: */
79: PETSC_STATIC_INLINE PetscErrorCode BV_SquareSum_Default(BV bv,PetscInt j,PetscScalar *h,PetscReal *sum) 80: {
82: PetscScalar *hh=h;
83: PetscInt i;
86: *sum = 0.0;
87: if (!h) { VecGetArray(bv->buffer,&hh); }
88: for (i=0;i<bv->nc+j;i++) *sum += PetscRealPart(hh[i]*PetscConj(hh[i]));
89: if (!h) { VecRestoreArray(bv->buffer,&hh); }
90: return(0);
91: }
93: /*
94: BV_ApplySignature_Default - Computes the pointwise product h*omega, where h represents
95: the contents of the coefficients array (up to position j) and omega is the signature;
96: if inverse=TRUE then the operation is h/omega
97: */
98: PETSC_STATIC_INLINE PetscErrorCode BV_ApplySignature_Default(BV bv,PetscInt j,PetscScalar *h,PetscBool inverse) 99: {
100: PetscErrorCode ierr;
101: PetscScalar *hh=h;
102: PetscInt i;
103: const PetscScalar *omega;
106: if (!(bv->nc+j)) return(0);
107: if (!h) { VecGetArray(bv->buffer,&hh); }
108: VecGetArrayRead(bv->omega,&omega);
109: if (inverse) for (i=0;i<bv->nc+j;i++) hh[i] /= PetscRealPart(omega[i]);
110: else for (i=0;i<bv->nc+j;i++) hh[i] *= PetscRealPart(omega[i]);
111: VecRestoreArrayRead(bv->omega,&omega);
112: if (!h) { VecRestoreArray(bv->buffer,&hh); }
113: return(0);
114: }
116: /*
117: BV_SquareRoot_Default - Returns the square root of position j (counted after the constraints)
118: of the coefficients array
119: */
120: PETSC_STATIC_INLINE PetscErrorCode BV_SquareRoot_Default(BV bv,PetscInt j,PetscScalar *h,PetscReal *beta)121: {
123: PetscScalar *hh=h;
126: if (!h) { VecGetArray(bv->buffer,&hh); }
127: BV_SafeSqrt(bv,hh[bv->nc+j],beta);
128: if (!h) { VecRestoreArray(bv->buffer,&hh); }
129: return(0);
130: }
132: /*
133: BV_StoreCoefficients_Default - Copy the contents of the coefficients array to an array dest
134: provided by the caller (only values from l to j are copied)
135: */
136: PETSC_STATIC_INLINE PetscErrorCode BV_StoreCoefficients_Default(BV bv,PetscInt j,PetscScalar *h,PetscScalar *dest)137: {
139: PetscScalar *hh=h,*a;
140: PetscInt i;
143: if (!h) {
144: VecGetArray(bv->buffer,&a);
145: hh = a + j*(bv->nc+bv->m);
146: }
147: for (i=bv->l;i<j;i++) dest[i-bv->l] = hh[bv->nc+i];
148: if (!h) { VecRestoreArray(bv->buffer,&a); }
149: return(0);
150: }
152: /*
153: BV_NormVecOrColumn - Compute the 2-norm of the working vector, irrespective of
154: whether it is in a column or not
155: */
156: PETSC_STATIC_INLINE PetscErrorCode BV_NormVecOrColumn(BV bv,PetscInt j,Vec v,PetscReal *nrm)157: {
161: if (v) { BVNormVec(bv,v,NORM_2,nrm); }
162: else { BVNormColumn(bv,j,NORM_2,nrm); }
163: return(0);
164: }
166: /*
167: BVDotColumnInc - Same as BVDotColumn() but also including column j, which
168: is multiplied by itself
169: */
170: PETSC_STATIC_INLINE PetscErrorCode BVDotColumnInc(BV X,PetscInt j,PetscScalar *q)171: {
173: PetscInt ksave;
174: Vec y;
177: PetscLogEventBegin(BV_DotVec,X,0,0,0);
178: ksave = X->k;
179: X->k = j+1;
180: BVGetColumn(X,j,&y);
181: (*X->ops->dotvec)(X,y,q);
182: BVRestoreColumn(X,j,&y);
183: X->k = ksave;
184: PetscLogEventEnd(BV_DotVec,X,0,0,0);
185: return(0);
186: }
189: #if defined(PETSC_HAVE_VECCUDA)
190: #define BV_CleanCoefficients(a,b,c) ((a)->cuda?BV_CleanCoefficients_CUDA:BV_CleanCoefficients_Default)((a),(b),(c))191: #define BV_AddCoefficients(a,b,c,d) ((a)->cuda?BV_AddCoefficients_CUDA:BV_AddCoefficients_Default)((a),(b),(c),(d))192: #define BV_SetValue(a,b,c,d,e) ((a)->cuda?BV_SetValue_CUDA:BV_SetValue_Default)((a),(b),(c),(d),(e))193: #define BV_SquareSum(a,b,c,d) ((a)->cuda?BV_SquareSum_CUDA:BV_SquareSum_Default)((a),(b),(c),(d))194: #define BV_ApplySignature(a,b,c,d) ((a)->cuda?BV_ApplySignature_CUDA:BV_ApplySignature_Default)((a),(b),(c),(d))195: #define BV_SquareRoot(a,b,c,d) ((a)->cuda?BV_SquareRoot_CUDA:BV_SquareRoot_Default)((a),(b),(c),(d))196: #define BV_StoreCoefficients(a,b,c,d) ((a)->cuda?BV_StoreCoefficients_CUDA:BV_StoreCoefficients_Default)((a),(b),(c),(d))197: #else
198: #define BV_CleanCoefficients(a,b,c) BV_CleanCoefficients_Default((a),(b),(c))199: #define BV_AddCoefficients(a,b,c,d) BV_AddCoefficients_Default((a),(b),(c),(d))200: #define BV_SetValue(a,b,c,d,e) BV_SetValue_Default((a),(b),(c),(d),(e))201: #define BV_SquareSum(a,b,c,d) BV_SquareSum_Default((a),(b),(c),(d))202: #define BV_ApplySignature(a,b,c,d) BV_ApplySignature_Default((a),(b),(c),(d))203: #define BV_SquareRoot(a,b,c,d) BV_SquareRoot_Default((a),(b),(c),(d))204: #define BV_StoreCoefficients(a,b,c,d) BV_StoreCoefficients_Default((a),(b),(c),(d))205: #endif /* PETSC_HAVE_VECCUDA */
207: /*
208: BVOrthogonalizeMGS1 - Compute one step of Modified Gram-Schmidt
209: */
210: static PetscErrorCode BVOrthogonalizeMGS1(BV bv,PetscInt j,Vec v,PetscBool *which,PetscScalar *h,PetscScalar *c,PetscReal *onrm,PetscReal *nrm)211: {
213: PetscInt i;
214: PetscScalar dot;
215: Vec vi,z,w=v;
216: const PetscScalar *omega;
219: if (!v) { BVGetColumn(bv,j,&w); }
220: if (onrm) { BVNormVec(bv,w,NORM_2,onrm); }
221: z = w;
222: if (bv->indef) {
223: VecGetArrayRead(bv->omega,&omega);
224: }
225: for (i=-bv->nc;i<j;i++) {
226: if (which && i>=0 && !which[i]) continue;
227: BVGetColumn(bv,i,&vi);
228: /* h_i = ( v, v_i ) */
229: if (bv->matrix) {
230: BV_IPMatMult(bv,w);
231: z = bv->Bx;
232: }
233: VecDot(z,vi,&dot);
234: /* v <- v - h_i v_i */
235: BV_SetValue(bv,i,0,c,dot);
236: if (bv->indef) dot /= PetscRealPart(omega[bv->nc+i]);
237: VecAXPY(w,-dot,vi);
238: BVRestoreColumn(bv,i,&vi);
239: }
240: if (nrm) { BVNormVec(bv,w,NORM_2,nrm); }
241: if (!v) { BVRestoreColumn(bv,j,&w); }
242: BV_AddCoefficients(bv,j,h,c);
243: if (bv->indef) {
244: VecRestoreArrayRead(bv->omega,&omega);
245: }
246: return(0);
247: }
249: /*
250: BVOrthogonalizeCGS1 - Compute |v'| (estimated), |v| and one step of CGS with
251: only one global synchronization
252: */
253: static PetscErrorCode BVOrthogonalizeCGS1(BV bv,PetscInt j,Vec v,PetscBool *which,PetscScalar *h,PetscScalar *c,PetscReal *onorm,PetscReal *norm)254: {
256: PetscReal sum,beta;
259: /* h = W^* v ; alpha = (v, v) */
260: bv->k = j;
261: if (onorm || norm) {
262: if (!v) {
263: BVDotColumnInc(bv,j,c);
264: BV_SquareRoot(bv,j,c,&beta);
265: } else {
266: BVDotVec(bv,v,c);
267: BVNormVec(bv,v,NORM_2,&beta);
268: }
269: } else {
270: if (!v) { BVDotColumn(bv,j,c); }
271: else { BVDotVec(bv,v,c); }
272: }
274: /* q = v - V h */
275: if (bv->indef) { BV_ApplySignature(bv,j,c,PETSC_TRUE); }
276: if (!v) { BVMultColumn(bv,-1.0,1.0,j,c); }
277: else { BVMultVec(bv,-1.0,1.0,v,c); }
278: if (bv->indef) { BV_ApplySignature(bv,j,c,PETSC_FALSE); }
280: /* compute |v| */
281: if (onorm) *onorm = beta;
283: if (norm) {
284: if (bv->indef) {
285: BV_NormVecOrColumn(bv,j,v,norm);
286: } else {
287: /* estimate |v'| from |v| */
288: BV_SquareSum(bv,j,c,&sum);
289: *norm = beta*beta-sum;
290: if (*norm <= 0.0) {
291: BV_NormVecOrColumn(bv,j,v,norm);
292: } else *norm = PetscSqrtReal(*norm);
293: }
294: }
295: BV_AddCoefficients(bv,j,h,c);
296: return(0);
297: }
299: #define BVOrthogonalizeGS1(a,b,c,d,e,f,g,h) (mgs?BVOrthogonalizeMGS1:BVOrthogonalizeCGS1)(a,b,c,d,e,f,g,h)301: /*
302: BVOrthogonalizeGS - Orthogonalize with (classical or modified) Gram-Schmidt
304: j - the index of the column to orthogonalize (cannot use both j and v)
305: v - the vector to orthogonalize (cannot use both j and v)
306: which - logical array indicating selected columns (only used in MGS)
307: norm - (optional) norm of the vector after being orthogonalized
308: lindep - (optional) flag indicating possible linear dependence
309: */
310: static PetscErrorCode BVOrthogonalizeGS(BV bv,PetscInt j,Vec v,PetscBool *which,PetscReal *norm,PetscBool *lindep)311: {
313: PetscScalar *h,*c,*omega;
314: PetscReal onrm,nrm;
315: PetscInt k,l;
316: PetscBool mgs,dolindep,signature;
319: if (v) {
320: k = bv->k;
321: h = bv->h;
322: c = bv->c;
323: } else {
324: k = j;
325: h = NULL;
326: c = NULL;
327: }
329: mgs = (bv->orthog_type==BV_ORTHOG_MGS)? PETSC_TRUE: PETSC_FALSE;
331: /* if indefinite inner product, skip the computation of lindep */
332: if (bv->indef && lindep) *lindep = PETSC_FALSE;
333: dolindep = (!bv->indef && lindep)? PETSC_TRUE: PETSC_FALSE;
335: /* if indefinite and we are orthogonalizing a column, the norm must always be computed */
336: signature = (bv->indef && !v)? PETSC_TRUE: PETSC_FALSE;
338: BV_CleanCoefficients(bv,k,h);
340: switch (bv->orthog_ref) {
342: case BV_ORTHOG_REFINE_IFNEEDED:
343: BVOrthogonalizeGS1(bv,k,v,which,h,c,&onrm,&nrm);
344: /* repeat if ||q|| < eta ||h|| */
345: l = 1;
346: while (l<3 && nrm && PetscAbsReal(nrm) < bv->orthog_eta*PetscAbsReal(onrm)) {
347: l++;
348: if (mgs||bv->indef) onrm = nrm;
349: BVOrthogonalizeGS1(bv,k,v,which,h,c,(mgs||bv->indef)?NULL:&onrm,&nrm);
350: }
351: /* linear dependence check: criterion not satisfied in the last iteration */
352: if (dolindep) *lindep = PetscNot(nrm && PetscAbsReal(nrm) >= bv->orthog_eta*PetscAbsReal(onrm));
353: break;
355: case BV_ORTHOG_REFINE_NEVER:
356: BVOrthogonalizeGS1(bv,k,v,which,h,c,NULL,NULL);
357: /* compute ||v|| */
358: if (norm || dolindep || signature) {
359: BV_NormVecOrColumn(bv,k,v,&nrm);
360: }
361: /* linear dependence check: just test for exactly zero norm */
362: if (dolindep) *lindep = PetscNot(nrm);
363: break;
365: case BV_ORTHOG_REFINE_ALWAYS:
366: BVOrthogonalizeGS1(bv,k,v,which,h,c,NULL,NULL);
367: BVOrthogonalizeGS1(bv,k,v,which,h,c,dolindep?&onrm:NULL,(norm||dolindep||signature)?&nrm:NULL);
368: /* linear dependence check: criterion not satisfied in the second iteration */
369: if (dolindep) *lindep = PetscNot(nrm && PetscAbsReal(nrm) >= bv->orthog_eta*PetscAbsReal(onrm));
370: break;
371: }
372: if (signature) {
373: VecGetArray(bv->omega,&omega);
374: omega[bv->nc+k] = (nrm<0.0)? -1.0: 1.0;
375: VecRestoreArray(bv->omega,&omega);
376: }
377: if (norm) {
378: *norm = nrm;
379: if (!v) { /* store norm value next to the orthogonalization coefficients */
380: if (dolindep && *lindep) { BV_SetValue(bv,k,k,h,0.0); }
381: else { BV_SetValue(bv,k,k,h,nrm); }
382: }
383: }
384: return(0);
385: }
387: /*@
388: BVOrthogonalizeVec - Orthogonalize a given vector with respect to all
389: active columns.
391: Collective on BV393: Input Parameters:
394: + bv - the basis vectors context
395: - v - the vector
397: Output Parameters:
398: + H - (optional) coefficients computed during orthogonalization
399: . norm - (optional) norm of the vector after being orthogonalized
400: - lindep - (optional) flag indicating that refinement did not improve the quality
401: of orthogonalization
403: Notes:
404: This function is equivalent to BVOrthogonalizeColumn() but orthogonalizes
405: a vector as an argument rather than taking one of the BV columns. The
406: vector is orthogonalized against all active columns (k) and the constraints.
407: If H is given, it must have enough space to store k-l coefficients, where l
408: is the number of leading columns.
410: In the case of an indefinite inner product, the lindep parameter is not
411: computed (set to false).
413: Level: advanced
415: .seealso: BVOrthogonalizeColumn(), BVSetOrthogonalization(), BVSetActiveColumns(), BVGetNumConstraints()
416: @*/
417: PetscErrorCode BVOrthogonalizeVec(BV bv,Vec v,PetscScalar *H,PetscReal *norm,PetscBool *lindep)418: {
420: PetscInt ksave,lsave;
426: BVCheckSizes(bv,1);
430: PetscLogEventBegin(BV_OrthogonalizeVec,bv,0,0,0);
431: ksave = bv->k;
432: lsave = bv->l;
433: bv->l = -bv->nc; /* must also orthogonalize against constraints and leading columns */
434: BV_AllocateCoeffs(bv);
435: BV_AllocateSignature(bv);
436: BVOrthogonalizeGS(bv,0,v,NULL,norm,lindep);
437: bv->k = ksave;
438: bv->l = lsave;
439: if (H) { BV_StoreCoefficients(bv,bv->k,bv->h,H); }
440: PetscLogEventEnd(BV_OrthogonalizeVec,bv,0,0,0);
441: return(0);
442: }
444: /*@
445: BVOrthogonalizeColumn - Orthogonalize one of the column vectors with respect to
446: the previous ones.
448: Collective on BV450: Input Parameters:
451: + bv - the basis vectors context
452: - j - index of column to be orthogonalized
454: Output Parameters:
455: + H - (optional) coefficients computed during orthogonalization
456: . norm - (optional) norm of the vector after being orthogonalized
457: - lindep - (optional) flag indicating that refinement did not improve the quality
458: of orthogonalization
460: Notes:
461: This function applies an orthogonal projector to project vector V[j] onto
462: the orthogonal complement of the span of the columns of V[0..j-1],
463: where V[.] are the vectors of BV. The columns V[0..j-1] are assumed to be
464: mutually orthonormal.
466: Leading columns V[0..l-1] also participate in the orthogonalization, as well
467: as the constraints. If H is given, it must have enough space to store
468: j-l+1 coefficients (the last coefficient will contain the value norm, unless
469: the norm argument is NULL).
471: If a non-standard inner product has been specified with BVSetMatrix(),
472: then the vector is B-orthogonalized, using the non-standard inner product
473: defined by matrix B. The output vector satisfies V[j]'*B*V[0..j-1] = 0.
475: This routine does not normalize the resulting vector, see BVOrthonormalizeColumn().
477: In the case of an indefinite inner product, the lindep parameter is not
478: computed (set to false).
480: Level: advanced
482: .seealso: BVSetOrthogonalization(), BVSetMatrix(), BVSetActiveColumns(), BVOrthogonalize(), BVOrthogonalizeVec(), BVGetNumConstraints(), BVOrthonormalizeColumn()
483: @*/
484: PetscErrorCode BVOrthogonalizeColumn(BV bv,PetscInt j,PetscScalar *H,PetscReal *norm,PetscBool *lindep)485: {
487: PetscInt ksave,lsave;
493: BVCheckSizes(bv,1);
494: if (j<0) SETERRQ(PetscObjectComm((PetscObject)bv),PETSC_ERR_ARG_OUTOFRANGE,"Index j must be non-negative");
495: if (j>=bv->m) SETERRQ2(PetscObjectComm((PetscObject)bv),PETSC_ERR_ARG_OUTOFRANGE,"Index j=%D but BV only has %D columns",j,bv->m);
497: PetscLogEventBegin(BV_OrthogonalizeVec,bv,0,0,0);
498: ksave = bv->k;
499: lsave = bv->l;
500: bv->l = -bv->nc; /* must also orthogonalize against constraints and leading columns */
501: if (!bv->buffer) { BVGetBufferVec(bv,&bv->buffer); }
502: BV_AllocateSignature(bv);
503: BVOrthogonalizeGS(bv,j,NULL,NULL,norm,lindep);
504: bv->k = ksave;
505: bv->l = lsave;
506: if (H) { BV_StoreCoefficients(bv,j,NULL,H); }
507: PetscLogEventEnd(BV_OrthogonalizeVec,bv,0,0,0);
508: PetscObjectStateIncrease((PetscObject)bv);
509: return(0);
510: }
512: /*@
513: BVOrthonormalizeColumn - Orthonormalize one of the column vectors with respect to
514: the previous ones. This is equivalent to a call to BVOrthogonalizeColumn()
515: followed by a call to BVScaleColumn() with the reciprocal of the norm.
517: Collective on BV519: Input Parameters:
520: + bv - the basis vectors context
521: . j - index of column to be orthonormalized
522: - replace - whether it is allowed to set the vector randomly
524: Output Parameters:
525: + norm - (optional) norm of the vector after orthogonalization and before normalization
526: - lindep - (optional) flag indicating that linear dependence was determined during
527: orthogonalization
529: Notes:
530: This function first orthogonalizes vector V[j] with respect to V[0..j-1],
531: where V[.] are the vectors of BV. A byproduct of this computation is norm,
532: the norm of the vector after orthogonalization. Secondly, it scales the
533: vector with 1/norm, so that the resulting vector has unit norm.
535: If after orthogonalization the vector V[j] is exactly zero, it cannot be normalized
536: because norm=0. In that case, it could be left as zero or replaced by a random
537: vector that is then orthonormalized. The latter is achieved by setting the
538: argument replace to TRUE. The vector will be replaced by a random vector also
539: if lindep was set to TRUE, even if the norm is not exaclty zero.
541: If the vector has been replaced by a random vector, the output arguments norm and
542: lindep will be set according to the orthogonalization of this new vector.
544: Level: advanced
546: .seealso: BVOrthogonalizeColumn(), BVScaleColumn()
547: @*/
548: PetscErrorCode BVOrthonormalizeColumn(BV bv,PetscInt j,PetscBool replace,PetscReal *norm,PetscBool *lindep)549: {
551: PetscScalar alpha;
552: PetscReal nrm;
553: PetscInt ksave,lsave;
554: PetscBool lndep;
560: BVCheckSizes(bv,1);
561: if (j<0) SETERRQ(PetscObjectComm((PetscObject)bv),PETSC_ERR_ARG_OUTOFRANGE,"Index j must be non-negative");
562: if (j>=bv->m) SETERRQ2(PetscObjectComm((PetscObject)bv),PETSC_ERR_ARG_OUTOFRANGE,"Index j=%D but BV only has %D columns",j,bv->m);
564: /* orthogonalize */
565: PetscLogEventBegin(BV_OrthogonalizeVec,bv,0,0,0);
566: ksave = bv->k;
567: lsave = bv->l;
568: bv->l = -bv->nc; /* must also orthogonalize against constraints and leading columns */
569: if (!bv->buffer) { BVGetBufferVec(bv,&bv->buffer); }
570: BV_AllocateSignature(bv);
571: BVOrthogonalizeGS(bv,j,NULL,NULL,&nrm,&lndep);
572: if (replace && (nrm==0.0 || lndep)) {
573: PetscInfo(bv,"Vector was linearly dependent, generating a new random vector\n");
574: BVSetRandomColumn(bv,j);
575: BVOrthogonalizeGS(bv,j,NULL,NULL,&nrm,&lndep);
576: if (nrm==0.0 || lndep) { /* yet another attempt */
577: BVSetRandomColumn(bv,j);
578: BVOrthogonalizeGS(bv,j,NULL,NULL,&nrm,&lndep);
579: }
580: }
581: bv->k = ksave;
582: bv->l = lsave;
583: PetscLogEventEnd(BV_OrthogonalizeVec,bv,0,0,0);
585: /* scale */
586: if (nrm!=1.0 && nrm!=0.0) {
587: alpha = 1.0/nrm;
588: PetscLogEventBegin(BV_Scale,bv,0,0,0);
589: if (bv->n) {
590: (*bv->ops->scale)(bv,j,alpha);
591: }
592: PetscLogEventEnd(BV_Scale,bv,0,0,0);
593: }
594: if (norm) *norm = nrm;
595: if (lindep) *lindep = lndep;
596: PetscObjectStateIncrease((PetscObject)bv);
597: return(0);
598: }
600: /*@
601: BVOrthogonalizeSomeColumn - Orthogonalize one of the column vectors with
602: respect to some of the previous ones.
604: Collective on BV606: Input Parameters:
607: + bv - the basis vectors context
608: . j - index of column to be orthogonalized
609: - which - logical array indicating selected columns
611: Output Parameters:
612: + H - (optional) coefficients computed during orthogonalization
613: . norm - (optional) norm of the vector after being orthogonalized
614: - lindep - (optional) flag indicating that refinement did not improve the quality
615: of orthogonalization
617: Notes:
618: This function is similar to BVOrthogonalizeColumn(), but V[j] is
619: orthogonalized only against columns V[i] having which[i]=PETSC_TRUE.
620: The length of array which must be j at least.
622: The use of this operation is restricted to MGS orthogonalization type.
624: In the case of an indefinite inner product, the lindep parameter is not
625: computed (set to false).
627: Level: advanced
629: .seealso: BVOrthogonalizeColumn(), BVSetOrthogonalization()
630: @*/
631: PetscErrorCode BVOrthogonalizeSomeColumn(BV bv,PetscInt j,PetscBool *which,PetscScalar *H,PetscReal *norm,PetscBool *lindep)632: {
634: PetscInt ksave,lsave;
641: BVCheckSizes(bv,1);
642: if (j<0) SETERRQ(PetscObjectComm((PetscObject)bv),PETSC_ERR_ARG_OUTOFRANGE,"Index j must be non-negative");
643: if (j>=bv->m) SETERRQ2(PetscObjectComm((PetscObject)bv),PETSC_ERR_ARG_OUTOFRANGE,"Index j=%D but BV only has %D columns",j,bv->m);
644: if (bv->orthog_type!=BV_ORTHOG_MGS) SETERRQ(PetscObjectComm((PetscObject)bv),PETSC_ERR_SUP,"Operation only available for MGS orthogonalization");
646: PetscLogEventBegin(BV_OrthogonalizeVec,bv,0,0,0);
647: ksave = bv->k;
648: lsave = bv->l;
649: bv->l = -bv->nc; /* must also orthogonalize against constraints and leading columns */
650: if (!bv->buffer) { BVGetBufferVec(bv,&bv->buffer); }
651: BV_AllocateSignature(bv);
652: BVOrthogonalizeGS(bv,j,NULL,which,norm,lindep);
653: bv->k = ksave;
654: bv->l = lsave;
655: if (H) { BV_StoreCoefficients(bv,j,NULL,H); }
656: PetscLogEventEnd(BV_OrthogonalizeVec,bv,0,0,0);
657: PetscObjectStateIncrease((PetscObject)bv);
658: return(0);
659: }
661: /*
662: Orthogonalize a set of vectors with Gram-Schmidt, column by column.
663: */
664: static PetscErrorCode BVOrthogonalize_GS(BV V,Mat R)665: {
667: PetscScalar *r=NULL;
668: PetscReal norm;
669: PetscInt j,ldr;
670: Vec v,w;
673: if (R) {
674: MatGetSize(R,&ldr,NULL);
675: MatDenseGetArray(R,&r);
676: }
677: if (V->matrix) {
678: BVGetCachedBV(V,&V->cached);
679: BVSetActiveColumns(V->cached,V->l,V->k);
680: }
681: for (j=V->l;j<V->k;j++) {
682: if (V->matrix && V->orthog_type==BV_ORTHOG_MGS) { /* fill cached BV */
683: BVGetColumn(V->cached,j,&v);
684: BVGetColumn(V,j,&w);
685: MatMult(V->matrix,w,v);
686: BVRestoreColumn(V,j,&w);
687: BVRestoreColumn(V->cached,j,&v);
688: }
689: if (R) {
690: BVOrthogonalizeColumn(V,j,r+j*ldr+V->l,&norm,NULL);
691: r[j+j*ldr] = norm;
692: } else {
693: BVOrthogonalizeColumn(V,j,NULL,&norm,NULL);
694: }
695: if (!norm) SETERRQ(PetscObjectComm((PetscObject)V),1,"Breakdown in BVOrthogonalize due to a linearly dependent column");
696: if (V->matrix && V->orthog_type==BV_ORTHOG_CGS) { /* fill cached BV */
697: BVGetColumn(V->cached,j,&v);
698: VecCopy(V->Bx,v);
699: BVRestoreColumn(V->cached,j,&v);
700: }
701: BVScaleColumn(V,j,1.0/norm);
702: }
703: if (R) { MatDenseRestoreArray(R,&r); }
704: return(0);
705: }
707: /*
708: Compute the upper Cholesky factor in R and its inverse in S.
709: */
710: static PetscErrorCode MatCholeskyFactorInvert(Mat R,PetscInt l,Mat *S)711: {
712: #if defined(PETSC_MISSING_LAPACK_POTRF) || defined(SLEPC_MISSING_LAPACK_TRTRI)
714: SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"POTRF/TRTRI - Lapack routine is unavailable");
715: #else
717: PetscInt i,n,m,ld;
718: PetscScalar *pR,*pS;
719: PetscBLASInt info,n_,l_,m_,ld_;
722: MatGetSize(R,&m,NULL);
723: n = m-l;
724: PetscBLASIntCast(m,&m_);
725: PetscBLASIntCast(l,&l_);
726: PetscBLASIntCast(n,&n_);
727: ld = m;
728: ld_ = m_;
729: MatCreateSeqDense(PETSC_COMM_SELF,ld,ld,NULL,S);
730: MatDenseGetArray(R,&pR);
731: MatDenseGetArray(*S,&pS);
733: /* save a copy of matrix in S */
734: for (i=l;i<m;i++) {
735: PetscMemcpy(pS+i*ld+l,pR+i*ld+l,n*sizeof(PetscScalar));
736: }
738: /* compute upper Cholesky factor in R */
739: PetscStackCallBLAS("LAPACKpotrf",LAPACKpotrf_("U",&n_,pR+l*ld+l,&ld_,&info));
740: PetscLogFlops((1.0*n*n*n)/3.0);
742: if (info) { /* LAPACKpotrf failed, retry on diagonally perturbed matrix */
743: for (i=l;i<m;i++) {
744: PetscMemcpy(pR+i*ld+l,pS+i*ld+l,n*sizeof(PetscScalar));
745: pR[i+i*ld] += 50.0*PETSC_MACHINE_EPSILON;
746: }
747: PetscStackCallBLAS("LAPACKpotrf",LAPACKpotrf_("U",&n_,pR+l*ld+l,&ld_,&info));
748: SlepcCheckLapackInfo("potrf",info);
749: PetscLogFlops((1.0*n*n*n)/3.0);
750: }
752: /* compute S = inv(R) */
753: PetscMemzero(pS,m*m*sizeof(PetscScalar));
754: for (i=l;i<m;i++) {
755: PetscMemcpy(pS+i*ld+l,pR+i*ld+l,n*sizeof(PetscScalar));
756: }
757: PetscStackCallBLAS("LAPACKtrtri",LAPACKtrtri_("U","N",&n_,pS+l*ld+l,&ld_,&info));
758: SlepcCheckLapackInfo("trtri",info);
759: PetscLogFlops(1.0*n*n*n);
761: /* Zero out entries below the diagonal */
762: for (i=l;i<m-1;i++) {
763: PetscMemzero(pR+i*ld+i+1,(m-i-1)*sizeof(PetscScalar));
764: PetscMemzero(pS+i*ld+i+1,(m-i-1)*sizeof(PetscScalar));
765: }
766: MatDenseRestoreArray(R,&pR);
767: MatDenseRestoreArray(*S,&pS);
768: return(0);
769: #endif
770: }
772: /*
773: Orthogonalize a set of vectors with Cholesky: R=chol(V'*V), Q=V*inv(R)
774: */
775: static PetscErrorCode BVOrthogonalize_Chol(BV V,Mat Rin)776: {
778: Mat S,R=Rin;
781: if (!Rin) {
782: MatCreateSeqDense(PETSC_COMM_SELF,V->k,V->k,NULL,&R);
783: }
784: BVDot(V,V,R);
785: MatCholeskyFactorInvert(R,V->l,&S);
786: BVMultInPlace(V,S,V->l,V->k);
787: MatDestroy(&S);
788: if (!Rin) {
789: MatDestroy(&R);
790: }
791: return(0);
792: }
794: /*
795: Orthogonalize a set of vectors with the Tall-Skinny QR method
796: */
797: static PetscErrorCode BVOrthogonalize_TSQR(BV V,Mat R)798: {
800: PetscScalar *pv,*r=NULL;
803: if (R) { MatDenseGetArray(R,&r); }
804: BVGetArray(V,&pv);
805: BVOrthogonalize_LAPACK_Private(V,V->n,V->k,pv+V->nc*V->n,r);
806: BVRestoreArray(V,&pv);
807: if (R) { MatDenseRestoreArray(R,&r); }
808: return(0);
809: }
811: /*@
812: BVOrthogonalize - Orthogonalize all columns (except leading ones), that is,
813: compute the QR decomposition.
815: Collective on BV817: Input Parameter:
818: . V - basis vectors
820: Output Parameters:
821: + V - the modified basis vectors
822: - R - a sequential dense matrix (or NULL)
824: Notes:
825: On input, matrix R must be a sequential dense Mat, with at least as many rows
826: and columns as the number of active columns of V. The output satisfies
827: V0 = V*R (where V0 represent the input V) and V'*V = I.
829: If V has leading columns, then they are not modified (are assumed to be already
830: orthonormal) and the corresponding part of R is not referenced.
832: Can pass NULL if R is not required.
834: The method to be used for block orthogonalization can be set with
835: BVSetOrthogonalization(). If set to GS, the computation is done column by
836: column with successive calls to BVOrthogonalizeColumn().
838: If V is rank-deficient or very ill-conditioned, that is, one or more columns are
839: (almost) linearly dependent with respect to the rest, then the algorithm may
840: break down or result in larger numerical error. Linearly dependent columns are
841: essentially replaced by random directions, and the corresponding diagonal entry
842: in R is set to (nearly) zero.
844: Level: intermediate
846: .seealso: BVOrthogonalizeColumn(), BVOrthogonalizeVec(), BVSetActiveColumns(), BVSetOrthogonalization(), BVOrthogBlockType847: @*/
848: PetscErrorCode BVOrthogonalize(BV V,Mat R)849: {
851: PetscBool match;
852: PetscInt m,n;
857: BVCheckSizes(V,1);
858: if (R) {
861: if (V->l>0 && V->orthog_block==BV_ORTHOG_BLOCK_GS) SETERRQ(PetscObjectComm((PetscObject)V),PETSC_ERR_SUP,"Cannot request matrix R in Gram-Schmidt orthogonalization if l>0");
862: PetscObjectTypeCompare((PetscObject)R,MATSEQDENSE,&match);
863: if (!match) SETERRQ(PetscObjectComm((PetscObject)V),PETSC_ERR_SUP,"Mat argument must be of type seqdense");
864: MatGetSize(R,&m,&n);
865: if (m!=n) SETERRQ2(PetscObjectComm((PetscObject)V),PETSC_ERR_ARG_SIZ,"Mat argument is not square, it has %D rows and %D columns",m,n);
866: if (n<V->k) SETERRQ2(PetscObjectComm((PetscObject)V),PETSC_ERR_ARG_SIZ,"Mat size %D is smaller than the number of BV active columns %D",n,V->k);
867: }
868: if (V->nc) SETERRQ(PetscObjectComm((PetscObject)V),PETSC_ERR_SUP,"Not implemented for BV with constraints, use BVOrthogonalizeColumn() instead");
870: PetscLogEventBegin(BV_Orthogonalize,V,R,0,0);
871: switch (V->orthog_block) {
872: case BV_ORTHOG_BLOCK_GS: /* proceed column by column with Gram-Schmidt */
873: BVOrthogonalize_GS(V,R);
874: break;
875: case BV_ORTHOG_BLOCK_CHOL:
876: BVOrthogonalize_Chol(V,R);
877: break;
878: case BV_ORTHOG_BLOCK_TSQR:
879: if (V->matrix) SETERRQ(PetscObjectComm((PetscObject)V),PETSC_ERR_SUP,"Orthogonalization method not available for non-standard inner product");
880: BVOrthogonalize_TSQR(V,R);
881: break;
882: }
883: PetscLogEventEnd(BV_Orthogonalize,V,R,0,0);
884: PetscObjectStateIncrease((PetscObject)V);
885: return(0);
886: }