Actual source code: bvorthog.c

slepc-3.8.2 2017-12-01
Report Typos and Errors
  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 BV

393:    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 BV

450:    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 BV

519:    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 BV

606:    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 BV

817:    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(), BVOrthogBlockType
847: @*/
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: }