Date: 2015-09-03T15:03:22+00:00

Actual source code: slepcutil.c
slepc-3.6.1 2015-09-03
Report Typos and Errors

      1: /*
      2:    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
      3:    SLEPc - Scalable Library for Eigenvalue Problem Computations
      4:    Copyright (c) 2002-2015, Universitat Politecnica de Valencia, Spain

      6:    This file is part of SLEPc.

      8:    SLEPc is free software: you can redistribute it and/or modify it under  the
      9:    terms of version 3 of the GNU Lesser General Public License as published by
     10:    the Free Software Foundation.

     12:    SLEPc  is  distributed in the hope that it will be useful, but WITHOUT  ANY
     13:    WARRANTY;  without even the implied warranty of MERCHANTABILITY or  FITNESS
     14:    FOR  A  PARTICULAR PURPOSE. See the GNU Lesser General Public  License  for
     15:    more details.

     17:    You  should have received a copy of the GNU Lesser General  Public  License
     18:    along with SLEPc. If not, see <http://www.gnu.org/licenses/>.
     19:    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
     20: */

     22: #include <slepc/private/slepcimpl.h>            /*I "slepcsys.h" I*/

     26: /*@C
     27:    SlepcVecNormalize - Normalizes a possibly complex vector by the 2-norm.

     29:    Collective on Vec

     31:    Input parameters:
     32: +  xr - the real part of the vector (overwritten on output)
     33: .  xi - the imaginary part of the vector (not referenced if iscomplex is false)
     34: -  iscomplex - a flag indicating if the vector is complex

     36:    Output parameter:
     37: .  norm - the vector norm before normalization (can be set to NULL)

     39:    Level: developer
     40: @*/
     41: PetscErrorCode SlepcVecNormalize(Vec xr,Vec xi,PetscBool iscomplex,PetscReal *norm)
     42: {
     44: #if !defined(PETSC_USE_COMPLEX)
     45:   PetscReal      normr,normi,alpha;
     46: #endif

     50: #if !defined(PETSC_USE_COMPLEX)
     51:   if (iscomplex) {
     53:     VecNormBegin(xr,NORM_2,&normr);
     54:     VecNormBegin(xi,NORM_2,&normi);
     55:     VecNormEnd(xr,NORM_2,&normr);
     56:     VecNormEnd(xi,NORM_2,&normi);
     57:     alpha = SlepcAbsEigenvalue(normr,normi);
     58:     if (norm) *norm = alpha;
     59:     alpha = 1.0 / alpha;
     60:     VecScale(xr,alpha);
     61:     VecScale(xi,alpha);
     62:   } else
     63: #endif
     64:   {
     65:     VecNormalize(xr,norm);
     66:   }
     67:   return(0);
     68: }

     72: /*@C
     73:    SlepcMatConvertSeqDense - Converts a parallel matrix to another one in sequential
     74:    dense format replicating the values in every processor.

     76:    Collective on Mat

     78:    Input parameters:
     79: +  A  - the source matrix
     80: -  B  - the target matrix

     82:    Level: developer
     83: @*/
     84: PetscErrorCode SlepcMatConvertSeqDense(Mat mat,Mat *newmat)
     85: {
     87:   PetscInt       m,n;
     88:   PetscMPIInt    size;
     89:   PetscBool      flg;
     90:   Mat            *M;
     91:   IS             isrow,iscol;

     96:   MPI_Comm_size(PetscObjectComm((PetscObject)mat),&size);
     97:   if (size > 1) {
     98:     MatHasOperation(mat,MATOP_GET_SUBMATRICES,&flg);
     99:     if (!flg) SETERRQ1(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Mat type %s",((PetscObject)mat)->type_name);

    101:     /* assemble full matrix on every processor */
    102:     MatGetSize(mat,&m,&n);
    103:     ISCreateStride(PETSC_COMM_SELF,m,0,1,&isrow);
    104:     ISCreateStride(PETSC_COMM_SELF,n,0,1,&iscol);
    105:     MatGetSubMatrices(mat,1,&isrow,&iscol,MAT_INITIAL_MATRIX,&M);
    106:     ISDestroy(&isrow);
    107:     ISDestroy(&iscol);

    109:     /* Fake support for "inplace" convert */
    110:     if (*newmat == mat) {
    111:       MatDestroy(&mat);
    112:     }

    114:     /* convert matrix to MatSeqDense */
    115:     MatConvert(*M,MATSEQDENSE,MAT_INITIAL_MATRIX,newmat);
    116:     MatDestroyMatrices(1,&M);
    117:   } else {
    118:     /* convert matrix to MatSeqDense */
    119:     MatConvert(mat,MATSEQDENSE,MAT_INITIAL_MATRIX,newmat);
    120:   }
    121:   return(0);
    122: }

    126: static PetscErrorCode SlepcMatTile_SeqAIJ(PetscScalar a,Mat A,PetscScalar b,Mat B,PetscScalar c,Mat C,PetscScalar d,Mat D,Mat G)
    127: {
    128:   PetscErrorCode    ierr;
    129:   PetscInt          i,j,M1,M2,N1,N2,*nnz,ncols,*scols;
    130:   PetscScalar       *svals,*buf;
    131:   const PetscInt    *cols;
    132:   const PetscScalar *vals;

    135:   MatGetSize(A,&M1,&N1);
    136:   MatGetSize(D,&M2,&N2);

    138:   PetscCalloc1(M1+M2,&nnz);
    139:   /* Preallocate for A */
    140:   if (a!=0.0) {
    141:     for (i=0;i<M1;i++) {
    142:       MatGetRow(A,i,&ncols,NULL,NULL);
    143:       nnz[i] += ncols;
    144:       MatRestoreRow(A,i,&ncols,NULL,NULL);
    145:     }
    146:   }
    147:   /* Preallocate for B */
    148:   if (b!=0.0) {
    149:     for (i=0;i<M1;i++) {
    150:       MatGetRow(B,i,&ncols,NULL,NULL);
    151:       nnz[i] += ncols;
    152:       MatRestoreRow(B,i,&ncols,NULL,NULL);
    153:     }
    154:   }
    155:   /* Preallocate for C */
    156:   if (c!=0.0) {
    157:     for (i=0;i<M2;i++) {
    158:       MatGetRow(C,i,&ncols,NULL,NULL);
    159:       nnz[i+M1] += ncols;
    160:       MatRestoreRow(C,i,&ncols,NULL,NULL);
    161:     }
    162:   }
    163:   /* Preallocate for D */
    164:   if (d!=0.0) {
    165:     for (i=0;i<M2;i++) {
    166:       MatGetRow(D,i,&ncols,NULL,NULL);
    167:       nnz[i+M1] += ncols;
    168:       MatRestoreRow(D,i,&ncols,NULL,NULL);
    169:     }
    170:   }
    171:   MatSeqAIJSetPreallocation(G,0,nnz);
    172:   PetscFree(nnz);

    174:   PetscMalloc2(PetscMax(N1,N2),&buf,PetscMax(N1,N2),&scols);
    175:   /* Transfer A */
    176:   if (a!=0.0) {
    177:     for (i=0;i<M1;i++) {
    178:       MatGetRow(A,i,&ncols,&cols,&vals);
    179:       if (a!=1.0) {
    180:         svals=buf;
    181:         for (j=0;j<ncols;j++) svals[j] = vals[j]*a;
    182:       } else svals=(PetscScalar*)vals;
    183:       MatSetValues(G,1,&i,ncols,cols,svals,INSERT_VALUES);
    184:       MatRestoreRow(A,i,&ncols,&cols,&vals);
    185:     }
    186:   }
    187:   /* Transfer B */
    188:   if (b!=0.0) {
    189:     for (i=0;i<M1;i++) {
    190:       MatGetRow(B,i,&ncols,&cols,&vals);
    191:       if (b!=1.0) {
    192:         svals=buf;
    193:         for (j=0;j<ncols;j++) svals[j] = vals[j]*b;
    194:       } else svals=(PetscScalar*)vals;
    195:       for (j=0;j<ncols;j++) scols[j] = cols[j]+N1;
    196:       MatSetValues(G,1,&i,ncols,scols,svals,INSERT_VALUES);
    197:       MatRestoreRow(B,i,&ncols,&cols,&vals);
    198:     }
    199:   }
    200:   /* Transfer C */
    201:   if (c!=0.0) {
    202:     for (i=0;i<M2;i++) {
    203:       MatGetRow(C,i,&ncols,&cols,&vals);
    204:       if (c!=1.0) {
    205:         svals=buf;
    206:         for (j=0;j<ncols;j++) svals[j] = vals[j]*c;
    207:       } else svals=(PetscScalar*)vals;
    208:       j = i+M1;
    209:       MatSetValues(G,1,&j,ncols,cols,svals,INSERT_VALUES);
    210:       MatRestoreRow(C,i,&ncols,&cols,&vals);
    211:     }
    212:   }
    213:   /* Transfer D */
    214:   if (d!=0.0) {
    215:     for (i=0;i<M2;i++) {
    216:       MatGetRow(D,i,&ncols,&cols,&vals);
    217:       if (d!=1.0) {
    218:         svals=buf;
    219:         for (j=0;j<ncols;j++) svals[j] = vals[j]*d;
    220:       } else svals=(PetscScalar*)vals;
    221:       for (j=0;j<ncols;j++) scols[j] = cols[j]+N1;
    222:       j = i+M1;
    223:       MatSetValues(G,1,&j,ncols,scols,svals,INSERT_VALUES);
    224:       MatRestoreRow(D,i,&ncols,&cols,&vals);
    225:     }
    226:   }
    227:   PetscFree2(buf,scols);
    228:   return(0);
    229: }

    233: static PetscErrorCode SlepcMatTile_MPIAIJ(PetscScalar a,Mat A,PetscScalar b,Mat B,PetscScalar c,Mat C,PetscScalar d,Mat D,Mat G)
    234: {
    236:   PetscMPIInt       np;
    237:   PetscInt          p,i,j,N1,N2,m1,m2,n1,n2,*map1,*map2;
    238:   PetscInt          *dnz,*onz,ncols,*scols,start,gstart;
    239:   PetscScalar       *svals,*buf;
    240:   const PetscInt    *cols,*mapptr1,*mapptr2;
    241:   const PetscScalar *vals;

    244:   MatGetSize(A,NULL,&N1);
    245:   MatGetLocalSize(A,&m1,&n1);
    246:   MatGetSize(D,NULL,&N2);
    247:   MatGetLocalSize(D,&m2,&n2);

    249:   /* Create mappings */
    250:   MPI_Comm_size(PetscObjectComm((PetscObject)G),&np);
    251:   MatGetOwnershipRangesColumn(A,&mapptr1);
    252:   MatGetOwnershipRangesColumn(B,&mapptr2);
    253:   PetscMalloc4(PetscMax(N1,N2),&buf,PetscMax(N1,N2),&scols,N1,&map1,N2,&map2);
    254:   for (p=0;p<np;p++) {
    255:     for (i=mapptr1[p];i<mapptr1[p+1];i++) map1[i] = i+mapptr2[p];
    256:   }
    257:   for (p=0;p<np;p++) {
    258:     for (i=mapptr2[p];i<mapptr2[p+1];i++) map2[i] = i+mapptr1[p+1];
    259:   }

    261:   MatPreallocateInitialize(PetscObjectComm((PetscObject)G),m1+m2,n1+n2,dnz,onz);
    262:   MatGetOwnershipRange(G,&gstart,NULL);
    263:   /* Preallocate for A */
    264:   if (a!=0.0) {
    265:     MatGetOwnershipRange(A,&start,NULL);
    266:     for (i=0;i<m1;i++) {
    267:       MatGetRow(A,i+start,&ncols,&cols,NULL);
    268:       for (j=0;j<ncols;j++) scols[j] = map1[cols[j]];
    269:       MatPreallocateSet(gstart+i,ncols,scols,dnz,onz);
    270:       MatRestoreRow(A,i+start,&ncols,&cols,NULL);
    271:     }
    272:   }
    273:   /* Preallocate for B */
    274:   if (b!=0.0) {
    275:     MatGetOwnershipRange(B,&start,NULL);
    276:     for (i=0;i<m1;i++) {
    277:       MatGetRow(B,i+start,&ncols,&cols,NULL);
    278:       for (j=0;j<ncols;j++) scols[j] = map2[cols[j]];
    279:       MatPreallocateSet(gstart+i,ncols,scols,dnz,onz);
    280:       MatRestoreRow(B,i+start,&ncols,&cols,NULL);
    281:     }
    282:   }
    283:   /* Preallocate for C */
    284:   if (c!=0.0) {
    285:     MatGetOwnershipRange(C,&start,NULL);
    286:     for (i=0;i<m2;i++) {
    287:       MatGetRow(C,i+start,&ncols,&cols,NULL);
    288:       for (j=0;j<ncols;j++) scols[j] = map1[cols[j]];
    289:       MatPreallocateSet(gstart+m1+i,ncols,scols,dnz,onz);
    290:       MatRestoreRow(C,i+start,&ncols,&cols,NULL);
    291:     }
    292:   }
    293:   /* Preallocate for D */
    294:   if (d!=0.0) {
    295:     MatGetOwnershipRange(D,&start,NULL);
    296:     for (i=0;i<m2;i++) {
    297:       MatGetRow(D,i+start,&ncols,&cols,NULL);
    298:       for (j=0;j<ncols;j++) scols[j] = map2[cols[j]];
    299:       MatPreallocateSet(gstart+m1+i,ncols,scols,dnz,onz);
    300:       MatRestoreRow(D,i+start,&ncols,&cols,NULL);
    301:     }
    302:   }
    303:   MatMPIAIJSetPreallocation(G,0,dnz,0,onz);
    304:   MatPreallocateFinalize(dnz,onz);

    306:   /* Transfer A */
    307:   if (a!=0.0) {
    308:     MatGetOwnershipRange(A,&start,NULL);
    309:     for (i=0;i<m1;i++) {
    310:       MatGetRow(A,i+start,&ncols,&cols,&vals);
    311:       if (a!=1.0) {
    312:         svals=buf;
    313:         for (j=0;j<ncols;j++) svals[j] = vals[j]*a;
    314:       } else svals=(PetscScalar*)vals;
    315:       for (j=0;j<ncols;j++) scols[j] = map1[cols[j]];
    316:       j = gstart+i;
    317:       MatSetValues(G,1,&j,ncols,scols,svals,INSERT_VALUES);
    318:       MatRestoreRow(A,i+start,&ncols,&cols,&vals);
    319:     }
    320:   }
    321:   /* Transfer B */
    322:   if (b!=0.0) {
    323:     MatGetOwnershipRange(B,&start,NULL);
    324:     for (i=0;i<m1;i++) {
    325:       MatGetRow(B,i+start,&ncols,&cols,&vals);
    326:       if (b!=1.0) {
    327:         svals=buf;
    328:         for (j=0;j<ncols;j++) svals[j] = vals[j]*b;
    329:       } else svals=(PetscScalar*)vals;
    330:       for (j=0;j<ncols;j++) scols[j] = map2[cols[j]];
    331:       j = gstart+i;
    332:       MatSetValues(G,1,&j,ncols,scols,svals,INSERT_VALUES);
    333:       MatRestoreRow(B,i+start,&ncols,&cols,&vals);
    334:     }
    335:   }
    336:   /* Transfer C */
    337:   if (c!=0.0) {
    338:     MatGetOwnershipRange(C,&start,NULL);
    339:     for (i=0;i<m2;i++) {
    340:       MatGetRow(C,i+start,&ncols,&cols,&vals);
    341:       if (c!=1.0) {
    342:         svals=buf;
    343:         for (j=0;j<ncols;j++) svals[j] = vals[j]*c;
    344:       } else svals=(PetscScalar*)vals;
    345:       for (j=0;j<ncols;j++) scols[j] = map1[cols[j]];
    346:       j = gstart+m1+i;
    347:       MatSetValues(G,1,&j,ncols,scols,svals,INSERT_VALUES);
    348:       MatRestoreRow(C,i+start,&ncols,&cols,&vals);
    349:     }
    350:   }
    351:   /* Transfer D */
    352:   if (d!=0.0) {
    353:     MatGetOwnershipRange(D,&start,NULL);
    354:     for (i=0;i<m2;i++) {
    355:       MatGetRow(D,i+start,&ncols,&cols,&vals);
    356:       if (d!=1.0) {
    357:         svals=buf;
    358:         for (j=0;j<ncols;j++) svals[j] = vals[j]*d;
    359:       } else svals=(PetscScalar*)vals;
    360:       for (j=0;j<ncols;j++) scols[j] = map2[cols[j]];
    361:       j = gstart+m1+i;
    362:       MatSetValues(G,1,&j,ncols,scols,svals,INSERT_VALUES);
    363:       MatRestoreRow(D,i+start,&ncols,&cols,&vals);
    364:     }
    365:   }
    366:   PetscFree4(buf,scols,map1,map2);
    367:   return(0);
    368: }

    372: /*@
    373:    SlepcMatTile - Explicitly build a matrix from four blocks, G = [ a*A b*B; c*C d*D ].

    375:    Collective on Mat

    377:    Input parameters:
    378: +  A - matrix for top-left block
    379: .  a - scaling factor for block A
    380: .  B - matrix for top-right block
    381: .  b - scaling factor for block B
    382: .  C - matrix for bottom-left block
    383: .  c - scaling factor for block C
    384: .  D - matrix for bottom-right block
    385: -  d - scaling factor for block D

    387:    Output parameter:
    388: .  G  - the resulting matrix

    390:    Notes:
    391:    In the case of a parallel matrix, a permuted version of G is returned. The permutation
    392:    is a perfect shuffle such that the local parts of A, B, C, D remain in the local part of
    393:    G for the same process.

    395:    Matrix G must be destroyed by the user.

    397:    Level: developer
    398: @*/
    399: PetscErrorCode SlepcMatTile(PetscScalar a,Mat A,PetscScalar b,Mat B,PetscScalar c,Mat C,PetscScalar d,Mat D,Mat *G)
    400: {
    402:   PetscInt       M1,M2,N1,N2,M,N,m1,m2,n1,n2,m,n;
    403:   PetscBool      flg1,flg2;

    415:   /* check row 1 */
    416:   MatGetSize(A,&M1,NULL);
    417:   MatGetLocalSize(A,&m1,NULL);
    418:   MatGetSize(B,&M,NULL);
    419:   MatGetLocalSize(B,&m,NULL);
    420:   if (M!=M1 || m!=m1) SETERRQ(PetscObjectComm((PetscObject)A),PETSC_ERR_ARG_INCOMP,"Incompatible dimensions");
    421:   /* check row 2 */
    422:   MatGetSize(C,&M2,NULL);
    423:   MatGetLocalSize(C,&m2,NULL);
    424:   MatGetSize(D,&M,NULL);
    425:   MatGetLocalSize(D,&m,NULL);
    426:   if (M!=M2 || m!=m2) SETERRQ(PetscObjectComm((PetscObject)A),PETSC_ERR_ARG_INCOMP,"Incompatible dimensions");
    427:   /* check column 1 */
    428:   MatGetSize(A,NULL,&N1);
    429:   MatGetLocalSize(A,NULL,&n1);
    430:   MatGetSize(C,NULL,&N);
    431:   MatGetLocalSize(C,NULL,&n);
    432:   if (N!=N1 || n!=n1) SETERRQ(PetscObjectComm((PetscObject)A),PETSC_ERR_ARG_INCOMP,"Incompatible dimensions");
    433:   /* check column 2 */
    434:   MatGetSize(B,NULL,&N2);
    435:   MatGetLocalSize(B,NULL,&n2);
    436:   MatGetSize(D,NULL,&N);
    437:   MatGetLocalSize(D,NULL,&n);
    438:   if (N!=N2 || n!=n2) SETERRQ(PetscObjectComm((PetscObject)A),PETSC_ERR_ARG_INCOMP,"Incompatible dimensions");

    440:   MatCreate(PetscObjectComm((PetscObject)A),G);
    441:   MatSetSizes(*G,m1+m2,n1+n2,M1+M2,N1+N2);
    442:   MatSetFromOptions(*G);
    443:   MatSetUp(*G);

    445:   PetscObjectTypeCompare((PetscObject)*G,MATMPIAIJ,&flg1);
    446:   PetscObjectTypeCompare((PetscObject)A,MATMPIAIJ,&flg2);
    447:   if (flg1 && flg2) {
    448:     SlepcMatTile_MPIAIJ(a,A,b,B,c,C,d,D,*G);
    449:   } else {
    450:     PetscObjectTypeCompare((PetscObject)*G,MATSEQAIJ,&flg1);
    451:     PetscObjectTypeCompare((PetscObject)A,MATSEQAIJ,&flg2);
    452:     if (flg1 && flg2) {
    453:       SlepcMatTile_SeqAIJ(a,A,b,B,c,C,d,D,*G);
    454:     } else SETERRQ(PetscObjectComm((PetscObject)A),PETSC_ERR_SUP,"Not implemented for this matrix type");
    455:   }
    456:   MatAssemblyBegin(*G,MAT_FINAL_ASSEMBLY);
    457:   MatAssemblyEnd(*G,MAT_FINAL_ASSEMBLY);
    458:   return(0);
    459: }

    463: /*@C
    464:    SlepcCheckOrthogonality - Checks (or prints) the level of orthogonality
    465:    of a set of vectors.

    467:    Collective on Vec

    469:    Input parameters:
    470: +  V  - a set of vectors
    471: .  nv - number of V vectors
    472: .  W  - an alternative set of vectors (optional)
    473: .  nw - number of W vectors
    474: .  B  - matrix defining the inner product (optional)
    475: -  viewer - optional visualization context

    477:    Output parameter:
    478: .  lev - level of orthogonality (optional)

    480:    Notes:
    481:    This function computes W'*V and prints the result. It is intended to check
    482:    the level of bi-orthogonality of the vectors in the two sets. If W is equal
    483:    to NULL then V is used, thus checking the orthogonality of the V vectors.

    485:    If matrix B is provided then the check uses the B-inner product, W'*B*V.

    487:    If lev is not NULL, it will contain the maximum entry of matrix
    488:    W'*V - I (in absolute value). Otherwise, the matrix W'*V is printed.

    490:    Level: developer
    491: @*/
    492: PetscErrorCode SlepcCheckOrthogonality(Vec *V,PetscInt nv,Vec *W,PetscInt nw,Mat B,PetscViewer viewer,PetscReal *lev)
    493: {
    495:   PetscInt       i,j;
    496:   PetscScalar    *vals;
    497:   PetscBool      isascii;
    498:   Vec            w;

    501:   if (nv<=0 || nw<=0) return(0);
    504:   if (!lev) {
    505:     if (!viewer) viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)*V));
    508:     PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&isascii);
    509:     if (!isascii) return(0);
    510:   }

    512:   PetscMalloc1(nv,&vals);
    513:   if (B) {
    514:     VecDuplicate(V[0],&w);
    515:   }
    516:   if (lev) *lev = 0.0;
    517:   for (i=0;i<nw;i++) {
    518:     if (B) {
    519:       if (W) {
    520:         MatMultTranspose(B,W[i],w);
    521:       } else {
    522:         MatMultTranspose(B,V[i],w);
    523:       }
    524:     } else {
    525:       if (W) w = W[i];
    526:       else w = V[i];
    527:     }
    528:     VecMDot(w,nv,V,vals);
    529:     for (j=0;j<nv;j++) {
    530:       if (lev) *lev = PetscMax(*lev,PetscAbsScalar((j==i)? (vals[j]-1.0): vals[j]));
    531:       else {
    532: #if !defined(PETSC_USE_COMPLEX)
    533:         PetscViewerASCIIPrintf(viewer," %12g  ",(double)vals[j]);
    534: #else
    535:         PetscViewerASCIIPrintf(viewer," %12g%+12gi ",(double)PetscRealPart(vals[j]),(double)PetscImaginaryPart(vals[j]));
    536: #endif
    537:       }
    538:     }
    539:     if (!lev) { PetscViewerASCIIPrintf(viewer,"\n"); }
    540:   }
    541:   PetscFree(vals);
    542:   if (B) {
    543:     VecDestroy(&w);
    544:   }
    545:   return(0);
    546: }

    550: /*
    551:   Clean up context used in monitors of type XXXMonitorConverged.
    552:   This function is shared by EPS, SVD, PEP
    553: */
    554: PetscErrorCode SlepcConvMonitorDestroy(SlepcConvMonitor *ctx)
    555: {

    559:   if (!*ctx) return(0);
    560:   PetscViewerDestroy(&(*ctx)->viewer);
    561:   PetscFree(*ctx);
    562:   return(0);
    563: }

    567: /*
    568:    Given n vectors in V, this function gets references of them into W.
    569:    If m<0 then some previous non-processed vectors remain in W and must be freed.
    570:  */
    571: PetscErrorCode SlepcBasisReference_Private(PetscInt n,Vec *V,PetscInt *m,Vec **W)
    572: {
    574:   PetscInt       i;

    577:   SlepcBasisDestroy_Private(m,W);
    578:   if (n>0) {
    579:     PetscMalloc1(n,W);
    580:     for (i=0;i<n;i++) {
    581:       PetscObjectReference((PetscObject)V[i]);
    582:       (*W)[i] = V[i];
    583:     }
    584:     *m = -n;
    585:   }
    586:   return(0);
    587: }

    591: /*
    592:    Destroys a set of vectors.
    593:    A negative value of m indicates that W contains vectors to be destroyed.
    594:  */
    595: PetscErrorCode SlepcBasisDestroy_Private(PetscInt *m,Vec **W)
    596: {
    598:   PetscInt       i;

    601:   if (*m<0) {
    602:     for (i=0;i<-(*m);i++) {
    603:       VecDestroy(&(*W)[i]);
    604:     }
    605:     PetscFree(*W);
    606:   }
    607:   *m = 0;
    608:   return(0);
    609: }

    613: /*@C
    614:    SlepcSNPrintfScalar - Prints a PetscScalar variable to a string of
    615:    given length.

    617:    Not Collective

    619:    Input Parameters:
    620: +  str - the string to print to
    621: .  len - the length of str
    622: .  val - scalar value to be printed
    623: -  exp - to be used within an expression, print leading sign and parentheses
    624:          in case of nonzero imaginary part

    626:    Level: developer
    627: @*/
    628: PetscErrorCode SlepcSNPrintfScalar(char *str,size_t len,PetscScalar val,PetscBool exp)
    629: {
    631: #if defined(PETSC_USE_COMPLEX)
    632:   PetscReal      re,im;
    633: #endif

    636: #if !defined(PETSC_USE_COMPLEX)
    637:   if (exp) {
    638:     PetscSNPrintf(str,len,"%+g",(double)val);
    639:   } else {
    640:     PetscSNPrintf(str,len,"%g",(double)val);
    641:   }
    642: #else
    643:   re = PetscRealPart(val);
    644:   im = PetscImaginaryPart(val);
    645:   if (im!=0.0) {
    646:     if (exp) {
    647:       PetscSNPrintf(str,len,"+(%g%+gi)",(double)re,(double)im);
    648:     } else {
    649:       PetscSNPrintf(str,len,"%g%+gi",(double)re,(double)im);
    650:     }
    651:   } else {
    652:     if (exp) {
    653:       PetscSNPrintf(str,len,"%+g",(double)re);
    654:     } else {
    655:       PetscSNPrintf(str,len,"%g",(double)re);
    656:     }
    657:   }
    658: #endif
    659:   return(0);
    660: }