Date: 2023-01-26T12:18:12+00:00

Actual source code: bvorthog.c
slepc-3.18.2 2023-01-26
Report Typos and Errors

      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:   return 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:   PetscUseTypeMethod(X,dotvec,y,q);
     41:   BVRestoreColumn(X,j,&y);
     42:   X->k = ksave;
     43:   PetscLogEventEnd(BV_DotVec,X,0,0,0);
     44:   return 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:   return 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:   return 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:   return 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:   return 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:   return 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) PetscUseTypeMethod(bv,scale,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:   return 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:   return 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:   return 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:     MatDenseGetLDA(R,&ldr);
    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:   return 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:   }
    555:   return 0;
    556: }

    558: /*
    559:    BV_StoreCoeffsBlock_Default - Copy the contents of the BV buffer to a dense Mat
    560:    provided by the caller. Only columns l:k-1 are copied, restricting to the upper
    561:    triangular part if tri=PETSC_TRUE.
    562: */
    563: static inline PetscErrorCode BV_StoreCoeffsBlock_Default(BV bv,Mat R,PetscBool tri)
    564: {
    565:   const PetscScalar *bb;
    566:   PetscScalar       *rr;
    567:   PetscInt          j,ldr,ldb;

    569:   MatDenseGetLDA(R,&ldr);
    570:   MatDenseGetArray(R,&rr);
    571:   ldb  = bv->m+bv->nc;
    572:   VecGetArrayRead(bv->buffer,&bb);
    573:   for (j=bv->l;j<bv->k;j++) PetscArraycpy(rr+j*ldr,bb+j*ldb,(tri?(j+1):bv->k)+bv->nc);
    574:   VecRestoreArrayRead(bv->buffer,&bb);
    575:   MatDenseRestoreArray(R,&rr);
    576:   return 0;
    577: }

    579: /*
    580:    Orthogonalize a set of vectors with Cholesky: R=chol(V'*V), Q=V*inv(R)
    581:  */
    582: static PetscErrorCode BVOrthogonalize_Chol(BV V,Mat Rin)
    583: {
    584:   Mat            R,S;

    586:   BV_GetBufferMat(V);
    587:   R = V->Abuffer;
    588:   if (Rin) S = Rin;   /* use Rin as a workspace for S */
    589:   else S = R;
    590:   if (V->l) BVOrthogonalize_BlockGS(V,R);
    591:   BVDot(V,V,R);
    592:   BVMatCholInv_LAPACK_Private(V,R,S);
    593:   BVMultInPlace(V,S,V->l,V->k);
    594:   if (Rin) BV_StoreCoeffsBlock_Default(V,Rin,PETSC_TRUE);
    595:   return 0;
    596: }

    598: /*
    599:    Orthogonalize a set of vectors with the Tall-Skinny QR method
    600:  */
    601: static PetscErrorCode BVOrthogonalize_TSQR(BV V,Mat Rin)
    602: {
    603:   PetscScalar    *pv,*r=NULL;
    604:   PetscInt       ldr;
    605:   Mat            R;

    607:   BV_GetBufferMat(V);
    608:   R = V->Abuffer;
    609:   if (V->l) BVOrthogonalize_BlockGS(V,R);
    610:   MatDenseGetLDA(R,&ldr);
    611:   MatDenseGetArray(R,&r);
    612:   BVGetArray(V,&pv);
    613:   BVOrthogonalize_LAPACK_TSQR(V,V->n,V->k-V->l,pv+(V->nc+V->l)*V->n,r+V->l*ldr+V->l,ldr);
    614:   BVRestoreArray(V,&pv);
    615:   MatDenseRestoreArray(R,&r);
    616:   if (Rin) BV_StoreCoeffsBlock_Default(V,Rin,PETSC_TRUE);
    617:   return 0;
    618: }

    620: /*
    621:    Orthogonalize a set of vectors with TSQR, but computing R only, then doing Q=V*inv(R)
    622:  */
    623: static PetscErrorCode BVOrthogonalize_TSQRCHOL(BV V,Mat Rin)
    624: {
    625:   PetscScalar    *pv,*r=NULL;
    626:   PetscInt       ldr;
    627:   Mat            R,S;

    629:   BV_GetBufferMat(V);
    630:   R = V->Abuffer;
    631:   if (Rin) S = Rin;   /* use Rin as a workspace for S */
    632:   else S = R;
    633:   if (V->l) BVOrthogonalize_BlockGS(V,R);
    634:   MatDenseGetLDA(R,&ldr);
    635:   MatDenseGetArray(R,&r);
    636:   BVGetArray(V,&pv);
    637:   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);
    638:   BVRestoreArray(V,&pv);
    639:   MatDenseRestoreArray(R,&r);
    640:   BVMatTriInv_LAPACK_Private(V,R,S);
    641:   BVMultInPlace(V,S,V->l,V->k);
    642:   if (Rin) BV_StoreCoeffsBlock_Default(V,Rin,PETSC_TRUE);
    643:   return 0;
    644: }

    646: /*
    647:    Orthogonalize a set of vectors with SVQB
    648:  */
    649: static PetscErrorCode BVOrthogonalize_SVQB(BV V,Mat Rin)
    650: {
    651:   Mat            R,S;

    653:   BV_GetBufferMat(V);
    654:   R = V->Abuffer;
    655:   if (Rin) S = Rin;   /* use Rin as a workspace for S */
    656:   else S = R;
    657:   if (V->l) BVOrthogonalize_BlockGS(V,R);
    658:   BVDot(V,V,R);
    659:   BVMatSVQB_LAPACK_Private(V,R,S);
    660:   BVMultInPlace(V,S,V->l,V->k);
    661:   if (Rin) BV_StoreCoeffsBlock_Default(V,Rin,PETSC_FALSE);
    662:   return 0;
    663: }

    665: /*@
    666:    BVOrthogonalize - Orthogonalize all columns (starting from the leading ones),
    667:    that is, compute the QR decomposition.

    669:    Collective on V

    671:    Input Parameters:
    672: +  V - basis vectors to be orthogonalized (or B-orthogonalized), modified on output
    673: -  R - a sequential dense matrix (or NULL), on output the triangular factor of
    674:        the QR decomposition

    676:    Notes:
    677:    On input, matrix R must be a square sequential dense Mat, with at least as many
    678:    rows and columns as the number of active columns of V. The output satisfies
    679:    V0 = V*R (where V0 represent the input V) and V'*V = I (or V'*B*V = I if an
    680:    inner product matrix B has been specified with BVSetMatrix()).

    682:    If V has leading columns, then they are not modified (are assumed to be already
    683:    orthonormal) and the leading columns of R are not referenced. Let the
    684:    decomposition be
    685: .vb
    686:    [ V01 V02 ] = [ V1 V2 ] [ R11 R12 ]
    687:                            [  0  R22 ]
    688: .ve
    689:    then V1 is left unchanged (equal to V01) as well as R11 (it should satisfy
    690:    V01 = V1*R11).

    692:    Can pass NULL if R is not required.

    694:    The method to be used for block orthogonalization can be set with
    695:    BVSetOrthogonalization(). If set to GS, the computation is done column by
    696:    column with successive calls to BVOrthogonalizeColumn(). Note that in the
    697:    SVQB method the R factor is not upper triangular.

    699:    If V is rank-deficient or very ill-conditioned, that is, one or more columns are
    700:    (almost) linearly dependent with respect to the rest, then the algorithm may
    701:    break down or result in larger numerical error. Linearly dependent columns are
    702:    essentially replaced by random directions, and the corresponding diagonal entry
    703:    in R is set to (nearly) zero.

    705:    Level: intermediate

    707: .seealso: BVOrthogonalizeColumn(), BVOrthogonalizeVec(), BVSetMatrix(), BVSetActiveColumns(), BVSetOrthogonalization(), BVOrthogBlockType
    708: @*/
    709: PetscErrorCode BVOrthogonalize(BV V,Mat R)
    710: {
    711:   PetscInt       m,n;

    715:   BVCheckSizes(V,1);
    716:   if (R) {
    720:     MatGetSize(R,&m,&n);
    723:   }

    726:   PetscLogEventBegin(BV_Orthogonalize,V,R,0,0);
    727:   switch (V->orthog_block) {
    728:   case BV_ORTHOG_BLOCK_GS: /* proceed column by column with Gram-Schmidt */
    729:     BVOrthogonalize_GS(V,R);
    730:     break;
    731:   case BV_ORTHOG_BLOCK_CHOL:
    732:     BVOrthogonalize_Chol(V,R);
    733:     break;
    734:   case BV_ORTHOG_BLOCK_TSQR:
    736:     BVOrthogonalize_TSQR(V,R);
    737:     break;
    738:   case BV_ORTHOG_BLOCK_TSQRCHOL:
    740:     BVOrthogonalize_TSQRCHOL(V,R);
    741:     break;
    742:   case BV_ORTHOG_BLOCK_SVQB:
    743:     BVOrthogonalize_SVQB(V,R);
    744:     break;
    745:   }
    746:   PetscLogEventEnd(BV_Orthogonalize,V,R,0,0);
    747:   PetscObjectStateIncrease((PetscObject)V);
    748:   return 0;
    749: }