Date: 2024-04-26T10:23:08+00:00

Actual source code: dsops.c
slepc-3.21.1 2024-04-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:    DS operations: DSSolve(), DSVectors(), etc
     12: */

     14: #include <slepc/private/dsimpl.h>

     16: /*@
     17:    DSGetLeadingDimension - Returns the leading dimension of the allocated
     18:    matrices.

     20:    Not Collective

     22:    Input Parameter:
     23: .  ds - the direct solver context

     25:    Output Parameter:
     26: .  ld - leading dimension (maximum allowed dimension for the matrices)

     28:    Level: advanced

     30: .seealso: DSAllocate(), DSSetDimensions()
     31: @*/
     32: PetscErrorCode DSGetLeadingDimension(DS ds,PetscInt *ld)
     33: {
     34:   PetscFunctionBegin;
     36:   PetscAssertPointer(ld,2);
     37:   *ld = ds->ld;
     38:   PetscFunctionReturn(PETSC_SUCCESS);
     39: }

     41: /*@
     42:    DSSetState - Change the state of the DS object.

     44:    Logically Collective

     46:    Input Parameters:
     47: +  ds    - the direct solver context
     48: -  state - the new state

     50:    Notes:
     51:    The state indicates that the dense system is in an initial state (raw),
     52:    in an intermediate state (such as tridiagonal, Hessenberg or
     53:    Hessenberg-triangular), in a condensed state (such as diagonal, Schur or
     54:    generalized Schur), or in a truncated state.

     56:    This function is normally used to return to the raw state when the
     57:    condensed structure is destroyed.

     59:    Level: advanced

     61: .seealso: DSGetState()
     62: @*/
     63: PetscErrorCode DSSetState(DS ds,DSStateType state)
     64: {
     65:   PetscFunctionBegin;
     68:   switch (state) {
     69:     case DS_STATE_RAW:
     70:     case DS_STATE_INTERMEDIATE:
     71:     case DS_STATE_CONDENSED:
     72:     case DS_STATE_TRUNCATED:
     73:       if (ds->state!=state) PetscCall(PetscInfo(ds,"State has changed from %s to %s\n",DSStateTypes[ds->state],DSStateTypes[state]));
     74:       ds->state = state;
     75:       break;
     76:     default:
     77:       SETERRQ(PetscObjectComm((PetscObject)ds),PETSC_ERR_ARG_WRONG,"Wrong state");
     78:   }
     79:   PetscFunctionReturn(PETSC_SUCCESS);
     80: }

     82: /*@
     83:    DSGetState - Returns the current state.

     85:    Not Collective

     87:    Input Parameter:
     88: .  ds - the direct solver context

     90:    Output Parameter:
     91: .  state - current state

     93:    Level: advanced

     95: .seealso: DSSetState()
     96: @*/
     97: PetscErrorCode DSGetState(DS ds,DSStateType *state)
     98: {
     99:   PetscFunctionBegin;
    101:   PetscAssertPointer(state,2);
    102:   *state = ds->state;
    103:   PetscFunctionReturn(PETSC_SUCCESS);
    104: }

    106: /*@
    107:    DSSetDimensions - Resize the matrices in the DS object.

    109:    Logically Collective

    111:    Input Parameters:
    112: +  ds - the direct solver context
    113: .  n  - the new size
    114: .  l  - number of locked (inactive) leading columns
    115: -  k  - intermediate dimension (e.g., position of arrow)

    117:    Notes:
    118:    The internal arrays are not reallocated.

    120:    Some DS types have additional dimensions, e.g. the number of columns
    121:    in DSSVD. For these, you should call a specific interface function.

    123:    Level: intermediate

    125: .seealso: DSGetDimensions(), DSAllocate(), DSSVDSetDimensions()
    126: @*/
    127: PetscErrorCode DSSetDimensions(DS ds,PetscInt n,PetscInt l,PetscInt k)
    128: {
    129:   PetscInt       on,ol,ok;
    130:   PetscBool      issvd;

    132:   PetscFunctionBegin;
    134:   DSCheckAlloc(ds,1);
    138:   on = ds->n; ol = ds->l; ok = ds->k;
    139:   if (n==PETSC_DECIDE || n==PETSC_DEFAULT) {
    140:     ds->n = ds->extrarow? ds->ld-1: ds->ld;
    141:   } else {
    142:     PetscCheck(n>=0 && n<=ds->ld,PetscObjectComm((PetscObject)ds),PETSC_ERR_ARG_OUTOFRANGE,"Illegal value of n. Must be between 0 and ld");
    143:     PetscCall(PetscObjectTypeCompareAny((PetscObject)ds,&issvd,DSSVD,DSGSVD,""));  /* SVD and GSVD have extra column instead of extra row */
    144:     PetscCheck(!ds->extrarow || n<ds->ld || issvd,PetscObjectComm((PetscObject)ds),PETSC_ERR_ARG_OUTOFRANGE,"A value of n equal to ld leaves no room for extra row");
    145:     ds->n = n;
    146:   }
    147:   ds->t = ds->n;   /* truncated length equal to the new dimension */
    148:   if (l==PETSC_DECIDE || l==PETSC_DEFAULT) {
    149:     ds->l = 0;
    150:   } else {
    151:     PetscCheck(l>=0 && l<=ds->n,PetscObjectComm((PetscObject)ds),PETSC_ERR_ARG_OUTOFRANGE,"Illegal value of l. Must be between 0 and n");
    152:     ds->l = l;
    153:   }
    154:   if (k==PETSC_DECIDE || k==PETSC_DEFAULT) {
    155:     ds->k = ds->n/2;
    156:   } else {
    157:     PetscCheck(k>=0 || k<=ds->n,PetscObjectComm((PetscObject)ds),PETSC_ERR_ARG_OUTOFRANGE,"Illegal value of k. Must be between 0 and n");
    158:     ds->k = k;
    159:   }
    160:   if (on!=ds->n || ol!=ds->l || ok!=ds->k) PetscCall(PetscInfo(ds,"New dimensions are: n=%" PetscInt_FMT ", l=%" PetscInt_FMT ", k=%" PetscInt_FMT "\n",ds->n,ds->l,ds->k));
    161:   PetscFunctionReturn(PETSC_SUCCESS);
    162: }

    164: /*@
    165:    DSGetDimensions - Returns the current dimensions.

    167:    Not Collective

    169:    Input Parameter:
    170: .  ds - the direct solver context

    172:    Output Parameters:
    173: +  n  - the current size
    174: .  l  - number of locked (inactive) leading columns
    175: .  k  - intermediate dimension (e.g., position of arrow)
    176: -  t  - truncated length

    178:    Note:
    179:    The t parameter makes sense only if DSTruncate() has been called.
    180:    Otherwise its value equals n.

    182:    Some DS types have additional dimensions, e.g. the number of columns
    183:    in DSSVD. For these, you should call a specific interface function.

    185:    Level: intermediate

    187: .seealso: DSSetDimensions(), DSTruncate(), DSSVDGetDimensions()
    188: @*/
    189: PetscErrorCode DSGetDimensions(DS ds,PetscInt *n,PetscInt *l,PetscInt *k,PetscInt *t)
    190: {
    191:   PetscFunctionBegin;
    193:   DSCheckAlloc(ds,1);
    194:   if (n) *n = ds->n;
    195:   if (l) *l = ds->l;
    196:   if (k) *k = ds->k;
    197:   if (t) *t = ds->t;
    198:   PetscFunctionReturn(PETSC_SUCCESS);
    199: }

    201: /*@
    202:    DSTruncate - Truncates the system represented in the DS object.

    204:    Logically Collective

    206:    Input Parameters:
    207: +  ds   - the direct solver context
    208: .  n    - the new size
    209: -  trim - a flag to indicate if the factorization must be trimmed

    211:    Note:
    212:    The new size is set to n. Note that in some cases the new size could
    213:    be n+1 or n-1 to avoid breaking a 2x2 diagonal block (e.g. in real
    214:    Schur form). In cases where the extra row is meaningful, the first
    215:    n elements are kept as the extra row for the new system.

    217:    If the flag trim is turned on, it resets the locked and intermediate
    218:    dimensions to zero, see DSSetDimensions(), and sets the state to RAW.
    219:    It also cleans the extra row if being used.

    221:    The typical usage of trim=true is to truncate the Schur decomposition
    222:    at the end of a Krylov iteration. In this case, the state must be
    223:    changed to RAW so that DSVectors() computes eigenvectors from scratch.

    225:    Level: advanced

    227: .seealso: DSSetDimensions(), DSSetExtraRow(), DSStateType
    228: @*/
    229: PetscErrorCode DSTruncate(DS ds,PetscInt n,PetscBool trim)
    230: {
    231:   DSStateType    old;

    233:   PetscFunctionBegin;
    236:   DSCheckAlloc(ds,1);
    239:   PetscCheck(n>=ds->l && n<=ds->n,PetscObjectComm((PetscObject)ds),PETSC_ERR_ARG_OUTOFRANGE,"Illegal value of n (%" PetscInt_FMT "). Must be between l (%" PetscInt_FMT ") and n (%" PetscInt_FMT ")",n,ds->l,ds->n);
    240:   PetscCall(PetscLogEventBegin(DS_Other,ds,0,0,0));
    241:   PetscCall(PetscFPTrapPush(PETSC_FP_TRAP_OFF));
    242:   PetscUseTypeMethod(ds,truncate,n,trim);
    243:   PetscCall(PetscFPTrapPop());
    244:   PetscCall(PetscLogEventEnd(DS_Other,ds,0,0,0));
    245:   PetscCall(PetscInfo(ds,"Decomposition %s to size n=%" PetscInt_FMT "\n",trim?"trimmed":"truncated",ds->n));
    246:   old = ds->state;
    247:   ds->state = trim? DS_STATE_RAW: DS_STATE_TRUNCATED;
    248:   if (old!=ds->state) PetscCall(PetscInfo(ds,"State has changed from %s to %s\n",DSStateTypes[old],DSStateTypes[ds->state]));
    249:   PetscCall(PetscObjectStateIncrease((PetscObject)ds));
    250:   PetscFunctionReturn(PETSC_SUCCESS);
    251: }

    253: /*@
    254:    DSMatGetSize - Returns the numbers of rows and columns of one of the DS matrices.

    256:    Not Collective

    258:    Input Parameters:
    259: +  ds - the direct solver context
    260: -  t  - the requested matrix

    262:    Output Parameters:
    263: +  n  - the number of rows
    264: -  m  - the number of columns

    266:    Note:
    267:    This is equivalent to MatGetSize() on a matrix obtained with DSGetMat().

    269:    Level: developer

    271: .seealso: DSSetDimensions(), DSGetMat()
    272: @*/
    273: PetscErrorCode DSMatGetSize(DS ds,DSMatType t,PetscInt *m,PetscInt *n)
    274: {
    275:   PetscInt       rows,cols;

    277:   PetscFunctionBegin;
    280:   DSCheckValidMat(ds,t,2);
    281:   if (ds->ops->matgetsize) PetscUseTypeMethod(ds,matgetsize,t,&rows,&cols);
    282:   else {
    283:     if (ds->state==DS_STATE_TRUNCATED && t>=DS_MAT_Q) rows = ds->t;
    284:     else rows = (t==DS_MAT_A && ds->extrarow)? ds->n+1: ds->n;
    285:     if (t==DS_MAT_T) cols = PetscDefined(USE_COMPLEX)? 2: 3;
    286:     else if (t==DS_MAT_D) cols = 1;
    287:     else cols = ds->n;
    288:   }
    289:   if (m) *m = rows;
    290:   if (n) *n = cols;
    291:   PetscFunctionReturn(PETSC_SUCCESS);
    292: }

    294: /*@
    295:    DSMatIsHermitian - Checks if one of the DS matrices is known to be Hermitian.

    297:    Not Collective

    299:    Input Parameters:
    300: +  ds - the direct solver context
    301: -  t  - the requested matrix

    303:    Output Parameter:
    304: .  flg - the Hermitian flag

    306:    Note:
    307:    Does not check the matrix values directly. The flag is set according to the
    308:    problem structure. For instance, in DSHEP matrix A is Hermitian.

    310:    Level: developer

    312: .seealso: DSGetMat()
    313: @*/
    314: PetscErrorCode DSMatIsHermitian(DS ds,DSMatType t,PetscBool *flg)
    315: {
    316:   PetscFunctionBegin;
    319:   DSCheckValidMat(ds,t,2);
    320:   PetscAssertPointer(flg,3);
    321:   *flg = PETSC_FALSE;
    322:   PetscTryTypeMethod(ds,hermitian,t,flg);
    323:   PetscFunctionReturn(PETSC_SUCCESS);
    324: }

    326: PetscErrorCode DSGetTruncateSize_Default(DS ds,PetscInt l,PetscInt n,PetscInt *k)
    327: {
    328: #if !defined(PETSC_USE_COMPLEX)
    329:   PetscScalar val;
    330: #endif

    332:   PetscFunctionBegin;
    333: #if !defined(PETSC_USE_COMPLEX)
    334:   PetscCall(MatGetValue(ds->omat[DS_MAT_A],l+(*k),l+(*k)-1,&val));
    335:   if (val != 0.0) {
    336:     if (l+(*k)<n-1) (*k)++;
    337:     else (*k)--;
    338:   }
    339: #endif
    340:   PetscFunctionReturn(PETSC_SUCCESS);
    341: }

    343: /*@
    344:    DSGetTruncateSize - Gets the correct size to be used in DSTruncate()
    345:    to avoid breaking a 2x2 block.

    347:    Not Collective

    349:    Input Parameters:
    350: +  ds - the direct solver context
    351: .  l  - the size of the locked part (set to 0 to use ds->l)
    352: -  n  - the total matrix size (set to 0 to use ds->n)

    354:    Output Parameter:
    355: .  k  - the wanted truncation size (possibly modified)

    357:    Notes:
    358:    This should be called before DSTruncate() to make sure that the truncation
    359:    does not break a 2x2 block corresponding to a complex conjugate eigenvalue.

    361:    The total size is n (either user-provided or ds->n if 0 is passed). The
    362:    size where the truncation is intended is equal to l+k (where l can be
    363:    equal to the locked size ds->l if set to 0). Then if there is a 2x2 block
    364:    at the l+k limit, the value of k is increased (or decreased) by 1.

    366:    Level: advanced

    368: .seealso: DSTruncate(), DSSetDimensions()
    369: @*/
    370: PetscErrorCode DSGetTruncateSize(DS ds,PetscInt l,PetscInt n,PetscInt *k)
    371: {
    372:   PetscFunctionBegin;
    374:   DSCheckAlloc(ds,1);
    377:   PetscAssertPointer(k,4);
    378:   PetscUseTypeMethod(ds,gettruncatesize,l?l:ds->l,n?n:ds->n,k);
    379:   PetscFunctionReturn(PETSC_SUCCESS);
    380: }

    382: /*@
    383:    DSGetMat - Returns a sequential dense Mat object containing the requested
    384:    matrix.

    386:    Not Collective

    388:    Input Parameters:
    389: +  ds - the direct solver context
    390: -  m  - the requested matrix

    392:    Output Parameter:
    393: .  A  - Mat object

    395:    Notes:
    396:    The returned Mat has sizes equal to the current DS dimensions (nxm),
    397:    and contains the values that would be obtained with DSGetArray()
    398:    (not DSGetArrayReal()). If the DS was truncated, then the number of rows
    399:    is equal to the dimension prior to truncation, see DSTruncate().
    400:    The communicator is always PETSC_COMM_SELF.

    402:    It is implemented with MatDenseGetSubMatrix(), and when no longer needed
    403:    the user must call DSRestoreMat() which will invoke MatDenseRestoreSubMatrix().

    405:    For matrices DS_MAT_T and DS_MAT_D, this function will return a Mat object
    406:    that cannot be used directly for computations, since it uses compact storage
    407:    (three and one diagonals for T and D, respectively). In complex scalars, the
    408:    internal array stores real values, so it is sufficient with 2 columns for T.

    410:    Level: advanced

    412: .seealso: DSRestoreMat(), DSSetDimensions(), DSGetArray(), DSGetArrayReal(), DSTruncate()
    413: @*/
    414: PetscErrorCode DSGetMat(DS ds,DSMatType m,Mat *A)
    415: {
    416:   PetscInt  rows,cols;
    417:   PetscBool flg;

    419:   PetscFunctionBegin;
    421:   DSCheckAlloc(ds,1);
    422:   DSCheckValidMat(ds,m,2);
    423:   PetscAssertPointer(A,3);

    425:   PetscCall(DSMatGetSize(ds,m,&rows,&cols));
    426:   PetscCheck(rows && cols,PetscObjectComm((PetscObject)ds),PETSC_ERR_ORDER,"Must call DSSetDimensions() first");
    427:   PetscCall(MatDenseGetSubMatrix(ds->omat[m],0,rows,0,cols,A));

    429:   /* set Hermitian flag */
    430:   PetscCall(DSMatIsHermitian(ds,m,&flg));
    431:   PetscCall(MatSetOption(*A,MAT_SYMMETRIC,flg));
    432:   PetscCall(MatSetOption(*A,MAT_HERMITIAN,flg));
    433:   PetscFunctionReturn(PETSC_SUCCESS);
    434: }

    436: /*@
    437:    DSRestoreMat - Restores the matrix after DSGetMat() was called.

    439:    Not Collective

    441:    Input Parameters:
    442: +  ds - the direct solver context
    443: .  m  - the requested matrix
    444: -  A  - the fetched Mat object

    446:    Note:
    447:    A call to this function must match a previous call of DSGetMat().

    449:    Level: advanced

    451: .seealso: DSGetMat(), DSRestoreArray(), DSRestoreArrayReal()
    452: @*/
    453: PetscErrorCode DSRestoreMat(DS ds,DSMatType m,Mat *A)
    454: {
    455:   PetscFunctionBegin;
    457:   DSCheckAlloc(ds,1);
    458:   DSCheckValidMat(ds,m,2);
    459:   PetscAssertPointer(A,3);

    461:   PetscCall(MatDenseRestoreSubMatrix(ds->omat[m],A));
    462:   PetscCall(PetscObjectStateIncrease((PetscObject)ds));
    463:   PetscFunctionReturn(PETSC_SUCCESS);
    464: }

    466: /*@
    467:    DSGetMatAndColumn - Returns a sequential dense Mat object containing the requested
    468:    matrix and one of its columns as a Vec.

    470:    Not Collective

    472:    Input Parameters:
    473: +  ds  - the direct solver context
    474: .  m   - the requested matrix
    475: -  col - the requested column

    477:    Output Parameters:
    478: +  A   - Mat object
    479: -  v   - Vec object (the column)

    481:    Notes:
    482:    This calls DSGetMat() and then it extracts the selected column.
    483:    The user must call DSRestoreMatAndColumn() to recover the original state.
    484:    For matrices DS_MAT_T and DS_MAT_D, in complex scalars this function implies
    485:    copying from real values stored internally to scalar values in the Vec.

    487:    Level: advanced

    489: .seealso: DSRestoreMatAndColumn(), DSGetMat()
    490: @*/
    491: PetscErrorCode DSGetMatAndColumn(DS ds,DSMatType m,PetscInt col,Mat *A,Vec *v)
    492: {
    493:   PetscFunctionBegin;
    495:   DSCheckAlloc(ds,1);
    496:   DSCheckValidMat(ds,m,2);
    497:   PetscAssertPointer(A,4);
    498:   PetscAssertPointer(v,5);

    500:   PetscCall(DSGetMat(ds,m,A));
    501:   if (PetscDefined(USE_COMPLEX) && (m==DS_MAT_T || m==DS_MAT_D)) {
    502:     const PetscScalar *as;
    503:     PetscScalar       *vs;
    504:     PetscReal         *ar;
    505:     PetscInt          i,n,lda;
    506:     PetscCall(MatCreateVecs(*A,NULL,v));
    507:     PetscCall(VecGetSize(*v,&n));
    508:     PetscCall(MatDenseGetLDA(*A,&lda));
    509:     PetscCall(MatDenseGetArrayRead(*A,&as));
    510:     PetscCall(VecGetArrayWrite(*v,&vs));
    511:     ar = (PetscReal*)as;
    512:     for (i=0;i<n;i++) vs[i] = ar[i+col*lda];
    513:     PetscCall(VecRestoreArrayWrite(*v,&vs));
    514:     PetscCall(MatDenseRestoreArrayRead(*A,&as));
    515:   } else PetscCall(MatDenseGetColumnVec(*A,col,v));
    516:   PetscFunctionReturn(PETSC_SUCCESS);
    517: }

    519: /*@
    520:    DSRestoreMatAndColumn - Restores the matrix and vector after DSGetMatAndColumn()
    521:    was called.

    523:    Not Collective

    525:    Input Parameters:
    526: +  ds  - the direct solver context
    527: .  m   - the requested matrix
    528: .  col - the requested column
    529: .  A   - the fetched Mat object
    530: -  v   - the fetched Vec object

    532:    Note:
    533:    A call to this function must match a previous call of DSGetMatAndColumn().

    535:    Level: advanced

    537: .seealso: DSGetMatAndColumn(), DSRestoreMat()
    538: @*/
    539: PetscErrorCode DSRestoreMatAndColumn(DS ds,DSMatType m,PetscInt col,Mat *A,Vec *v)
    540: {
    541:   PetscFunctionBegin;
    543:   DSCheckAlloc(ds,1);
    544:   DSCheckValidMat(ds,m,2);
    545:   PetscAssertPointer(A,4);
    546:   PetscAssertPointer(v,5);

    548:   if (PetscDefined(USE_COMPLEX) && (m==DS_MAT_T || m==DS_MAT_D)) {
    549:     const PetscScalar *vs;
    550:     PetscScalar       *as;
    551:     PetscReal         *ar;
    552:     PetscInt          i,n,lda;
    553:     PetscCall(VecGetSize(*v,&n));
    554:     PetscCall(MatDenseGetLDA(*A,&lda));
    555:     PetscCall(MatDenseGetArray(*A,&as));
    556:     PetscCall(VecGetArrayRead(*v,&vs));
    557:     ar = (PetscReal*)as;
    558:     for (i=0;i<n;i++) ar[i+col*lda] = PetscRealPart(vs[i]);
    559:     PetscCall(VecRestoreArrayRead(*v,&vs));
    560:     PetscCall(MatDenseRestoreArray(*A,&as));
    561:     PetscCall(VecDestroy(v));
    562:   } else PetscCall(MatDenseRestoreColumnVec(*A,col,v));
    563:   PetscCall(DSRestoreMat(ds,m,A));
    564:   PetscFunctionReturn(PETSC_SUCCESS);
    565: }

    567: /*@C
    568:    DSGetArray - Returns a pointer to the internal array of one of the
    569:    matrices. You MUST call DSRestoreArray() when you no longer
    570:    need to access the array.

    572:    Not Collective

    574:    Input Parameters:
    575: +  ds - the direct solver context
    576: -  m  - the requested matrix

    578:    Output Parameter:
    579: .  a  - pointer to the values

    581:    Note:
    582:    To get read-only access, use DSGetMat() followed by MatDenseGetArrayRead().

    584:    Level: advanced

    586: .seealso: DSRestoreArray(), DSGetArrayReal()
    587: @*/
    588: PetscErrorCode DSGetArray(DS ds,DSMatType m,PetscScalar *a[])
    589: {
    590:   PetscFunctionBegin;
    592:   DSCheckAlloc(ds,1);
    593:   DSCheckValidMat(ds,m,2);
    594:   PetscAssertPointer(a,3);
    595:   PetscCall(MatDenseGetArray(ds->omat[m],a));
    596:   PetscFunctionReturn(PETSC_SUCCESS);
    597: }

    599: /*@C
    600:    DSRestoreArray - Restores the matrix after DSGetArray() was called.

    602:    Not Collective

    604:    Input Parameters:
    605: +  ds - the direct solver context
    606: .  m  - the requested matrix
    607: -  a  - pointer to the values

    609:    Level: advanced

    611: .seealso: DSGetArray(), DSGetArrayReal()
    612: @*/
    613: PetscErrorCode DSRestoreArray(DS ds,DSMatType m,PetscScalar *a[])
    614: {
    615:   PetscFunctionBegin;
    617:   DSCheckAlloc(ds,1);
    618:   DSCheckValidMat(ds,m,2);
    619:   PetscAssertPointer(a,3);
    620:   PetscCall(MatDenseRestoreArray(ds->omat[m],a));
    621:   PetscCall(PetscObjectStateIncrease((PetscObject)ds));
    622:   PetscFunctionReturn(PETSC_SUCCESS);
    623: }

    625: /*@C
    626:    DSGetArrayReal - Returns a real pointer to the internal array of T or D.
    627:    You MUST call DSRestoreArrayReal() when you no longer need to access the array.

    629:    Not Collective

    631:    Input Parameters:
    632: +  ds - the direct solver context
    633: -  m  - the requested matrix

    635:    Output Parameter:
    636: .  a  - pointer to the values

    638:    Note:
    639:    This function can be used only for DS_MAT_T and DS_MAT_D. These matrices always
    640:    store real values, even in complex scalars, that is why the returned pointer is
    641:    PetscReal.

    643:    Level: advanced

    645: .seealso: DSRestoreArrayReal(), DSGetArray()
    646: @*/
    647: PetscErrorCode DSGetArrayReal(DS ds,DSMatType m,PetscReal *a[])
    648: {
    649: #if defined(PETSC_USE_COMPLEX)
    650:   PetscScalar *as;
    651: #endif

    653:   PetscFunctionBegin;
    655:   DSCheckAlloc(ds,1);
    656:   DSCheckValidMatReal(ds,m,2);
    657:   PetscAssertPointer(a,3);
    658: #if defined(PETSC_USE_COMPLEX)
    659:   PetscCall(MatDenseGetArray(ds->omat[m],&as));
    660:   *a = (PetscReal*)as;
    661: #else
    662:   PetscCall(MatDenseGetArray(ds->omat[m],a));
    663: #endif
    664:   PetscFunctionReturn(PETSC_SUCCESS);
    665: }

    667: /*@C
    668:    DSRestoreArrayReal - Restores the matrix after DSGetArrayReal() was called.

    670:    Not Collective

    672:    Input Parameters:
    673: +  ds - the direct solver context
    674: .  m  - the requested matrix
    675: -  a  - pointer to the values

    677:    Level: advanced

    679: .seealso: DSGetArrayReal(), DSGetArray()
    680: @*/
    681: PetscErrorCode DSRestoreArrayReal(DS ds,DSMatType m,PetscReal *a[])
    682: {
    683: #if defined(PETSC_USE_COMPLEX)
    684:   PetscScalar *as;
    685: #endif

    687:   PetscFunctionBegin;
    689:   DSCheckAlloc(ds,1);
    690:   DSCheckValidMatReal(ds,m,2);
    691:   PetscAssertPointer(a,3);
    692: #if defined(PETSC_USE_COMPLEX)
    693:   PetscCall(MatDenseRestoreArray(ds->omat[m],&as));
    694:   *a = NULL;
    695: #else
    696:   PetscCall(MatDenseRestoreArray(ds->omat[m],a));
    697: #endif
    698:   PetscCall(PetscObjectStateIncrease((PetscObject)ds));
    699:   PetscFunctionReturn(PETSC_SUCCESS);
    700: }

    702: /*@
    703:    DSSolve - Solves the problem.

    705:    Logically Collective

    707:    Input Parameters:
    708: +  ds   - the direct solver context
    709: .  eigr - array to store the computed eigenvalues (real part)
    710: -  eigi - array to store the computed eigenvalues (imaginary part)

    712:    Note:
    713:    This call brings the dense system to condensed form. No ordering
    714:    of the eigenvalues is enforced (for this, call DSSort() afterwards).

    716:    Level: intermediate

    718: .seealso: DSSort(), DSStateType
    719: @*/
    720: PetscErrorCode DSSolve(DS ds,PetscScalar eigr[],PetscScalar eigi[])
    721: {
    722:   PetscFunctionBegin;
    725:   DSCheckAlloc(ds,1);
    726:   PetscAssertPointer(eigr,2);
    727:   if (ds->state>=DS_STATE_CONDENSED) PetscFunctionReturn(PETSC_SUCCESS);
    728:   PetscCheck(ds->ops->solve[ds->method],PetscObjectComm((PetscObject)ds),PETSC_ERR_ARG_OUTOFRANGE,"The specified method number does not exist for this DS");
    729:   PetscCall(PetscInfo(ds,"Starting solve with problem sizes: n=%" PetscInt_FMT ", l=%" PetscInt_FMT ", k=%" PetscInt_FMT "\n",ds->n,ds->l,ds->k));
    730:   PetscCall(PetscLogEventBegin(DS_Solve,ds,0,0,0));
    731:   PetscCall(PetscFPTrapPush(PETSC_FP_TRAP_OFF));
    732:   PetscUseTypeMethod(ds,solve[ds->method],eigr,eigi);
    733:   PetscCall(PetscFPTrapPop());
    734:   PetscCall(PetscLogEventEnd(DS_Solve,ds,0,0,0));
    735:   PetscCall(PetscInfo(ds,"State has changed from %s to CONDENSED\n",DSStateTypes[ds->state]));
    736:   ds->state = DS_STATE_CONDENSED;
    737:   PetscCall(PetscObjectStateIncrease((PetscObject)ds));
    738:   PetscFunctionReturn(PETSC_SUCCESS);
    739: }

    741: /*@C
    742:    DSSort - Sorts the result of DSSolve() according to a given sorting
    743:    criterion.

    745:    Logically Collective

    747:    Input Parameters:
    748: +  ds   - the direct solver context
    749: .  rr   - (optional) array containing auxiliary values (real part)
    750: -  ri   - (optional) array containing auxiliary values (imaginary part)

    752:    Input/Output Parameters:
    753: +  eigr - array containing the computed eigenvalues (real part)
    754: .  eigi - array containing the computed eigenvalues (imaginary part)
    755: -  k    - (optional) number of elements in the leading group

    757:    Notes:
    758:    This routine sorts the arrays provided in eigr and eigi, and also
    759:    sorts the dense system stored inside ds (assumed to be in condensed form).
    760:    The sorting criterion is specified with DSSetSlepcSC().

    762:    If arrays rr and ri are provided, then a (partial) reordering based on these
    763:    values rather than on the eigenvalues is performed. In symmetric problems
    764:    a total order is obtained (parameter k is ignored), but otherwise the result
    765:    is sorted only partially. In this latter case, it is only guaranteed that
    766:    all the first k elements satisfy the comparison with any of the last n-k
    767:    elements. The output value of parameter k is the final number of elements in
    768:    the first set.

    770:    Level: intermediate

    772: .seealso: DSSolve(), DSSetSlepcSC(), DSSortWithPermutation()
    773: @*/
    774: PetscErrorCode DSSort(DS ds,PetscScalar *eigr,PetscScalar *eigi,PetscScalar *rr,PetscScalar *ri,PetscInt *k)
    775: {
    776:   PetscInt       i;

    778:   PetscFunctionBegin;
    781:   DSCheckSolved(ds,1);
    782:   PetscAssertPointer(eigr,2);
    783:   if (rr) PetscAssertPointer(rr,4);
    784:   PetscCheck(ds->state<DS_STATE_TRUNCATED,PetscObjectComm((PetscObject)ds),PETSC_ERR_ORDER,"Cannot sort a truncated DS");
    785:   PetscCheck(ds->sc,PetscObjectComm((PetscObject)ds),PETSC_ERR_ORDER,"Must provide a sorting criterion first");
    786:   PetscCheck(!k || rr,PetscObjectComm((PetscObject)ds),PETSC_ERR_ARG_WRONG,"Argument k can only be used together with rr");

    788:   for (i=0;i<ds->n;i++) ds->perm[i] = i;   /* initialize to trivial permutation */
    789:   PetscCall(PetscLogEventBegin(DS_Other,ds,0,0,0));
    790:   PetscCall(PetscFPTrapPush(PETSC_FP_TRAP_OFF));
    791:   PetscUseTypeMethod(ds,sort,eigr,eigi,rr,ri,k);
    792:   PetscCall(PetscFPTrapPop());
    793:   PetscCall(PetscLogEventEnd(DS_Other,ds,0,0,0));
    794:   PetscCall(PetscObjectStateIncrease((PetscObject)ds));
    795:   PetscCall(PetscInfo(ds,"Finished sorting\n"));
    796:   PetscFunctionReturn(PETSC_SUCCESS);
    797: }

    799: /*@C
    800:    DSSortWithPermutation - Reorders the result of DSSolve() according to a given
    801:    permutation.

    803:    Logically Collective

    805:    Input Parameters:
    806: +  ds   - the direct solver context
    807: -  perm - permutation that indicates the new ordering

    809:    Input/Output Parameters:
    810: +  eigr - array with the reordered eigenvalues (real part)
    811: -  eigi - array with the reordered eigenvalues (imaginary part)

    813:    Notes:
    814:    This routine reorders the arrays provided in eigr and eigi, and also the dense
    815:    system stored inside ds (assumed to be in condensed form). There is no sorting
    816:    criterion, as opposed to DSSort(). Instead, the new ordering is given in argument perm.

    818:    Level: advanced

    820: .seealso: DSSolve(), DSSort()
    821: @*/
    822: PetscErrorCode DSSortWithPermutation(DS ds,PetscInt *perm,PetscScalar *eigr,PetscScalar *eigi)
    823: {
    824:   PetscFunctionBegin;
    827:   DSCheckSolved(ds,1);
    828:   PetscAssertPointer(perm,2);
    829:   PetscAssertPointer(eigr,3);
    830:   PetscCheck(ds->state<DS_STATE_TRUNCATED,PetscObjectComm((PetscObject)ds),PETSC_ERR_ORDER,"Cannot sort a truncated DS");

    832:   PetscCall(PetscLogEventBegin(DS_Other,ds,0,0,0));
    833:   PetscCall(PetscFPTrapPush(PETSC_FP_TRAP_OFF));
    834:   PetscUseTypeMethod(ds,sortperm,perm,eigr,eigi);
    835:   PetscCall(PetscFPTrapPop());
    836:   PetscCall(PetscLogEventEnd(DS_Other,ds,0,0,0));
    837:   PetscCall(PetscObjectStateIncrease((PetscObject)ds));
    838:   PetscCall(PetscInfo(ds,"Finished sorting\n"));
    839:   PetscFunctionReturn(PETSC_SUCCESS);
    840: }

    842: /*@
    843:    DSSynchronize - Make sure that all processes have the same data, performing
    844:    communication if necessary.

    846:    Collective

    848:    Input Parameter:
    849: .  ds   - the direct solver context

    851:    Input/Output Parameters:
    852: +  eigr - (optional) array with the computed eigenvalues (real part)
    853: -  eigi - (optional) array with the computed eigenvalues (imaginary part)

    855:    Notes:
    856:    When the DS has been created with a communicator with more than one process,
    857:    the internal data, especially the computed matrices, may diverge in the
    858:    different processes. This happens when using multithreaded BLAS and may
    859:    cause numerical issues in some ill-conditioned problems. This function
    860:    performs the necessary communication among the processes so that the
    861:    internal data is exactly equal in all of them.

    863:    Depending on the parallel mode as set with DSSetParallel(), this function
    864:    will either do nothing or synchronize the matrices computed by DSSolve()
    865:    and DSSort(). The arguments eigr and eigi are typically those used in the
    866:    calls to DSSolve() and DSSort().

    868:    Level: developer

    870: .seealso: DSSetParallel(), DSSolve(), DSSort()
    871: @*/
    872: PetscErrorCode DSSynchronize(DS ds,PetscScalar eigr[],PetscScalar eigi[])
    873: {
    874:   PetscMPIInt    size;

    876:   PetscFunctionBegin;
    879:   DSCheckAlloc(ds,1);
    880:   PetscCallMPI(MPI_Comm_size(PetscObjectComm((PetscObject)ds),&size));
    881:   if (size>1 && ds->pmode==DS_PARALLEL_SYNCHRONIZED) {
    882:     PetscCall(PetscLogEventBegin(DS_Synchronize,ds,0,0,0));
    883:     PetscUseTypeMethod(ds,synchronize,eigr,eigi);
    884:     PetscCall(PetscLogEventEnd(DS_Synchronize,ds,0,0,0));
    885:     PetscCall(PetscObjectStateIncrease((PetscObject)ds));
    886:     PetscCall(PetscInfo(ds,"Synchronization completed (%s)\n",DSParallelTypes[ds->pmode]));
    887:   }
    888:   PetscFunctionReturn(PETSC_SUCCESS);
    889: }

    891: /*@C
    892:    DSVectors - Compute vectors associated to the dense system such
    893:    as eigenvectors.

    895:    Logically Collective

    897:    Input Parameters:
    898: +  ds  - the direct solver context
    899: -  mat - the matrix, used to indicate which vectors are required

    901:    Input/Output Parameter:
    902: .  j   - (optional) index of vector to be computed

    904:    Output Parameter:
    905: .  rnorm - (optional) computed residual norm

    907:    Notes:
    908:    Allowed values for mat are DS_MAT_X, DS_MAT_Y, DS_MAT_U and DS_MAT_V, to
    909:    compute right or left eigenvectors, or left or right singular vectors,
    910:    respectively.

    912:    If NULL is passed in argument j then all vectors are computed,
    913:    otherwise j indicates which vector must be computed. In real non-symmetric
    914:    problems, on exit the index j will be incremented when a complex conjugate
    915:    pair is found.

    917:    This function can be invoked after the dense problem has been solved,
    918:    to get the residual norm estimate of the associated Ritz pair. In that
    919:    case, the relevant information is returned in rnorm.

    921:    For computing eigenvectors, LAPACK's _trevc is used so the matrix must
    922:    be in (quasi-)triangular form, or call DSSolve() first.

    924:    Level: intermediate

    926: .seealso: DSSolve()
    927: @*/
    928: PetscErrorCode DSVectors(DS ds,DSMatType mat,PetscInt *j,PetscReal *rnorm)
    929: {
    930:   PetscFunctionBegin;
    933:   DSCheckAlloc(ds,1);
    935:   PetscCheck(mat<DS_NUM_MAT,PetscObjectComm((PetscObject)ds),PETSC_ERR_ARG_WRONG,"Invalid matrix");
    936:   PetscCheck(!rnorm || j,PetscObjectComm((PetscObject)ds),PETSC_ERR_ORDER,"Must give a value of j");
    937:   if (!ds->omat[mat]) PetscCall(DSAllocateMat_Private(ds,mat));
    938:   if (!j) PetscCall(PetscInfo(ds,"Computing all vectors on %s\n",DSMatName[mat]));
    939:   PetscCall(PetscLogEventBegin(DS_Vectors,ds,0,0,0));
    940:   PetscCall(PetscFPTrapPush(PETSC_FP_TRAP_OFF));
    941:   PetscUseTypeMethod(ds,vectors,mat,j,rnorm);
    942:   PetscCall(PetscFPTrapPop());
    943:   PetscCall(PetscLogEventEnd(DS_Vectors,ds,0,0,0));
    944:   PetscCall(PetscObjectStateIncrease((PetscObject)ds));
    945:   PetscFunctionReturn(PETSC_SUCCESS);
    946: }

    948: /*@
    949:    DSUpdateExtraRow - Performs all necessary operations so that the extra
    950:    row gets up-to-date after a call to DSSolve().

    952:    Logically Collective

    954:    Input Parameters:
    955: .  ds - the direct solver context

    957:    Level: advanced

    959: .seealso: DSSolve(), DSSetExtraRow()
    960: @*/
    961: PetscErrorCode DSUpdateExtraRow(DS ds)
    962: {
    963:   PetscFunctionBegin;
    966:   DSCheckAlloc(ds,1);
    967:   PetscCheck(ds->extrarow,PetscObjectComm((PetscObject)ds),PETSC_ERR_ARG_WRONGSTATE,"Should have called DSSetExtraRow");
    968:   PetscCall(PetscInfo(ds,"Updating extra row\n"));
    969:   PetscCall(PetscLogEventBegin(DS_Other,ds,0,0,0));
    970:   PetscCall(PetscFPTrapPush(PETSC_FP_TRAP_OFF));
    971:   PetscUseTypeMethod(ds,update);
    972:   PetscCall(PetscFPTrapPop());
    973:   PetscCall(PetscLogEventEnd(DS_Other,ds,0,0,0));
    974:   PetscFunctionReturn(PETSC_SUCCESS);
    975: }

    977: /*@
    978:    DSCond - Compute the condition number.

    980:    Logically Collective

    982:    Input Parameters:
    983: +  ds - the direct solver context
    984: -  cond - the computed condition number

    986:    Notes:
    987:    In standard eigenvalue problems, returns the inf-norm condition number of the first
    988:    matrix, computed as cond(A) = norm(A)*norm(inv(A)).

    990:    In GSVD problems, returns the maximum of cond(A) and cond(B), where cond(.) is
    991:    computed as the ratio of the largest and smallest singular values.

    993:    Does not take into account the extra row.

    995:    Level: advanced

    997: .seealso: DSSolve(), DSSetExtraRow()
    998: @*/
    999: PetscErrorCode DSCond(DS ds,PetscReal *cond)
    1000: {
    1001:   PetscFunctionBegin;
    1004:   DSCheckAlloc(ds,1);
    1005:   PetscAssertPointer(cond,2);
    1006:   PetscCall(PetscLogEventBegin(DS_Other,ds,0,0,0));
    1007:   PetscCall(PetscFPTrapPush(PETSC_FP_TRAP_OFF));
    1008:   PetscUseTypeMethod(ds,cond,cond);
    1009:   PetscCall(PetscFPTrapPop());
    1010:   PetscCall(PetscLogEventEnd(DS_Other,ds,0,0,0));
    1011:   PetscCall(PetscInfo(ds,"Computed condition number = %g\n",(double)*cond));
    1012:   PetscFunctionReturn(PETSC_SUCCESS);
    1013: }

    1015: /*@C
    1016:    DSTranslateHarmonic - Computes a translation of the dense system.

    1018:    Logically Collective

    1020:    Input Parameters:
    1021: +  ds      - the direct solver context
    1022: .  tau     - the translation amount
    1023: .  beta    - last component of vector b
    1024: -  recover - boolean flag to indicate whether to recover or not

    1026:    Output Parameters:
    1027: +  g       - the computed vector (optional)
    1028: -  gamma   - scale factor (optional)

    1030:    Notes:
    1031:    This function is intended for use in the context of Krylov methods only.
    1032:    It computes a translation of a Krylov decomposition in order to extract
    1033:    eigenpair approximations by harmonic Rayleigh-Ritz.
    1034:    The matrix is updated as A + g*b' where g = (A-tau*eye(n))'\b and
    1035:    vector b is assumed to be beta*e_n^T.

    1037:    The gamma factor is defined as sqrt(1+g'*g) and can be interpreted as
    1038:    the factor by which the residual of the Krylov decomposition is scaled.

    1040:    If the recover flag is activated, the computed translation undoes the
    1041:    translation done previously. In that case, parameter tau is ignored.

    1043:    Level: developer

    1045: .seealso: DSTranslateRKS()
    1046: @*/
    1047: PetscErrorCode DSTranslateHarmonic(DS ds,PetscScalar tau,PetscReal beta,PetscBool recover,PetscScalar *g,PetscReal *gamma)
    1048: {
    1049:   PetscFunctionBegin;
    1052:   DSCheckAlloc(ds,1);
    1053:   if (recover) PetscCall(PetscInfo(ds,"Undoing the translation\n"));
    1054:   else PetscCall(PetscInfo(ds,"Computing the translation\n"));
    1055:   PetscCall(PetscLogEventBegin(DS_Other,ds,0,0,0));
    1056:   PetscCall(PetscFPTrapPush(PETSC_FP_TRAP_OFF));
    1057:   PetscUseTypeMethod(ds,transharm,tau,beta,recover,g,gamma);
    1058:   PetscCall(PetscFPTrapPop());
    1059:   PetscCall(PetscLogEventEnd(DS_Other,ds,0,0,0));
    1060:   ds->state = DS_STATE_RAW;
    1061:   PetscCall(PetscObjectStateIncrease((PetscObject)ds));
    1062:   PetscFunctionReturn(PETSC_SUCCESS);
    1063: }

    1065: /*@
    1066:    DSTranslateRKS - Computes a modification of the dense system corresponding
    1067:    to an update of the shift in a rational Krylov method.

    1069:    Logically Collective

    1071:    Input Parameters:
    1072: +  ds    - the direct solver context
    1073: -  alpha - the translation amount

    1075:    Notes:
    1076:    This function is intended for use in the context of Krylov methods only.
    1077:    It takes the leading (k+1,k) submatrix of A, containing the truncated
    1078:    Rayleigh quotient of a Krylov-Schur relation computed from a shift
    1079:    sigma1 and transforms it to obtain a Krylov relation as if computed
    1080:    from a different shift sigma2. The new matrix is computed as
    1081:    1.0/alpha*(eye(k)-Q*inv(R)), where [Q,R]=qr(eye(k)-alpha*A) and
    1082:    alpha = sigma1-sigma2.

    1084:    Matrix Q is placed in DS_MAT_Q so that it can be used to update the
    1085:    Krylov basis.

    1087:    Level: developer

    1089: .seealso: DSTranslateHarmonic()
    1090: @*/
    1091: PetscErrorCode DSTranslateRKS(DS ds,PetscScalar alpha)
    1092: {
    1093:   PetscFunctionBegin;
    1096:   DSCheckAlloc(ds,1);
    1097:   PetscCall(PetscInfo(ds,"Translating with alpha=%g\n",(double)PetscRealPart(alpha)));
    1098:   PetscCall(PetscLogEventBegin(DS_Other,ds,0,0,0));
    1099:   PetscCall(PetscFPTrapPush(PETSC_FP_TRAP_OFF));
    1100:   PetscUseTypeMethod(ds,transrks,alpha);
    1101:   PetscCall(PetscFPTrapPop());
    1102:   PetscCall(PetscLogEventEnd(DS_Other,ds,0,0,0));
    1103:   ds->state   = DS_STATE_RAW;
    1104:   ds->compact = PETSC_FALSE;
    1105:   PetscCall(PetscObjectStateIncrease((PetscObject)ds));
    1106:   PetscFunctionReturn(PETSC_SUCCESS);
    1107: }