Date: 2022-08-09T09:05:22+00:00

Actual source code: dssvd.c
slepc-3.17.2 2022-08-09
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: */

     11: #include <slepc/private/dsimpl.h>
     12: #include <slepcblaslapack.h>

     14: typedef struct {
     15:   PetscInt m;              /* number of columns */
     16:   PetscInt t;              /* number of rows of V after truncating */
     17: } DS_SVD;

     19: PetscErrorCode DSAllocate_SVD(DS ds,PetscInt ld)
     20: {
     21:   DSAllocateMat_Private(ds,DS_MAT_A);
     22:   DSAllocateMat_Private(ds,DS_MAT_U);
     23:   DSAllocateMat_Private(ds,DS_MAT_V);
     24:   DSAllocateMatReal_Private(ds,DS_MAT_T);
     25:   PetscFree(ds->perm);
     26:   PetscMalloc1(ld,&ds->perm);
     27:   PetscLogObjectMemory((PetscObject)ds,ld*sizeof(PetscInt));
     28:   PetscFunctionReturn(0);
     29: }

     31: /*   0       l           k                 n-1
     32:     -----------------------------------------
     33:     |*       .           .                  |
     34:     |  *     .           .                  |
     35:     |    *   .           .                  |
     36:     |      * .           .                  |
     37:     |        o           o                  |
     38:     |          o         o                  |
     39:     |            o       o                  |
     40:     |              o     o                  |
     41:     |                o   o                  |
     42:     |                  o o                  |
     43:     |                    o x                |
     44:     |                      x x              |
     45:     |                        x x            |
     46:     |                          x x          |
     47:     |                            x x        |
     48:     |                              x x      |
     49:     |                                x x    |
     50:     |                                  x x  |
     51:     |                                    x x|
     52:     |                                      x|
     53:     -----------------------------------------
     54: */

     56: static PetscErrorCode DSSwitchFormat_SVD(DS ds)
     57: {
     58:   DS_SVD         *ctx = (DS_SVD*)ds->data;
     59:   PetscReal      *T = ds->rmat[DS_MAT_T];
     60:   PetscScalar    *A = ds->mat[DS_MAT_A];
     61:   PetscInt       i,m=ctx->m,k=ds->k,ld=ds->ld;

     64:   /* switch from compact (arrow) to dense storage */
     65:   PetscArrayzero(A,ld*ld);
     66:   for (i=0;i<k;i++) {
     67:     A[i+i*ld] = T[i];
     68:     A[i+k*ld] = T[i+ld];
     69:   }
     70:   A[k+k*ld] = T[k];
     71:   for (i=k+1;i<m;i++) {
     72:     A[i+i*ld]   = T[i];
     73:     A[i-1+i*ld] = T[i-1+ld];
     74:   }
     75:   PetscFunctionReturn(0);
     76: }

     78: PetscErrorCode DSView_SVD(DS ds,PetscViewer viewer)
     79: {
     80:   DS_SVD            *ctx = (DS_SVD*)ds->data;
     81:   PetscViewerFormat format;
     82:   PetscInt          i,j,r,c,m=ctx->m,rows,cols;
     83:   PetscReal         value;

     85:   PetscViewerGetFormat(viewer,&format);
     86:   if (format == PETSC_VIEWER_ASCII_INFO) PetscFunctionReturn(0);
     87:   if (format == PETSC_VIEWER_ASCII_INFO_DETAIL) {
     88:     PetscViewerASCIIPrintf(viewer,"number of columns: %" PetscInt_FMT "\n",m);
     89:     PetscFunctionReturn(0);
     90:   }
     92:   if (ds->compact) {
     93:     PetscViewerASCIIUseTabs(viewer,PETSC_FALSE);
     94:     rows = ds->n;
     95:     cols = ds->extrarow? m+1: m;
     96:     if (format == PETSC_VIEWER_ASCII_MATLAB) {
     97:       PetscViewerASCIIPrintf(viewer,"%% Size = %" PetscInt_FMT " %" PetscInt_FMT "\n",rows,cols);
     98:       PetscViewerASCIIPrintf(viewer,"zzz = zeros(%" PetscInt_FMT ",3);\n",2*ds->n);
     99:       PetscViewerASCIIPrintf(viewer,"zzz = [\n");
    100:       for (i=0;i<PetscMin(ds->n,m);i++) PetscViewerASCIIPrintf(viewer,"%" PetscInt_FMT " %" PetscInt_FMT "  %18.16e\n",i+1,i+1,(double)*(ds->rmat[DS_MAT_T]+i));
    101:       for (i=0;i<cols-1;i++) {
    102:         r = PetscMax(i+2,ds->k+1);
    103:         c = i+1;
    104:         PetscViewerASCIIPrintf(viewer,"%" PetscInt_FMT " %" PetscInt_FMT "  %18.16e\n",c,r,(double)*(ds->rmat[DS_MAT_T]+ds->ld+i));
    105:       }
    106:       PetscViewerASCIIPrintf(viewer,"];\n%s = spconvert(zzz);\n",DSMatName[DS_MAT_T]);
    107:     } else {
    108:       for (i=0;i<rows;i++) {
    109:         for (j=0;j<cols;j++) {
    110:           if (i==j) value = *(ds->rmat[DS_MAT_T]+i);
    111:           else if (i<ds->k && j==ds->k) value = *(ds->rmat[DS_MAT_T]+ds->ld+PetscMin(i,j));
    112:           else if (i+1==j && i>=ds->k) value = *(ds->rmat[DS_MAT_T]+ds->ld+i);
    113:           else value = 0.0;
    114:           PetscViewerASCIIPrintf(viewer," %18.16e ",(double)value);
    115:         }
    116:         PetscViewerASCIIPrintf(viewer,"\n");
    117:       }
    118:     }
    119:     PetscViewerASCIIUseTabs(viewer,PETSC_TRUE);
    120:     PetscViewerFlush(viewer);
    121:   } else DSViewMat(ds,viewer,DS_MAT_A);
    122:   if (ds->state>DS_STATE_INTERMEDIATE) {
    123:     DSViewMat(ds,viewer,DS_MAT_U);
    124:     DSViewMat(ds,viewer,DS_MAT_V);
    125:   }
    126:   PetscFunctionReturn(0);
    127: }

    129: PetscErrorCode DSVectors_SVD(DS ds,DSMatType mat,PetscInt *j,PetscReal *rnorm)
    130: {
    131:   switch (mat) {
    132:     case DS_MAT_U:
    133:     case DS_MAT_V:
    134:       if (rnorm) *rnorm = 0.0;
    135:       break;
    136:     default:
    137:       SETERRQ(PetscObjectComm((PetscObject)ds),PETSC_ERR_ARG_OUTOFRANGE,"Invalid mat parameter");
    138:   }
    139:   PetscFunctionReturn(0);
    140: }

    142: PetscErrorCode DSSort_SVD(DS ds,PetscScalar *wr,PetscScalar *wi,PetscScalar *rr,PetscScalar *ri,PetscInt *k)
    143: {
    144:   DS_SVD         *ctx = (DS_SVD*)ds->data;
    145:   PetscInt       n,l,i,*perm,ld=ds->ld;
    146:   PetscScalar    *A;
    147:   PetscReal      *d;

    149:   if (!ds->sc) PetscFunctionReturn(0);
    151:   l = ds->l;
    152:   n = PetscMin(ds->n,ctx->m);
    153:   A = ds->mat[DS_MAT_A];
    154:   d = ds->rmat[DS_MAT_T];
    155:   perm = ds->perm;
    156:   if (!rr) DSSortEigenvaluesReal_Private(ds,d,perm);
    157:   else DSSortEigenvalues_Private(ds,rr,ri,perm,PETSC_FALSE);
    158:   for (i=l;i<n;i++) wr[i] = d[perm[i]];
    159:   DSPermuteBoth_Private(ds,l,n,ds->n,ctx->m,DS_MAT_U,DS_MAT_V,perm);
    160:   for (i=l;i<n;i++) d[i] = PetscRealPart(wr[i]);
    161:   if (!ds->compact) {
    162:     for (i=l;i<n;i++) A[i+i*ld] = wr[i];
    163:   }
    164:   PetscFunctionReturn(0);
    165: }

    167: PetscErrorCode DSUpdateExtraRow_SVD(DS ds)
    168: {
    169:   DS_SVD         *ctx = (DS_SVD*)ds->data;
    170:   PetscInt       i;
    171:   PetscBLASInt   n=0,m=0,ld,incx=1;
    172:   PetscScalar    *A,*U,*x,*y,one=1.0,zero=0.0;
    173:   PetscReal      *e,beta;

    176:   PetscBLASIntCast(ds->n,&n);
    177:   PetscBLASIntCast(ctx->m,&m);
    178:   PetscBLASIntCast(ds->ld,&ld);
    179:   A = ds->mat[DS_MAT_A];
    180:   U = ds->mat[DS_MAT_U];
    181:   e = ds->rmat[DS_MAT_T]+ld;

    183:   if (ds->compact) {
    184:     beta = e[m-1];   /* in compact, we assume all entries are zero except the last one */
    185:     for (i=0;i<n;i++) e[i] = PetscRealPart(beta*U[n-1+i*ld]);
    186:     ds->k = m;
    187:   } else {
    188:     DSAllocateWork_Private(ds,2*ld,0,0);
    189:     x = ds->work;
    190:     y = ds->work+ld;
    191:     for (i=0;i<n;i++) x[i] = PetscConj(A[i+m*ld]);
    192:     PetscStackCallBLAS("BLASgemv",BLASgemv_("C",&n,&n,&one,U,&ld,x,&incx,&zero,y,&incx));
    193:     for (i=0;i<n;i++) A[i+m*ld] = PetscConj(y[i]);
    194:     ds->k = m;
    195:   }
    196:   PetscFunctionReturn(0);
    197: }

    199: PetscErrorCode DSTruncate_SVD(DS ds,PetscInt n,PetscBool trim)
    200: {
    201:   PetscInt    i,ld=ds->ld,l=ds->l;
    202:   PetscScalar *A = ds->mat[DS_MAT_A];
    203:   DS_SVD      *ctx = (DS_SVD*)ds->data;

    205:   if (trim) {
    206:     if (!ds->compact && ds->extrarow) {   /* clean extra column */
    207:       for (i=l;i<ds->n;i++) A[i+ctx->m*ld] = 0.0;
    208:     }
    209:     ds->l  = 0;
    210:     ds->k  = 0;
    211:     ds->n  = n;
    212:     ctx->m = n;
    213:     ds->t  = ds->n;   /* truncated length equal to the new dimension */
    214:     ctx->t = ctx->m;  /* must also keep the previous dimension of V */
    215:   } else {
    216:     if (!ds->compact && ds->extrarow && ds->k==ds->n) {
    217:       /* copy entries of extra column to the new position, then clean last row */
    218:       for (i=l;i<n;i++) A[i+n*ld] = A[i+ctx->m*ld];
    219:       for (i=l;i<ds->n;i++) A[i+ctx->m*ld] = 0.0;
    220:     }
    221:     ds->k  = (ds->extrarow)? n: 0;
    222:     ds->t  = ds->n;   /* truncated length equal to previous dimension */
    223:     ctx->t = ctx->m;  /* must also keep the previous dimension of V */
    224:     ds->n  = n;
    225:     ctx->m = n;
    226:   }
    227:   PetscFunctionReturn(0);
    228: }

    230: PetscErrorCode DSSolve_SVD_DC(DS ds,PetscScalar *wr,PetscScalar *wi)
    231: {
    232:   DS_SVD         *ctx = (DS_SVD*)ds->data;
    233:   PetscInt       i,j;
    234:   PetscBLASInt   n1,m1,info,l = 0,n = 0,m = 0,nm,ld,off,lwork;
    235:   PetscScalar    *A,*U,*V,*W,qwork;
    236:   PetscReal      *d,*e,*Ur,*Vr;

    239:   PetscBLASIntCast(ds->n,&n);
    240:   PetscBLASIntCast(ctx->m,&m);
    241:   PetscBLASIntCast(ds->l,&l);
    242:   PetscBLASIntCast(ds->ld,&ld);
    243:   n1 = n-l;     /* n1 = size of leading block, excl. locked + size of trailing block */
    244:   m1 = m-l;
    245:   off = l+l*ld;
    246:   A = ds->mat[DS_MAT_A];
    247:   U = ds->mat[DS_MAT_U];
    248:   V = ds->mat[DS_MAT_V];
    249:   d = ds->rmat[DS_MAT_T];
    250:   e = ds->rmat[DS_MAT_T]+ld;
    251:   PetscArrayzero(U,ld*ld);
    252:   for (i=0;i<l;i++) U[i+i*ld] = 1.0;
    253:   PetscArrayzero(V,ld*ld);
    254:   for (i=0;i<l;i++) V[i+i*ld] = 1.0;

    256:   if (ds->state>DS_STATE_RAW) {
    257:     /* solve bidiagonal SVD problem */
    258:     for (i=0;i<l;i++) wr[i] = d[i];
    259: #if defined(PETSC_USE_COMPLEX)
    260:     DSAllocateWork_Private(ds,0,3*n1*n1+4*n1,8*n1);
    261:     DSAllocateMatReal_Private(ds,DS_MAT_U);
    262:     DSAllocateMatReal_Private(ds,DS_MAT_V);
    263:     Ur = ds->rmat[DS_MAT_U];
    264:     Vr = ds->rmat[DS_MAT_V];
    265: #else
    266:     DSAllocateWork_Private(ds,0,3*n1*n1+4*n1+ld*ld,8*n1);
    267:     Ur = U;
    268:     Vr = ds->rwork+3*n1*n1+4*n1;
    269: #endif
    270:     PetscStackCallBLAS("LAPACKbdsdc",LAPACKbdsdc_("U","I",&n1,d+l,e+l,Ur+off,&ld,Vr+off,&ld,NULL,NULL,ds->rwork,ds->iwork,&info));
    271:     SlepcCheckLapackInfo("bdsdc",info);
    272:     for (i=l;i<n;i++) {
    273:       for (j=l;j<n;j++) {
    274: #if defined(PETSC_USE_COMPLEX)
    275:         U[i+j*ld] = Ur[i+j*ld];
    276: #endif
    277:         V[i+j*ld] = PetscConj(Vr[j+i*ld]);  /* transpose VT returned by Lapack */
    278:       }
    279:     }
    280:   } else {
    281:     /* solve general rectangular SVD problem */
    282:     DSAllocateMat_Private(ds,DS_MAT_W);
    283:     W = ds->mat[DS_MAT_W];
    284:     if (ds->compact) DSSwitchFormat_SVD(ds);
    285:     for (i=0;i<l;i++) wr[i] = d[i];
    286:     nm = PetscMin(n,m);
    287:     DSAllocateWork_Private(ds,0,0,8*nm);
    288:     lwork = -1;
    289: #if defined(PETSC_USE_COMPLEX)
    290:     DSAllocateWork_Private(ds,0,5*nm*nm+7*nm,0);
    291:     PetscStackCallBLAS("LAPACKgesdd",LAPACKgesdd_("A",&n1,&m1,A+off,&ld,d+l,U+off,&ld,W+off,&ld,&qwork,&lwork,ds->rwork,ds->iwork,&info));
    292: #else
    293:     PetscStackCallBLAS("LAPACKgesdd",LAPACKgesdd_("A",&n1,&m1,A+off,&ld,d+l,U+off,&ld,W+off,&ld,&qwork,&lwork,ds->iwork,&info));
    294: #endif
    295:     SlepcCheckLapackInfo("gesdd",info);
    296:     PetscBLASIntCast((PetscInt)PetscRealPart(qwork),&lwork);
    297:     DSAllocateWork_Private(ds,lwork,0,0);
    298: #if defined(PETSC_USE_COMPLEX)
    299:     PetscStackCallBLAS("LAPACKgesdd",LAPACKgesdd_("A",&n1,&m1,A+off,&ld,d+l,U+off,&ld,W+off,&ld,ds->work,&lwork,ds->rwork,ds->iwork,&info));
    300: #else
    301:     PetscStackCallBLAS("LAPACKgesdd",LAPACKgesdd_("A",&n1,&m1,A+off,&ld,d+l,U+off,&ld,W+off,&ld,ds->work,&lwork,ds->iwork,&info));
    302: #endif
    303:     SlepcCheckLapackInfo("gesdd",info);
    304:     for (i=l;i<m;i++) {
    305:       for (j=l;j<m;j++) V[i+j*ld] = PetscConj(W[j+i*ld]);  /* transpose VT returned by Lapack */
    306:     }
    307:   }
    308:   for (i=l;i<PetscMin(ds->n,ctx->m);i++) wr[i] = d[i];

    310:   /* create diagonal matrix as a result */
    311:   if (ds->compact) PetscArrayzero(e,n-1);
    312:   else {
    313:     for (i=l;i<m;i++) PetscArrayzero(A+l+i*ld,n-l);
    314:     for (i=l;i<n;i++) A[i+i*ld] = d[i];
    315:   }
    316:   PetscFunctionReturn(0);
    317: }

    319: PetscErrorCode DSSynchronize_SVD(DS ds,PetscScalar eigr[],PetscScalar eigi[])
    320: {
    321:   PetscInt       ld=ds->ld,l=ds->l,k=0,kr=0;
    322:   PetscMPIInt    n,rank,off=0,size,ldn,ld3;

    324:   if (ds->compact) kr = 3*ld;
    325:   else k = (ds->n-l)*ld;
    326:   if (ds->state>DS_STATE_RAW) k += 2*(ds->n-l)*ld;
    327:   if (eigr) k += ds->n-l;
    328:   DSAllocateWork_Private(ds,k+kr,0,0);
    329:   PetscMPIIntCast(k*sizeof(PetscScalar)+kr*sizeof(PetscReal),&size);
    330:   PetscMPIIntCast(ds->n-l,&n);
    331:   PetscMPIIntCast(ld*(ds->n-l),&ldn);
    332:   PetscMPIIntCast(3*ld,&ld3);
    333:   MPI_Comm_rank(PetscObjectComm((PetscObject)ds),&rank);
    334:   if (!rank) {
    335:     if (ds->compact) MPI_Pack(ds->rmat[DS_MAT_T],ld3,MPIU_REAL,ds->work,size,&off,PetscObjectComm((PetscObject)ds));
    336:     else MPI_Pack(ds->mat[DS_MAT_A]+l*ld,ldn,MPIU_SCALAR,ds->work,size,&off,PetscObjectComm((PetscObject)ds));
    337:     if (ds->state>DS_STATE_RAW) {
    338:       MPI_Pack(ds->mat[DS_MAT_U]+l*ld,ldn,MPIU_SCALAR,ds->work,size,&off,PetscObjectComm((PetscObject)ds));
    339:       MPI_Pack(ds->mat[DS_MAT_V]+l*ld,ldn,MPIU_SCALAR,ds->work,size,&off,PetscObjectComm((PetscObject)ds));
    340:     }
    341:     if (eigr) MPI_Pack(eigr+l,n,MPIU_SCALAR,ds->work,size,&off,PetscObjectComm((PetscObject)ds));
    342:   }
    343:   MPI_Bcast(ds->work,size,MPI_BYTE,0,PetscObjectComm((PetscObject)ds));
    344:   if (rank) {
    345:     if (ds->compact) MPI_Unpack(ds->work,size,&off,ds->rmat[DS_MAT_T],ld3,MPIU_REAL,PetscObjectComm((PetscObject)ds));
    346:     else MPI_Unpack(ds->work,size,&off,ds->mat[DS_MAT_A]+l*ld,ldn,MPIU_SCALAR,PetscObjectComm((PetscObject)ds));
    347:     if (ds->state>DS_STATE_RAW) {
    348:       MPI_Unpack(ds->work,size,&off,ds->mat[DS_MAT_U]+l*ld,ldn,MPIU_SCALAR,PetscObjectComm((PetscObject)ds));
    349:       MPI_Unpack(ds->work,size,&off,ds->mat[DS_MAT_V]+l*ld,ldn,MPIU_SCALAR,PetscObjectComm((PetscObject)ds));
    350:     }
    351:     if (eigr) MPI_Unpack(ds->work,size,&off,eigr+l,n,MPIU_SCALAR,PetscObjectComm((PetscObject)ds));
    352:   }
    353:   PetscFunctionReturn(0);
    354: }

    356: PetscErrorCode DSMatGetSize_SVD(DS ds,DSMatType t,PetscInt *rows,PetscInt *cols)
    357: {
    358:   DS_SVD *ctx = (DS_SVD*)ds->data;

    361:   switch (t) {
    362:     case DS_MAT_A:
    363:     case DS_MAT_T:
    364:       *rows = ds->n;
    365:       *cols = ds->extrarow? ctx->m+1: ctx->m;
    366:       break;
    367:     case DS_MAT_U:
    368:       *rows = ds->state==DS_STATE_TRUNCATED? ds->t: ds->n;
    369:       *cols = ds->n;
    370:       break;
    371:     case DS_MAT_V:
    372:       *rows = ds->state==DS_STATE_TRUNCATED? ctx->t: ctx->m;
    373:       *cols = ctx->m;
    374:       break;
    375:     default:
    376:       SETERRQ(PetscObjectComm((PetscObject)ds),PETSC_ERR_ARG_OUTOFRANGE,"Invalid t parameter");
    377:   }
    378:   PetscFunctionReturn(0);
    379: }

    381: static PetscErrorCode DSSVDSetDimensions_SVD(DS ds,PetscInt m)
    382: {
    383:   DS_SVD *ctx = (DS_SVD*)ds->data;

    385:   DSCheckAlloc(ds,1);
    386:   if (m==PETSC_DECIDE || m==PETSC_DEFAULT) {
    387:     ctx->m = ds->ld;
    388:   } else {
    390:     ctx->m = m;
    391:   }
    392:   PetscFunctionReturn(0);
    393: }

    395: /*@
    396:    DSSVDSetDimensions - Sets the number of columns for a DSSVD.

    398:    Logically Collective on ds

    400:    Input Parameters:
    401: +  ds - the direct solver context
    402: -  m  - the number of columns

    404:    Notes:
    405:    This call is complementary to DSSetDimensions(), to provide a dimension
    406:    that is specific to this DS type.

    408:    Level: intermediate

    410: .seealso: DSSVDGetDimensions(), DSSetDimensions()
    411: @*/
    412: PetscErrorCode DSSVDSetDimensions(DS ds,PetscInt m)
    413: {
    416:   PetscTryMethod(ds,"DSSVDSetDimensions_C",(DS,PetscInt),(ds,m));
    417:   PetscFunctionReturn(0);
    418: }

    420: static PetscErrorCode DSSVDGetDimensions_SVD(DS ds,PetscInt *m)
    421: {
    422:   DS_SVD *ctx = (DS_SVD*)ds->data;

    424:   *m = ctx->m;
    425:   PetscFunctionReturn(0);
    426: }

    428: /*@
    429:    DSSVDGetDimensions - Returns the number of columns for a DSSVD.

    431:    Not collective

    433:    Input Parameter:
    434: .  ds - the direct solver context

    436:    Output Parameters:
    437: .  m - the number of columns

    439:    Level: intermediate

    441: .seealso: DSSVDSetDimensions()
    442: @*/
    443: PetscErrorCode DSSVDGetDimensions(DS ds,PetscInt *m)
    444: {
    447:   PetscUseMethod(ds,"DSSVDGetDimensions_C",(DS,PetscInt*),(ds,m));
    448:   PetscFunctionReturn(0);
    449: }

    451: PetscErrorCode DSDestroy_SVD(DS ds)
    452: {
    453:   PetscFree(ds->data);
    454:   PetscObjectComposeFunction((PetscObject)ds,"DSSVDSetDimensions_C",NULL);
    455:   PetscObjectComposeFunction((PetscObject)ds,"DSSVDGetDimensions_C",NULL);
    456:   PetscFunctionReturn(0);
    457: }

    459: /*MC
    460:    DSSVD - Dense Singular Value Decomposition.

    462:    Level: beginner

    464:    Notes:
    465:    The problem is expressed as A = U*Sigma*V', where A is rectangular in
    466:    general, with n rows and m columns. Sigma is a diagonal matrix whose diagonal
    467:    elements are the arguments of DSSolve(). After solve, A is overwritten
    468:    with Sigma.

    470:    The orthogonal (or unitary) matrices of left and right singular vectors, U
    471:    and V, have size n and m, respectively. The number of columns m must
    472:    be specified via DSSVDSetDimensions().

    474:    If the DS object is in the intermediate state, A is assumed to be in upper
    475:    bidiagonal form (possibly with an arrow) and is stored in compact format
    476:    on matrix T. Otherwise, no particular structure is assumed. The compact
    477:    storage is implemented for the square case only, m=n. The extra row should
    478:    be interpreted in this case as an extra column.

    480:    Used DS matrices:
    481: +  DS_MAT_A - problem matrix
    482: -  DS_MAT_T - upper bidiagonal matrix

    484:    Implemented methods:
    485: .  0 - Divide and Conquer (_bdsdc or _gesdd)

    487: .seealso: DSCreate(), DSSetType(), DSType, DSSVDSetDimensions()
    488: M*/
    489: SLEPC_EXTERN PetscErrorCode DSCreate_SVD(DS ds)
    490: {
    491:   DS_SVD         *ctx;

    493:   PetscNewLog(ds,&ctx);
    494:   ds->data = (void*)ctx;

    496:   ds->ops->allocate      = DSAllocate_SVD;
    497:   ds->ops->view          = DSView_SVD;
    498:   ds->ops->vectors       = DSVectors_SVD;
    499:   ds->ops->solve[0]      = DSSolve_SVD_DC;
    500:   ds->ops->sort          = DSSort_SVD;
    501:   ds->ops->synchronize   = DSSynchronize_SVD;
    502:   ds->ops->truncate      = DSTruncate_SVD;
    503:   ds->ops->update        = DSUpdateExtraRow_SVD;
    504:   ds->ops->destroy       = DSDestroy_SVD;
    505:   ds->ops->matgetsize    = DSMatGetSize_SVD;
    506:   PetscObjectComposeFunction((PetscObject)ds,"DSSVDSetDimensions_C",DSSVDSetDimensions_SVD);
    507:   PetscObjectComposeFunction((PetscObject)ds,"DSSVDGetDimensions_C",DSSVDGetDimensions_SVD);
    508:   PetscFunctionReturn(0);
    509: }