LCOV - code coverage report
Current view: top level - svd/impls/cyclic - cyclic.c (source / functions) Hit Total Coverage
Test: SLEPc Lines: 672 710 94.6 %
Date: 2024-04-25 00:29:53 Functions: 30 31 96.8 %
Legend: Lines: hit not hit

          Line data    Source code
       1             : /*
       2             :    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
       3             :    SLEPc - Scalable Library for Eigenvalue Problem Computations
       4             :    Copyright (c) 2002-, Universitat Politecnica de Valencia, Spain
       5             : 
       6             :    This file is part of SLEPc.
       7             :    SLEPc is distributed under a 2-clause BSD license (see LICENSE).
       8             :    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
       9             : */
      10             : /*
      11             :    SLEPc singular value solver: "cyclic"
      12             : 
      13             :    Method: Uses a Hermitian eigensolver for H(A) = [ 0  A ; A^T 0 ]
      14             : */
      15             : 
      16             : #include <slepc/private/svdimpl.h>                /*I "slepcsvd.h" I*/
      17             : #include <slepc/private/bvimpl.h>
      18             : #include "cyclic.h"
      19             : 
      20        2839 : static PetscErrorCode MatMult_Cyclic(Mat B,Vec x,Vec y)
      21             : {
      22        2839 :   SVD_CYCLIC_SHELL  *ctx;
      23        2839 :   const PetscScalar *px;
      24        2839 :   PetscScalar       *py;
      25        2839 :   PetscInt          m;
      26             : 
      27        2839 :   PetscFunctionBegin;
      28        2839 :   PetscCall(MatShellGetContext(B,&ctx));
      29        2839 :   PetscCall(MatGetLocalSize(ctx->A,&m,NULL));
      30        2839 :   PetscCall(VecGetArrayRead(x,&px));
      31        2839 :   PetscCall(VecGetArrayWrite(y,&py));
      32        2839 :   PetscCall(VecPlaceArray(ctx->x1,px));
      33        2839 :   PetscCall(VecPlaceArray(ctx->x2,px+m));
      34        2839 :   PetscCall(VecPlaceArray(ctx->y1,py));
      35        2839 :   PetscCall(VecPlaceArray(ctx->y2,py+m));
      36        2839 :   PetscCall(MatMult(ctx->A,ctx->x2,ctx->y1));
      37        2839 :   PetscCall(MatMult(ctx->AT,ctx->x1,ctx->y2));
      38        2839 :   PetscCall(VecResetArray(ctx->x1));
      39        2839 :   PetscCall(VecResetArray(ctx->x2));
      40        2839 :   PetscCall(VecResetArray(ctx->y1));
      41        2839 :   PetscCall(VecResetArray(ctx->y2));
      42        2839 :   PetscCall(VecRestoreArrayRead(x,&px));
      43        2839 :   PetscCall(VecRestoreArrayWrite(y,&py));
      44        2839 :   PetscFunctionReturn(PETSC_SUCCESS);
      45             : }
      46             : 
      47           0 : static PetscErrorCode MatGetDiagonal_Cyclic(Mat B,Vec diag)
      48             : {
      49           0 :   PetscFunctionBegin;
      50           0 :   PetscCall(VecSet(diag,0.0));
      51           0 :   PetscFunctionReturn(PETSC_SUCCESS);
      52             : }
      53             : 
      54          27 : static PetscErrorCode MatDestroy_Cyclic(Mat B)
      55             : {
      56          27 :   SVD_CYCLIC_SHELL *ctx;
      57             : 
      58          27 :   PetscFunctionBegin;
      59          27 :   PetscCall(MatShellGetContext(B,&ctx));
      60          27 :   PetscCall(VecDestroy(&ctx->x1));
      61          27 :   PetscCall(VecDestroy(&ctx->x2));
      62          27 :   PetscCall(VecDestroy(&ctx->y1));
      63          27 :   PetscCall(VecDestroy(&ctx->y2));
      64          27 :   if (ctx->misaligned) {
      65           0 :     PetscCall(VecDestroy(&ctx->wx2));
      66           0 :     PetscCall(VecDestroy(&ctx->wy2));
      67             :   }
      68          27 :   PetscCall(PetscFree(ctx));
      69          27 :   PetscFunctionReturn(PETSC_SUCCESS);
      70             : }
      71             : 
      72             : /*
      73             :    Builds cyclic matrix   C = | 0   A |
      74             :                               | AT  0 |
      75             : */
      76          42 : static PetscErrorCode SVDCyclicGetCyclicMat(SVD svd,Mat A,Mat AT,Mat *C)
      77             : {
      78          42 :   SVD_CYCLIC       *cyclic = (SVD_CYCLIC*)svd->data;
      79          42 :   SVD_CYCLIC_SHELL *ctx;
      80          42 :   PetscInt         i,M,N,m,n,Istart,Iend;
      81          42 :   VecType          vtype;
      82          42 :   Mat              Zm,Zn;
      83             : #if defined(PETSC_HAVE_CUDA)
      84             :   PetscBool        cuda;
      85             :   const PetscInt   *ranges;
      86             :   PetscMPIInt      size;
      87             : #endif
      88             : 
      89          42 :   PetscFunctionBegin;
      90          42 :   PetscCall(MatGetSize(A,&M,&N));
      91          42 :   PetscCall(MatGetLocalSize(A,&m,&n));
      92             : 
      93          42 :   if (cyclic->explicitmatrix) {
      94          15 :     PetscCheck(svd->expltrans,PetscObjectComm((PetscObject)svd),PETSC_ERR_SUP,"Cannot use explicit cyclic matrix with implicit transpose");
      95          15 :     PetscCall(MatCreate(PetscObjectComm((PetscObject)svd),&Zm));
      96          15 :     PetscCall(MatSetSizes(Zm,m,m,M,M));
      97          15 :     PetscCall(MatSetFromOptions(Zm));
      98          15 :     PetscCall(MatGetOwnershipRange(Zm,&Istart,&Iend));
      99        2957 :     for (i=Istart;i<Iend;i++) PetscCall(MatSetValue(Zm,i,i,0.0,INSERT_VALUES));
     100          15 :     PetscCall(MatAssemblyBegin(Zm,MAT_FINAL_ASSEMBLY));
     101          15 :     PetscCall(MatAssemblyEnd(Zm,MAT_FINAL_ASSEMBLY));
     102          15 :     PetscCall(MatCreate(PetscObjectComm((PetscObject)svd),&Zn));
     103          15 :     PetscCall(MatSetSizes(Zn,n,n,N,N));
     104          15 :     PetscCall(MatSetFromOptions(Zn));
     105          15 :     PetscCall(MatGetOwnershipRange(Zn,&Istart,&Iend));
     106        1524 :     for (i=Istart;i<Iend;i++) PetscCall(MatSetValue(Zn,i,i,0.0,INSERT_VALUES));
     107          15 :     PetscCall(MatAssemblyBegin(Zn,MAT_FINAL_ASSEMBLY));
     108          15 :     PetscCall(MatAssemblyEnd(Zn,MAT_FINAL_ASSEMBLY));
     109          15 :     PetscCall(MatCreateTile(1.0,Zm,1.0,A,1.0,AT,1.0,Zn,C));
     110          15 :     PetscCall(MatDestroy(&Zm));
     111          15 :     PetscCall(MatDestroy(&Zn));
     112             :   } else {
     113          27 :     PetscCall(PetscNew(&ctx));
     114          27 :     ctx->A       = A;
     115          27 :     ctx->AT      = AT;
     116          27 :     ctx->swapped = svd->swapped;
     117          27 :     PetscCall(MatCreateVecsEmpty(A,&ctx->x2,&ctx->x1));
     118          27 :     PetscCall(MatCreateVecsEmpty(A,&ctx->y2,&ctx->y1));
     119          27 :     PetscCall(MatCreateShell(PetscObjectComm((PetscObject)svd),m+n,m+n,M+N,M+N,ctx,C));
     120          27 :     PetscCall(MatShellSetOperation(*C,MATOP_GET_DIAGONAL,(void(*)(void))MatGetDiagonal_Cyclic));
     121          27 :     PetscCall(MatShellSetOperation(*C,MATOP_DESTROY,(void(*)(void))MatDestroy_Cyclic));
     122             : #if defined(PETSC_HAVE_CUDA)
     123             :     PetscCall(PetscObjectTypeCompareAny((PetscObject)(svd->swapped?AT:A),&cuda,MATSEQAIJCUSPARSE,MATMPIAIJCUSPARSE,""));
     124             :     if (cuda) PetscCall(MatShellSetOperation(*C,MATOP_MULT,(void(*)(void))MatMult_Cyclic_CUDA));
     125             :     else
     126             : #endif
     127          27 :       PetscCall(MatShellSetOperation(*C,MATOP_MULT,(void(*)(void))MatMult_Cyclic));
     128          27 :     PetscCall(MatGetVecType(A,&vtype));
     129          27 :     PetscCall(MatSetVecType(*C,vtype));
     130             : #if defined(PETSC_HAVE_CUDA)
     131             :     if (cuda) {
     132             :       /* check alignment of bottom block */
     133             :       PetscCallMPI(MPI_Comm_size(PetscObjectComm((PetscObject)ctx->x1),&size));
     134             :       PetscCall(VecGetOwnershipRanges(ctx->x1,&ranges));
     135             :       for (i=0;i<size;i++) {
     136             :         ctx->misaligned = (((ranges[i+1]-ranges[i])*sizeof(PetscScalar))%16)? PETSC_TRUE: PETSC_FALSE;
     137             :         if (ctx->misaligned) break;
     138             :       }
     139             :       if (ctx->misaligned) {  /* create work vectors for MatMult */
     140             :         PetscCall(VecDuplicate(ctx->x2,&ctx->wx2));
     141             :         PetscCall(VecDuplicate(ctx->y2,&ctx->wy2));
     142             :       }
     143             :     }
     144             : #endif
     145             :   }
     146          42 :   PetscFunctionReturn(PETSC_SUCCESS);
     147             : }
     148             : 
     149        6635 : static PetscErrorCode MatMult_ECross(Mat B,Vec x,Vec y)
     150             : {
     151        6635 :   SVD_CYCLIC_SHELL  *ctx;
     152        6635 :   const PetscScalar *px;
     153        6635 :   PetscScalar       *py;
     154        6635 :   PetscInt          mn,m,n;
     155             : 
     156        6635 :   PetscFunctionBegin;
     157        6635 :   PetscCall(MatShellGetContext(B,&ctx));
     158        6635 :   PetscCall(MatGetLocalSize(ctx->A,NULL,&n));
     159        6635 :   PetscCall(VecGetLocalSize(y,&mn));
     160        6635 :   m = mn-n;
     161        6635 :   PetscCall(VecGetArrayRead(x,&px));
     162        6635 :   PetscCall(VecGetArrayWrite(y,&py));
     163        6635 :   PetscCall(VecPlaceArray(ctx->x1,px));
     164        6635 :   PetscCall(VecPlaceArray(ctx->x2,px+m));
     165        6635 :   PetscCall(VecPlaceArray(ctx->y1,py));
     166        6635 :   PetscCall(VecPlaceArray(ctx->y2,py+m));
     167        6635 :   PetscCall(VecCopy(ctx->x1,ctx->y1));
     168        6635 :   PetscCall(MatMult(ctx->A,ctx->x2,ctx->w));
     169        6635 :   PetscCall(MatMult(ctx->AT,ctx->w,ctx->y2));
     170        6635 :   PetscCall(VecResetArray(ctx->x1));
     171        6635 :   PetscCall(VecResetArray(ctx->x2));
     172        6635 :   PetscCall(VecResetArray(ctx->y1));
     173        6635 :   PetscCall(VecResetArray(ctx->y2));
     174        6635 :   PetscCall(VecRestoreArrayRead(x,&px));
     175        6635 :   PetscCall(VecRestoreArrayWrite(y,&py));
     176        6635 :   PetscFunctionReturn(PETSC_SUCCESS);
     177             : }
     178             : 
     179           5 : static PetscErrorCode MatGetDiagonal_ECross(Mat B,Vec d)
     180             : {
     181           5 :   SVD_CYCLIC_SHELL  *ctx;
     182           5 :   PetscScalar       *pd;
     183           5 :   PetscMPIInt       len;
     184           5 :   PetscInt          mn,m,n,N,i,j,start,end,ncols;
     185           5 :   PetscScalar       *work1,*work2,*diag;
     186           5 :   const PetscInt    *cols;
     187           5 :   const PetscScalar *vals;
     188             : 
     189           5 :   PetscFunctionBegin;
     190           5 :   PetscCall(MatShellGetContext(B,&ctx));
     191           5 :   PetscCall(MatGetLocalSize(ctx->A,NULL,&n));
     192           5 :   PetscCall(VecGetLocalSize(d,&mn));
     193           5 :   m = mn-n;
     194           5 :   PetscCall(VecGetArrayWrite(d,&pd));
     195           5 :   PetscCall(VecPlaceArray(ctx->y1,pd));
     196           5 :   PetscCall(VecSet(ctx->y1,1.0));
     197           5 :   PetscCall(VecResetArray(ctx->y1));
     198           5 :   PetscCall(VecPlaceArray(ctx->y2,pd+m));
     199           5 :   if (!ctx->diag) {
     200             :     /* compute diagonal from rows and store in ctx->diag */
     201           5 :     PetscCall(VecDuplicate(ctx->y2,&ctx->diag));
     202           5 :     PetscCall(MatGetSize(ctx->A,NULL,&N));
     203           5 :     PetscCall(PetscCalloc2(N,&work1,N,&work2));
     204           5 :     if (ctx->swapped) {
     205           0 :       PetscCall(MatGetOwnershipRange(ctx->AT,&start,&end));
     206           0 :       for (i=start;i<end;i++) {
     207           0 :         PetscCall(MatGetRow(ctx->AT,i,&ncols,NULL,&vals));
     208           0 :         for (j=0;j<ncols;j++) work1[i] += vals[j]*vals[j];
     209           0 :         PetscCall(MatRestoreRow(ctx->AT,i,&ncols,NULL,&vals));
     210             :       }
     211             :     } else {
     212           5 :       PetscCall(MatGetOwnershipRange(ctx->A,&start,&end));
     213         111 :       for (i=start;i<end;i++) {
     214         106 :         PetscCall(MatGetRow(ctx->A,i,&ncols,&cols,&vals));
     215         806 :         for (j=0;j<ncols;j++) work1[cols[j]] += vals[j]*vals[j];
     216         106 :         PetscCall(MatRestoreRow(ctx->A,i,&ncols,&cols,&vals));
     217             :       }
     218             :     }
     219           5 :     PetscCall(PetscMPIIntCast(N,&len));
     220          20 :     PetscCall(MPIU_Allreduce(work1,work2,len,MPIU_SCALAR,MPIU_SUM,PetscObjectComm((PetscObject)B)));
     221           5 :     PetscCall(VecGetOwnershipRange(ctx->diag,&start,&end));
     222           5 :     PetscCall(VecGetArrayWrite(ctx->diag,&diag));
     223         100 :     for (i=start;i<end;i++) diag[i-start] = work2[i];
     224           5 :     PetscCall(VecRestoreArrayWrite(ctx->diag,&diag));
     225           5 :     PetscCall(PetscFree2(work1,work2));
     226             :   }
     227           5 :   PetscCall(VecCopy(ctx->diag,ctx->y2));
     228           5 :   PetscCall(VecResetArray(ctx->y2));
     229           5 :   PetscCall(VecRestoreArrayWrite(d,&pd));
     230           5 :   PetscFunctionReturn(PETSC_SUCCESS);
     231             : }
     232             : 
     233           5 : static PetscErrorCode MatDestroy_ECross(Mat B)
     234             : {
     235           5 :   SVD_CYCLIC_SHELL *ctx;
     236             : 
     237           5 :   PetscFunctionBegin;
     238           5 :   PetscCall(MatShellGetContext(B,&ctx));
     239           5 :   PetscCall(VecDestroy(&ctx->x1));
     240           5 :   PetscCall(VecDestroy(&ctx->x2));
     241           5 :   PetscCall(VecDestroy(&ctx->y1));
     242           5 :   PetscCall(VecDestroy(&ctx->y2));
     243           5 :   PetscCall(VecDestroy(&ctx->diag));
     244           5 :   PetscCall(VecDestroy(&ctx->w));
     245           5 :   if (ctx->misaligned) {
     246           0 :     PetscCall(VecDestroy(&ctx->wx2));
     247           0 :     PetscCall(VecDestroy(&ctx->wy2));
     248             :   }
     249           5 :   PetscCall(PetscFree(ctx));
     250           5 :   PetscFunctionReturn(PETSC_SUCCESS);
     251             : }
     252             : 
     253             : /*
     254             :    Builds extended cross product matrix   C = | I_m   0  |
     255             :                                               |  0  AT*A |
     256             :    t is an auxiliary Vec used to take the dimensions of the upper block
     257             : */
     258          10 : static PetscErrorCode SVDCyclicGetECrossMat(SVD svd,Mat A,Mat AT,Mat *C,Vec t)
     259             : {
     260          10 :   SVD_CYCLIC       *cyclic = (SVD_CYCLIC*)svd->data;
     261          10 :   SVD_CYCLIC_SHELL *ctx;
     262          10 :   PetscInt         i,M,N,m,n,Istart,Iend;
     263          10 :   VecType          vtype;
     264          10 :   Mat              Id,Zm,Zn,ATA;
     265             : #if defined(PETSC_HAVE_CUDA)
     266             :   PetscBool        cuda;
     267             :   const PetscInt   *ranges;
     268             :   PetscMPIInt      size;
     269             : #endif
     270             : 
     271          10 :   PetscFunctionBegin;
     272          10 :   PetscCall(MatGetSize(A,NULL,&N));
     273          10 :   PetscCall(MatGetLocalSize(A,NULL,&n));
     274          10 :   PetscCall(VecGetSize(t,&M));
     275          10 :   PetscCall(VecGetLocalSize(t,&m));
     276             : 
     277          10 :   if (cyclic->explicitmatrix) {
     278           5 :     PetscCheck(svd->expltrans,PetscObjectComm((PetscObject)svd),PETSC_ERR_SUP,"Cannot use explicit cyclic matrix with implicit transpose");
     279           5 :     PetscCall(MatCreateConstantDiagonal(PetscObjectComm((PetscObject)svd),m,m,M,M,1.0,&Id));
     280           5 :     PetscCall(MatCreate(PetscObjectComm((PetscObject)svd),&Zm));
     281           5 :     PetscCall(MatSetSizes(Zm,m,n,M,N));
     282           5 :     PetscCall(MatSetFromOptions(Zm));
     283           5 :     PetscCall(MatGetOwnershipRange(Zm,&Istart,&Iend));
     284         394 :     for (i=Istart;i<Iend;i++) {
     285         389 :       if (i<N) PetscCall(MatSetValue(Zm,i,i,0.0,INSERT_VALUES));
     286             :     }
     287           5 :     PetscCall(MatAssemblyBegin(Zm,MAT_FINAL_ASSEMBLY));
     288           5 :     PetscCall(MatAssemblyEnd(Zm,MAT_FINAL_ASSEMBLY));
     289           5 :     PetscCall(MatCreate(PetscObjectComm((PetscObject)svd),&Zn));
     290           5 :     PetscCall(MatSetSizes(Zn,n,m,N,M));
     291           5 :     PetscCall(MatSetFromOptions(Zn));
     292           5 :     PetscCall(MatGetOwnershipRange(Zn,&Istart,&Iend));
     293         404 :     for (i=Istart;i<Iend;i++) {
     294         399 :       if (i<m) PetscCall(MatSetValue(Zn,i,i,0.0,INSERT_VALUES));
     295             :     }
     296           5 :     PetscCall(MatAssemblyBegin(Zn,MAT_FINAL_ASSEMBLY));
     297           5 :     PetscCall(MatAssemblyEnd(Zn,MAT_FINAL_ASSEMBLY));
     298           5 :     PetscCall(MatProductCreate(AT,A,NULL,&ATA));
     299           5 :     PetscCall(MatProductSetType(ATA,MATPRODUCT_AB));
     300           5 :     PetscCall(MatProductSetFromOptions(ATA));
     301           5 :     PetscCall(MatProductSymbolic(ATA));
     302           5 :     PetscCall(MatProductNumeric(ATA));
     303           5 :     PetscCall(MatCreateTile(1.0,Id,1.0,Zm,1.0,Zn,1.0,ATA,C));
     304           5 :     PetscCall(MatDestroy(&Id));
     305           5 :     PetscCall(MatDestroy(&Zm));
     306           5 :     PetscCall(MatDestroy(&Zn));
     307           5 :     PetscCall(MatDestroy(&ATA));
     308             :   } else {
     309           5 :     PetscCall(PetscNew(&ctx));
     310           5 :     ctx->A       = A;
     311           5 :     ctx->AT      = AT;
     312           5 :     ctx->swapped = svd->swapped;
     313           5 :     PetscCall(VecDuplicateEmpty(t,&ctx->x1));
     314           5 :     PetscCall(VecDuplicateEmpty(t,&ctx->y1));
     315           5 :     PetscCall(MatCreateVecsEmpty(A,&ctx->x2,NULL));
     316           5 :     PetscCall(MatCreateVecsEmpty(A,&ctx->y2,NULL));
     317           5 :     PetscCall(MatCreateVecs(A,NULL,&ctx->w));
     318           5 :     PetscCall(MatCreateShell(PetscObjectComm((PetscObject)svd),m+n,m+n,M+N,M+N,ctx,C));
     319           5 :     PetscCall(MatShellSetOperation(*C,MATOP_GET_DIAGONAL,(void(*)(void))MatGetDiagonal_ECross));
     320           5 :     PetscCall(MatShellSetOperation(*C,MATOP_DESTROY,(void(*)(void))MatDestroy_ECross));
     321             : #if defined(PETSC_HAVE_CUDA)
     322             :     PetscCall(PetscObjectTypeCompareAny((PetscObject)(svd->swapped?AT:A),&cuda,MATSEQAIJCUSPARSE,MATMPIAIJCUSPARSE,""));
     323             :     if (cuda) PetscCall(MatShellSetOperation(*C,MATOP_MULT,(void(*)(void))MatMult_ECross_CUDA));
     324             :     else
     325             : #endif
     326           5 :       PetscCall(MatShellSetOperation(*C,MATOP_MULT,(void(*)(void))MatMult_ECross));
     327           5 :     PetscCall(MatGetVecType(A,&vtype));
     328           5 :     PetscCall(MatSetVecType(*C,vtype));
     329             : #if defined(PETSC_HAVE_CUDA)
     330             :     if (cuda) {
     331             :       /* check alignment of bottom block */
     332             :       PetscCallMPI(MPI_Comm_size(PetscObjectComm((PetscObject)ctx->x1),&size));
     333             :       PetscCall(VecGetOwnershipRanges(ctx->x1,&ranges));
     334             :       for (i=0;i<size;i++) {
     335             :         ctx->misaligned = (((ranges[i+1]-ranges[i])*sizeof(PetscScalar))%16)? PETSC_TRUE: PETSC_FALSE;
     336             :         if (ctx->misaligned) break;
     337             :       }
     338             :       if (ctx->misaligned) {  /* create work vectors for MatMult */
     339             :         PetscCall(VecDuplicate(ctx->x2,&ctx->wx2));
     340             :         PetscCall(VecDuplicate(ctx->y2,&ctx->wy2));
     341             :       }
     342             :     }
     343             : #endif
     344             :   }
     345          10 :   PetscFunctionReturn(PETSC_SUCCESS);
     346             : }
     347             : 
     348             : /* Convergence test relative to the norm of R (used in GSVD only) */
     349         136 : static PetscErrorCode EPSConv_Cyclic(EPS eps,PetscScalar eigr,PetscScalar eigi,PetscReal res,PetscReal *errest,void *ctx)
     350             : {
     351         136 :   SVD svd = (SVD)ctx;
     352             : 
     353         136 :   PetscFunctionBegin;
     354         136 :   *errest = res/PetscMax(svd->nrma,svd->nrmb);
     355         136 :   PetscFunctionReturn(PETSC_SUCCESS);
     356             : }
     357             : 
     358          42 : static PetscErrorCode SVDSetUp_Cyclic(SVD svd)
     359             : {
     360          42 :   SVD_CYCLIC        *cyclic = (SVD_CYCLIC*)svd->data;
     361          42 :   PetscInt          M,N,m,n,p,k,i,isl,offset,nev,ncv,mpd,maxit;
     362          42 :   PetscReal         tol;
     363          42 :   const PetscScalar *isa,*oa;
     364          42 :   PetscScalar       *va;
     365          42 :   EPSProblemType    ptype;
     366          42 :   PetscBool         trackall,issinv;
     367          42 :   Vec               v,t;
     368          42 :   ST                st;
     369          42 :   Mat               Omega;
     370          42 :   MatType           Atype;
     371             : 
     372          42 :   PetscFunctionBegin;
     373          42 :   PetscCall(MatGetSize(svd->A,&M,&N));
     374          42 :   PetscCall(MatGetLocalSize(svd->A,&m,&n));
     375          42 :   if (!cyclic->eps) PetscCall(SVDCyclicGetEPS(svd,&cyclic->eps));
     376          42 :   PetscCall(MatDestroy(&cyclic->C));
     377          42 :   PetscCall(MatDestroy(&cyclic->D));
     378          42 :   if (svd->isgeneralized) {
     379          10 :     if (svd->which==SVD_SMALLEST) {  /* alternative pencil */
     380           0 :       PetscCall(MatCreateVecs(svd->B,NULL,&t));
     381           0 :       PetscCall(SVDCyclicGetCyclicMat(svd,svd->B,svd->BT,&cyclic->C));
     382           0 :       PetscCall(SVDCyclicGetECrossMat(svd,svd->A,svd->AT,&cyclic->D,t));
     383             :     } else {
     384          10 :       PetscCall(MatCreateVecs(svd->A,NULL,&t));
     385          10 :       PetscCall(SVDCyclicGetCyclicMat(svd,svd->A,svd->AT,&cyclic->C));
     386          10 :       PetscCall(SVDCyclicGetECrossMat(svd,svd->B,svd->BT,&cyclic->D,t));
     387             :     }
     388          10 :     PetscCall(VecDestroy(&t));
     389          10 :     PetscCall(EPSSetOperators(cyclic->eps,cyclic->C,cyclic->D));
     390          10 :     PetscCall(EPSGetProblemType(cyclic->eps,&ptype));
     391          10 :     if (!ptype) PetscCall(EPSSetProblemType(cyclic->eps,EPS_GHEP));
     392          32 :   } else if (svd->ishyperbolic) {
     393           7 :     PetscCall(SVDCyclicGetCyclicMat(svd,svd->A,svd->AT,&cyclic->C));
     394           7 :     PetscCall(MatCreateVecs(cyclic->C,&v,NULL));
     395           7 :     PetscCall(VecSet(v,1.0));
     396           7 :     PetscCall(VecGetArrayRead(svd->omega,&oa));
     397           7 :     PetscCall(VecGetArray(v,&va));
     398           7 :     if (svd->swapped) PetscCall(PetscArraycpy(va+m,oa,n));
     399           5 :     else PetscCall(PetscArraycpy(va,oa,m));
     400           7 :     PetscCall(VecRestoreArrayRead(svd->omega,&oa));
     401           7 :     PetscCall(VecRestoreArray(v,&va));
     402           7 :     PetscCall(MatGetType(svd->OP,&Atype));
     403           7 :     PetscCall(MatCreate(PetscObjectComm((PetscObject)svd),&Omega));
     404           7 :     PetscCall(MatSetSizes(Omega,m+n,m+n,M+N,M+N));
     405           7 :     PetscCall(MatSetType(Omega,Atype));
     406           7 :     PetscCall(MatDiagonalSet(Omega,v,INSERT_VALUES));
     407           7 :     PetscCall(EPSSetOperators(cyclic->eps,cyclic->C,Omega));
     408           7 :     PetscCall(EPSSetProblemType(cyclic->eps,EPS_GHIEP));
     409           7 :     PetscCall(MatDestroy(&Omega));
     410           7 :     PetscCall(VecDestroy(&v));
     411             :   } else {
     412          25 :     PetscCall(SVDCyclicGetCyclicMat(svd,svd->A,svd->AT,&cyclic->C));
     413          25 :     PetscCall(EPSSetOperators(cyclic->eps,cyclic->C,NULL));
     414          25 :     PetscCall(EPSSetProblemType(cyclic->eps,EPS_HEP));
     415             :   }
     416          42 :   if (!cyclic->usereps) {
     417          41 :     if (svd->which == SVD_LARGEST) {
     418          39 :       PetscCall(EPSGetST(cyclic->eps,&st));
     419          39 :       PetscCall(PetscObjectTypeCompare((PetscObject)st,STSINVERT,&issinv));
     420          39 :       if (issinv) PetscCall(EPSSetWhichEigenpairs(cyclic->eps,EPS_TARGET_MAGNITUDE));
     421          38 :       else if (svd->ishyperbolic) PetscCall(EPSSetWhichEigenpairs(cyclic->eps,EPS_LARGEST_MAGNITUDE));
     422          31 :       else PetscCall(EPSSetWhichEigenpairs(cyclic->eps,EPS_LARGEST_REAL));
     423             :     } else {
     424           2 :       if (svd->isgeneralized) {  /* computes sigma^{-1} via alternative pencil */
     425           0 :         PetscCall(EPSSetWhichEigenpairs(cyclic->eps,EPS_LARGEST_REAL));
     426             :       } else {
     427           2 :         if (svd->ishyperbolic) PetscCall(EPSSetWhichEigenpairs(cyclic->eps,EPS_TARGET_MAGNITUDE));
     428           2 :         else PetscCall(EPSSetEigenvalueComparison(cyclic->eps,SlepcCompareSmallestPosReal,NULL));
     429           2 :         PetscCall(EPSSetTarget(cyclic->eps,0.0));
     430             :       }
     431             :     }
     432          41 :     PetscCall(EPSGetDimensions(cyclic->eps,&nev,&ncv,&mpd));
     433          41 :     PetscCheck(nev==1 || nev>=2*svd->nsv,PetscObjectComm((PetscObject)svd),PETSC_ERR_ARG_WRONG,"The number of requested eigenvalues %" PetscInt_FMT " must be at least 2*%" PetscInt_FMT,nev,svd->nsv);
     434          41 :     nev = PetscMax(nev,2*svd->nsv);
     435          41 :     if (ncv==PETSC_DEFAULT && svd->ncv!=PETSC_DEFAULT) ncv = PetscMax(3*svd->nsv,svd->ncv);
     436          41 :     if (mpd==PETSC_DEFAULT && svd->mpd!=PETSC_DEFAULT) mpd = svd->mpd;
     437          41 :     PetscCall(EPSSetDimensions(cyclic->eps,nev,ncv,mpd));
     438          41 :     PetscCall(EPSGetTolerances(cyclic->eps,&tol,&maxit));
     439          47 :     if (tol==(PetscReal)PETSC_DEFAULT) tol = svd->tol==(PetscReal)PETSC_DEFAULT? SLEPC_DEFAULT_TOL/10.0: svd->tol;
     440          41 :     if (maxit==PETSC_DEFAULT && svd->max_it!=PETSC_DEFAULT) maxit = svd->max_it;
     441          41 :     PetscCall(EPSSetTolerances(cyclic->eps,tol,maxit));
     442          41 :     switch (svd->conv) {
     443           3 :     case SVD_CONV_ABS:
     444           3 :       PetscCall(EPSSetConvergenceTest(cyclic->eps,EPS_CONV_ABS));break;
     445          28 :     case SVD_CONV_REL:
     446          28 :       PetscCall(EPSSetConvergenceTest(cyclic->eps,EPS_CONV_REL));break;
     447          10 :     case SVD_CONV_NORM:
     448          10 :       if (svd->isgeneralized) {
     449          10 :         if (!svd->nrma) PetscCall(MatNorm(svd->OP,NORM_INFINITY,&svd->nrma));
     450          10 :         if (!svd->nrmb) PetscCall(MatNorm(svd->OPb,NORM_INFINITY,&svd->nrmb));
     451          10 :         PetscCall(EPSSetConvergenceTestFunction(cyclic->eps,EPSConv_Cyclic,svd,NULL));
     452             :       } else {
     453           0 :         PetscCall(EPSSetConvergenceTest(cyclic->eps,EPS_CONV_NORM));break;
     454             :       }
     455             :       break;
     456           0 :     case SVD_CONV_MAXIT:
     457           0 :       SETERRQ(PetscObjectComm((PetscObject)svd),PETSC_ERR_SUP,"Maxit convergence test not supported in this solver");
     458           0 :     case SVD_CONV_USER:
     459           0 :       SETERRQ(PetscObjectComm((PetscObject)svd),PETSC_ERR_SUP,"User-defined convergence test not supported in this solver");
     460             :     }
     461             :   }
     462          42 :   SVDCheckUnsupported(svd,SVD_FEATURE_STOPPING);
     463             :   /* Transfer the trackall option from svd to eps */
     464          42 :   PetscCall(SVDGetTrackAll(svd,&trackall));
     465          42 :   PetscCall(EPSSetTrackAll(cyclic->eps,trackall));
     466             :   /* Transfer the initial subspace from svd to eps */
     467          42 :   if (svd->nini<0 || svd->ninil<0) {
     468           8 :     for (i=0;i<-PetscMin(svd->nini,svd->ninil);i++) {
     469           4 :       PetscCall(MatCreateVecs(cyclic->C,&v,NULL));
     470           4 :       PetscCall(VecGetArrayWrite(v,&va));
     471           4 :       if (svd->isgeneralized) PetscCall(MatGetLocalSize(svd->B,&p,NULL));
     472           4 :       k = (svd->isgeneralized && svd->which==SVD_SMALLEST)? p: m;  /* size of upper block row */
     473           4 :       if (i<-svd->ninil) {
     474           4 :         PetscCall(VecGetArrayRead(svd->ISL[i],&isa));
     475           4 :         if (svd->isgeneralized) {
     476           1 :           PetscCall(VecGetLocalSize(svd->ISL[i],&isl));
     477           1 :           PetscCheck(isl==m+p,PetscObjectComm((PetscObject)svd),PETSC_ERR_SUP,"Size mismatch for left initial vector");
     478           1 :           offset = (svd->which==SVD_SMALLEST)? m: 0;
     479           1 :           PetscCall(PetscArraycpy(va,isa+offset,k));
     480             :         } else {
     481           3 :           PetscCall(VecGetLocalSize(svd->ISL[i],&isl));
     482           3 :           PetscCheck(isl==k,PetscObjectComm((PetscObject)svd),PETSC_ERR_SUP,"Size mismatch for left initial vector");
     483           3 :           PetscCall(PetscArraycpy(va,isa,k));
     484             :         }
     485           4 :         PetscCall(VecRestoreArrayRead(svd->IS[i],&isa));
     486           0 :       } else PetscCall(PetscArrayzero(&va,k));
     487           4 :       if (i<-svd->nini) {
     488           4 :         PetscCall(VecGetLocalSize(svd->IS[i],&isl));
     489           4 :         PetscCheck(isl==n,PetscObjectComm((PetscObject)svd),PETSC_ERR_SUP,"Size mismatch for right initial vector");
     490           4 :         PetscCall(VecGetArrayRead(svd->IS[i],&isa));
     491           4 :         PetscCall(PetscArraycpy(va+k,isa,n));
     492           4 :         PetscCall(VecRestoreArrayRead(svd->IS[i],&isa));
     493           0 :       } else PetscCall(PetscArrayzero(va+k,n));
     494           4 :       PetscCall(VecRestoreArrayWrite(v,&va));
     495           4 :       PetscCall(VecDestroy(&svd->IS[i]));
     496           4 :       svd->IS[i] = v;
     497             :     }
     498           4 :     svd->nini = PetscMin(svd->nini,svd->ninil);
     499           4 :     PetscCall(EPSSetInitialSpace(cyclic->eps,-svd->nini,svd->IS));
     500           4 :     PetscCall(SlepcBasisDestroy_Private(&svd->nini,&svd->IS));
     501           4 :     PetscCall(SlepcBasisDestroy_Private(&svd->ninil,&svd->ISL));
     502             :   }
     503          42 :   PetscCall(EPSSetUp(cyclic->eps));
     504          42 :   PetscCall(EPSGetDimensions(cyclic->eps,NULL,&svd->ncv,&svd->mpd));
     505          42 :   svd->ncv = PetscMin(svd->ncv,PetscMin(M,N));
     506          42 :   PetscCall(EPSGetTolerances(cyclic->eps,NULL,&svd->max_it));
     507          42 :   if (svd->tol==(PetscReal)PETSC_DEFAULT) svd->tol = SLEPC_DEFAULT_TOL;
     508             : 
     509          42 :   svd->leftbasis = PETSC_TRUE;
     510          42 :   PetscCall(SVDAllocateSolution(svd,0));
     511          42 :   PetscFunctionReturn(PETSC_SUCCESS);
     512             : }
     513             : 
     514        8493 : static PetscErrorCode SVDCyclicCheckEigenvalue(SVD svd,PetscScalar er,PetscScalar ei,PetscReal *sigma,PetscBool *isreal)
     515             : {
     516        8493 :   PetscFunctionBegin;
     517        8493 :   if (svd->ishyperbolic && PetscDefined(USE_COMPLEX) && PetscAbsReal(PetscImaginaryPart(er))>10*PetscAbsReal(PetscRealPart(er))) {
     518         232 :     *sigma = PetscImaginaryPart(er);
     519         232 :     if (isreal) *isreal = PETSC_FALSE;
     520        8261 :   } else if (svd->ishyperbolic && !PetscDefined(USE_COMPLEX) && PetscAbsScalar(ei)>10*PetscAbsScalar(er)) {
     521             :     *sigma = PetscRealPart(ei);
     522             :     if (isreal) *isreal = PETSC_FALSE;
     523             :   } else {
     524        8261 :     *sigma = PetscRealPart(er);
     525        8261 :     if (isreal) *isreal = PETSC_TRUE;
     526             :   }
     527        8493 :   PetscFunctionReturn(PETSC_SUCCESS);
     528             : }
     529             : 
     530          42 : static PetscErrorCode SVDSolve_Cyclic(SVD svd)
     531             : {
     532          42 :   SVD_CYCLIC     *cyclic = (SVD_CYCLIC*)svd->data;
     533          42 :   PetscInt       i,j,nconv;
     534          42 :   PetscScalar    er,ei;
     535          42 :   PetscReal      sigma;
     536             : 
     537          42 :   PetscFunctionBegin;
     538          42 :   PetscCall(EPSSolve(cyclic->eps));
     539          42 :   PetscCall(EPSGetConverged(cyclic->eps,&nconv));
     540          42 :   PetscCall(EPSGetIterationNumber(cyclic->eps,&svd->its));
     541          42 :   PetscCall(EPSGetConvergedReason(cyclic->eps,(EPSConvergedReason*)&svd->reason));
     542         669 :   for (i=0,j=0;i<nconv;i++) {
     543         627 :     PetscCall(EPSGetEigenvalue(cyclic->eps,i,&er,&ei));
     544         627 :     PetscCall(SVDCyclicCheckEigenvalue(svd,er,ei,&sigma,NULL));
     545         627 :     if (sigma>0.0) {
     546         426 :       if (svd->isgeneralized && svd->which==SVD_SMALLEST) svd->sigma[j] = 1.0/sigma;
     547         426 :       else svd->sigma[j] = sigma;
     548         426 :       j++;
     549             :     }
     550             :   }
     551          42 :   svd->nconv = j;
     552          42 :   PetscFunctionReturn(PETSC_SUCCESS);
     553             : }
     554             : 
     555          21 : static PetscErrorCode SVDComputeVectors_Cyclic_Standard(SVD svd)
     556             : {
     557          21 :   SVD_CYCLIC        *cyclic = (SVD_CYCLIC*)svd->data;
     558          21 :   PetscInt          i,j,m,nconv;
     559          21 :   PetscScalar       er,ei;
     560          21 :   PetscReal         sigma;
     561          21 :   const PetscScalar *px;
     562          21 :   Vec               x,x1,x2;
     563             : 
     564          21 :   PetscFunctionBegin;
     565          21 :   PetscCall(MatCreateVecs(cyclic->C,&x,NULL));
     566          21 :   PetscCall(MatGetLocalSize(svd->A,&m,NULL));
     567          21 :   PetscCall(MatCreateVecsEmpty(svd->A,&x2,&x1));
     568          21 :   PetscCall(EPSGetConverged(cyclic->eps,&nconv));
     569         188 :   for (i=0,j=0;i<nconv;i++) {
     570         167 :     PetscCall(EPSGetEigenpair(cyclic->eps,i,&er,&ei,x,NULL));
     571         167 :     PetscCall(SVDCyclicCheckEigenvalue(svd,er,ei,&sigma,NULL));
     572         167 :     if (sigma<0.0) continue;
     573         155 :     PetscCall(VecGetArrayRead(x,&px));
     574         155 :     PetscCall(VecPlaceArray(x1,px));
     575         155 :     PetscCall(VecPlaceArray(x2,px+m));
     576         155 :     PetscCall(BVInsertVec(svd->U,j,x1));
     577         155 :     PetscCall(BVScaleColumn(svd->U,j,PETSC_SQRT2));
     578         155 :     PetscCall(BVInsertVec(svd->V,j,x2));
     579         155 :     PetscCall(BVScaleColumn(svd->V,j,PETSC_SQRT2));
     580         155 :     PetscCall(VecResetArray(x1));
     581         155 :     PetscCall(VecResetArray(x2));
     582         155 :     PetscCall(VecRestoreArrayRead(x,&px));
     583         155 :     j++;
     584             :   }
     585          21 :   PetscCall(VecDestroy(&x));
     586          21 :   PetscCall(VecDestroy(&x1));
     587          21 :   PetscCall(VecDestroy(&x2));
     588          21 :   PetscFunctionReturn(PETSC_SUCCESS);
     589             : }
     590             : 
     591          10 : static PetscErrorCode SVDComputeVectors_Cyclic_Generalized(SVD svd)
     592             : {
     593          10 :   SVD_CYCLIC        *cyclic = (SVD_CYCLIC*)svd->data;
     594          10 :   PetscInt          i,j,m,p,nconv;
     595          10 :   PetscScalar       *dst,er,ei;
     596          10 :   PetscReal         sigma;
     597          10 :   const PetscScalar *src,*px;
     598          10 :   Vec               u,v,x,x1,x2,uv;
     599             : 
     600          10 :   PetscFunctionBegin;
     601          10 :   PetscCall(MatGetLocalSize(svd->A,&m,NULL));
     602          10 :   PetscCall(MatGetLocalSize(svd->B,&p,NULL));
     603          10 :   PetscCall(MatCreateVecs(cyclic->C,&x,NULL));
     604          10 :   if (svd->which==SVD_SMALLEST) PetscCall(MatCreateVecsEmpty(svd->B,&x1,&x2));
     605          10 :   else PetscCall(MatCreateVecsEmpty(svd->A,&x2,&x1));
     606          10 :   PetscCall(MatCreateVecs(svd->A,NULL,&u));
     607          10 :   PetscCall(MatCreateVecs(svd->B,NULL,&v));
     608          10 :   PetscCall(EPSGetConverged(cyclic->eps,&nconv));
     609          80 :   for (i=0,j=0;i<nconv;i++) {
     610          70 :     PetscCall(EPSGetEigenpair(cyclic->eps,i,&er,&ei,x,NULL));
     611          70 :     PetscCall(SVDCyclicCheckEigenvalue(svd,er,ei,&sigma,NULL));
     612          70 :     if (sigma<0.0) continue;
     613          70 :     if (svd->which==SVD_SMALLEST) {
     614             :       /* evec_i = 1/sqrt(2)*[ v_i; w_i ],  w_i = x_i/c_i */
     615           0 :       PetscCall(VecGetArrayRead(x,&px));
     616           0 :       PetscCall(VecPlaceArray(x2,px));
     617           0 :       PetscCall(VecPlaceArray(x1,px+p));
     618           0 :       PetscCall(VecCopy(x2,v));
     619           0 :       PetscCall(VecScale(v,PETSC_SQRT2));  /* v_i = sqrt(2)*evec_i_1 */
     620           0 :       PetscCall(VecScale(x1,PETSC_SQRT2)); /* w_i = sqrt(2)*evec_i_2 */
     621           0 :       PetscCall(MatMult(svd->A,x1,u));     /* A*w_i = u_i */
     622           0 :       PetscCall(VecScale(x1,1.0/PetscSqrtScalar(1.0+sigma*sigma)));  /* x_i = w_i*c_i */
     623           0 :       PetscCall(BVInsertVec(svd->V,j,x1));
     624           0 :       PetscCall(VecResetArray(x2));
     625           0 :       PetscCall(VecResetArray(x1));
     626           0 :       PetscCall(VecRestoreArrayRead(x,&px));
     627             :     } else {
     628             :       /* evec_i = 1/sqrt(2)*[ u_i; w_i ],  w_i = x_i/s_i */
     629          70 :       PetscCall(VecGetArrayRead(x,&px));
     630          70 :       PetscCall(VecPlaceArray(x1,px));
     631          70 :       PetscCall(VecPlaceArray(x2,px+m));
     632          70 :       PetscCall(VecCopy(x1,u));
     633          70 :       PetscCall(VecScale(u,PETSC_SQRT2));  /* u_i = sqrt(2)*evec_i_1 */
     634          70 :       PetscCall(VecScale(x2,PETSC_SQRT2)); /* w_i = sqrt(2)*evec_i_2 */
     635          70 :       PetscCall(MatMult(svd->B,x2,v));     /* B*w_i = v_i */
     636          70 :       PetscCall(VecScale(x2,1.0/PetscSqrtScalar(1.0+sigma*sigma)));  /* x_i = w_i*s_i */
     637          70 :       PetscCall(BVInsertVec(svd->V,j,x2));
     638          70 :       PetscCall(VecResetArray(x1));
     639          70 :       PetscCall(VecResetArray(x2));
     640          70 :       PetscCall(VecRestoreArrayRead(x,&px));
     641             :     }
     642             :     /* copy [u;v] to U[j] */
     643          70 :     PetscCall(BVGetColumn(svd->U,j,&uv));
     644          70 :     PetscCall(VecGetArrayWrite(uv,&dst));
     645          70 :     PetscCall(VecGetArrayRead(u,&src));
     646          70 :     PetscCall(PetscArraycpy(dst,src,m));
     647          70 :     PetscCall(VecRestoreArrayRead(u,&src));
     648          70 :     PetscCall(VecGetArrayRead(v,&src));
     649          70 :     PetscCall(PetscArraycpy(dst+m,src,p));
     650          70 :     PetscCall(VecRestoreArrayRead(v,&src));
     651          70 :     PetscCall(VecRestoreArrayWrite(uv,&dst));
     652          70 :     PetscCall(BVRestoreColumn(svd->U,j,&uv));
     653          70 :     j++;
     654             :   }
     655          10 :   PetscCall(VecDestroy(&x));
     656          10 :   PetscCall(VecDestroy(&x1));
     657          10 :   PetscCall(VecDestroy(&x2));
     658          10 :   PetscCall(VecDestroy(&u));
     659          10 :   PetscCall(VecDestroy(&v));
     660          10 :   PetscFunctionReturn(PETSC_SUCCESS);
     661             : }
     662             : 
     663             : #if defined(PETSC_USE_COMPLEX)
     664             : /* VecMaxAbs: returns the entry of x that has max(abs(x(i))), using w as a workspace vector */
     665           4 : static PetscErrorCode VecMaxAbs(Vec x,Vec w,PetscScalar *v)
     666             : {
     667           4 :   PetscMPIInt       size,rank,root;
     668           4 :   const PetscScalar *xx;
     669           4 :   const PetscInt    *ranges;
     670           4 :   PetscReal         val;
     671           4 :   PetscInt          p;
     672             : 
     673           4 :   PetscFunctionBegin;
     674           4 :   PetscCall(VecCopy(x,w));
     675           4 :   PetscCall(VecAbs(w));
     676           4 :   PetscCall(VecMax(w,&p,&val));
     677           4 :   PetscCallMPI(MPI_Comm_size(PetscObjectComm((PetscObject)x),&size));
     678           4 :   PetscCallMPI(MPI_Comm_rank(PetscObjectComm((PetscObject)x),&rank));
     679           4 :   PetscCall(VecGetOwnershipRanges(x,&ranges));
     680           4 :   for (root=0;root<size;root++) if (p>=ranges[root] && p<ranges[root+1]) break;
     681           4 :   if (rank==root) {
     682           4 :     PetscCall(VecGetArrayRead(x,&xx));
     683           4 :     *v = xx[p-ranges[root]];
     684           4 :     PetscCall(VecRestoreArrayRead(x,&xx));
     685             :   }
     686           8 :   PetscCallMPI(MPI_Bcast(v,1,MPIU_SCALAR,root,PetscObjectComm((PetscObject)x)));
     687           4 :   PetscFunctionReturn(PETSC_SUCCESS);
     688             : }
     689             : #endif
     690             : 
     691           7 : static PetscErrorCode SVDComputeVectors_Cyclic_Hyperbolic(SVD svd)
     692             : {
     693           7 :   SVD_CYCLIC        *cyclic = (SVD_CYCLIC*)svd->data;
     694           7 :   PetscInt          i,j,m,n,nconv;
     695           7 :   PetscScalar       er,ei;
     696           7 :   PetscReal         sigma,nrm;
     697           7 :   PetscBool         isreal;
     698           7 :   const PetscScalar *px;
     699           7 :   Vec               u,x,xi=NULL,x1,x2,x1i=NULL,x2i;
     700           7 :   BV                U=NULL,V=NULL;
     701             : #if !defined(PETSC_USE_COMPLEX)
     702             :   const PetscScalar *pxi;
     703             :   PetscReal         nrmr,nrmi;
     704             : #else
     705           7 :   PetscScalar       alpha;
     706             : #endif
     707             : 
     708           7 :   PetscFunctionBegin;
     709           7 :   PetscCall(MatCreateVecs(cyclic->C,&x,svd->ishyperbolic?&xi:NULL));
     710           7 :   PetscCall(MatGetLocalSize(svd->A,&m,NULL));
     711           7 :   PetscCall(MatCreateVecsEmpty(svd->OP,&x2,&x1));
     712             : #if defined(PETSC_USE_COMPLEX)
     713           7 :   PetscCall(MatCreateVecs(svd->OP,&x2i,&x1i));
     714             : #else
     715             :   PetscCall(MatCreateVecsEmpty(svd->OP,&x2i,&x1i));
     716             : #endif
     717             :   /* set-up Omega-normalization of U */
     718           7 :   U = svd->swapped? svd->V: svd->U;
     719           7 :   V = svd->swapped? svd->U: svd->V;
     720           7 :   PetscCall(BVGetSizes(U,&n,NULL,NULL));
     721           7 :   PetscCall(BV_SetMatrixDiagonal(U,svd->omega,svd->A));
     722           7 :   PetscCall(EPSGetConverged(cyclic->eps,&nconv));
     723         386 :   for (i=0,j=0;i<nconv;i++) {
     724         379 :     PetscCall(EPSGetEigenpair(cyclic->eps,i,&er,&ei,x,xi));
     725         379 :     PetscCall(SVDCyclicCheckEigenvalue(svd,er,ei,&sigma,&isreal));
     726         379 :     if (sigma<0.0) continue;
     727         190 :     PetscCall(VecGetArrayRead(x,&px));
     728         190 :     if (svd->swapped) {
     729          14 :       PetscCall(VecPlaceArray(x2,px));
     730          14 :       PetscCall(VecPlaceArray(x1,px+m));
     731             :     } else {
     732         176 :       PetscCall(VecPlaceArray(x1,px));
     733         176 :       PetscCall(VecPlaceArray(x2,px+n));
     734             :     }
     735             : #if defined(PETSC_USE_COMPLEX)
     736         190 :     PetscCall(BVInsertVec(U,j,x1));
     737         190 :     PetscCall(BVInsertVec(V,j,x2));
     738         190 :     if (!isreal) {
     739           4 :       PetscCall(VecMaxAbs(x1,x1i,&alpha));
     740           4 :       PetscCall(BVScaleColumn(U,j,PetscAbsScalar(alpha)/alpha));
     741           4 :       PetscCall(BVScaleColumn(V,j,PetscAbsScalar(alpha)/(alpha*PETSC_i)));
     742             :     }
     743             : #else
     744             :     PetscCall(VecGetArrayRead(xi,&pxi));
     745             :     if (svd->swapped) {
     746             :       PetscCall(VecPlaceArray(x2i,pxi));
     747             :       PetscCall(VecPlaceArray(x1i,pxi+m));
     748             :     } else {
     749             :       PetscCall(VecPlaceArray(x1i,pxi));
     750             :       PetscCall(VecPlaceArray(x2i,pxi+n));
     751             :     }
     752             :     PetscCall(VecNorm(x2,NORM_2,&nrmr));
     753             :     PetscCall(VecNorm(x2i,NORM_2,&nrmi));
     754             :     if (nrmi>nrmr) {
     755             :       if (isreal) {
     756             :         PetscCall(BVInsertVec(U,j,x1i));
     757             :         PetscCall(BVInsertVec(V,j,x2i));
     758             :       } else {
     759             :         PetscCall(BVInsertVec(U,j,x1));
     760             :         PetscCall(BVInsertVec(V,j,x2i));
     761             :       }
     762             :     } else {
     763             :       if (isreal) {
     764             :         PetscCall(BVInsertVec(U,j,x1));
     765             :         PetscCall(BVInsertVec(V,j,x2));
     766             :       } else {
     767             :         PetscCall(BVInsertVec(U,j,x1i));
     768             :         PetscCall(BVScaleColumn(U,j,-1.0));
     769             :         PetscCall(BVInsertVec(V,j,x2));
     770             :       }
     771             :     }
     772             :     PetscCall(VecResetArray(x1i));
     773             :     PetscCall(VecResetArray(x2i));
     774             :     PetscCall(VecRestoreArrayRead(xi,&pxi));
     775             : #endif
     776         190 :     PetscCall(VecResetArray(x1));
     777         190 :     PetscCall(VecResetArray(x2));
     778         190 :     PetscCall(VecRestoreArrayRead(x,&px));
     779         190 :     PetscCall(BVGetColumn(U,j,&u));
     780         190 :     PetscCall(VecPointwiseMult(u,u,svd->omega));
     781         190 :     PetscCall(BVRestoreColumn(U,j,&u));
     782         190 :     PetscCall(BVNormColumn(U,j,NORM_2,&nrm));
     783         190 :     PetscCall(BVScaleColumn(U,j,1.0/PetscAbs(nrm)));
     784         190 :     svd->sign[j] = PetscSign(nrm);
     785         190 :     PetscCall(BVNormColumn(V,j,NORM_2,&nrm));
     786         190 :     PetscCall(BVScaleColumn(V,j,1.0/nrm));
     787         190 :     j++;
     788             :   }
     789           7 :   PetscCall(VecDestroy(&x));
     790           7 :   PetscCall(VecDestroy(&x1));
     791           7 :   PetscCall(VecDestroy(&x2));
     792           7 :   PetscCall(VecDestroy(&xi));
     793           7 :   PetscCall(VecDestroy(&x1i));
     794           7 :   PetscCall(VecDestroy(&x2i));
     795           7 :   PetscFunctionReturn(PETSC_SUCCESS);
     796             : }
     797             : 
     798          38 : static PetscErrorCode SVDComputeVectors_Cyclic(SVD svd)
     799             : {
     800          38 :   PetscFunctionBegin;
     801          38 :   switch (svd->problem_type) {
     802          21 :     case SVD_STANDARD:
     803          21 :       PetscCall(SVDComputeVectors_Cyclic_Standard(svd));
     804             :       break;
     805          10 :     case SVD_GENERALIZED:
     806          10 :       PetscCall(SVDComputeVectors_Cyclic_Generalized(svd));
     807             :       break;
     808           7 :     case SVD_HYPERBOLIC:
     809           7 :       PetscCall(SVDComputeVectors_Cyclic_Hyperbolic(svd));
     810             :       break;
     811           0 :     default:
     812           0 :       SETERRQ(PetscObjectComm((PetscObject)svd),PETSC_ERR_ARG_WRONG,"Unknown singular value problem type");
     813             :   }
     814          38 :   PetscFunctionReturn(PETSC_SUCCESS);
     815             : }
     816             : 
     817         509 : static PetscErrorCode EPSMonitor_Cyclic(EPS eps,PetscInt its,PetscInt nconv,PetscScalar *eigr,PetscScalar *eigi,PetscReal *errest,PetscInt nest,void *ctx)
     818             : {
     819         509 :   PetscInt       i,j;
     820         509 :   SVD            svd = (SVD)ctx;
     821         509 :   PetscScalar    er,ei;
     822         509 :   PetscReal      sigma;
     823         509 :   ST             st;
     824             : 
     825         509 :   PetscFunctionBegin;
     826         509 :   nconv = 0;
     827         509 :   PetscCall(EPSGetST(eps,&st));
     828        7759 :   for (i=0,j=0;i<PetscMin(nest,svd->ncv);i++) {
     829        7250 :     er = eigr[i]; ei = eigi[i];
     830        7250 :     PetscCall(STBackTransform(st,1,&er,&ei));
     831        7250 :     PetscCall(SVDCyclicCheckEigenvalue(svd,er,ei,&sigma,NULL));
     832        7250 :     if (sigma>0.0) {
     833        4714 :       svd->sigma[j]  = sigma;
     834        4714 :       svd->errest[j] = errest[i];
     835        4714 :       if (errest[i] && errest[i] < svd->tol) nconv++;
     836        4714 :       j++;
     837             :     }
     838             :   }
     839         509 :   nest = j;
     840         509 :   PetscCall(SVDMonitor(svd,its,nconv,svd->sigma,svd->errest,nest));
     841         509 :   PetscFunctionReturn(PETSC_SUCCESS);
     842             : }
     843             : 
     844          30 : static PetscErrorCode SVDSetFromOptions_Cyclic(SVD svd,PetscOptionItems *PetscOptionsObject)
     845             : {
     846          30 :   PetscBool      set,val;
     847          30 :   SVD_CYCLIC     *cyclic = (SVD_CYCLIC*)svd->data;
     848          30 :   ST             st;
     849             : 
     850          30 :   PetscFunctionBegin;
     851          30 :   PetscOptionsHeadBegin(PetscOptionsObject,"SVD Cyclic Options");
     852             : 
     853          30 :     PetscCall(PetscOptionsBool("-svd_cyclic_explicitmatrix","Use cyclic explicit matrix","SVDCyclicSetExplicitMatrix",cyclic->explicitmatrix,&val,&set));
     854          30 :     if (set) PetscCall(SVDCyclicSetExplicitMatrix(svd,val));
     855             : 
     856          30 :   PetscOptionsHeadEnd();
     857             : 
     858          30 :   if (!cyclic->eps) PetscCall(SVDCyclicGetEPS(svd,&cyclic->eps));
     859          30 :   if (!cyclic->explicitmatrix && !cyclic->usereps) {
     860             :     /* use as default an ST with shell matrix and Jacobi */
     861          18 :     PetscCall(EPSGetST(cyclic->eps,&st));
     862          18 :     PetscCall(STSetMatMode(st,ST_MATMODE_SHELL));
     863             :   }
     864          30 :   PetscCall(EPSSetFromOptions(cyclic->eps));
     865          30 :   PetscFunctionReturn(PETSC_SUCCESS);
     866             : }
     867             : 
     868          19 : static PetscErrorCode SVDCyclicSetExplicitMatrix_Cyclic(SVD svd,PetscBool explicitmat)
     869             : {
     870          19 :   SVD_CYCLIC *cyclic = (SVD_CYCLIC*)svd->data;
     871             : 
     872          19 :   PetscFunctionBegin;
     873          19 :   if (cyclic->explicitmatrix != explicitmat) {
     874          12 :     cyclic->explicitmatrix = explicitmat;
     875          12 :     svd->state = SVD_STATE_INITIAL;
     876             :   }
     877          19 :   PetscFunctionReturn(PETSC_SUCCESS);
     878             : }
     879             : 
     880             : /*@
     881             :    SVDCyclicSetExplicitMatrix - Indicate if the eigensolver operator
     882             :    H(A) = [ 0  A ; A^T 0 ] must be computed explicitly.
     883             : 
     884             :    Logically Collective
     885             : 
     886             :    Input Parameters:
     887             : +  svd         - singular value solver
     888             : -  explicitmat - boolean flag indicating if H(A) is built explicitly
     889             : 
     890             :    Options Database Key:
     891             : .  -svd_cyclic_explicitmatrix <boolean> - Indicates the boolean flag
     892             : 
     893             :    Level: advanced
     894             : 
     895             : .seealso: SVDCyclicGetExplicitMatrix()
     896             : @*/
     897          19 : PetscErrorCode SVDCyclicSetExplicitMatrix(SVD svd,PetscBool explicitmat)
     898             : {
     899          19 :   PetscFunctionBegin;
     900          19 :   PetscValidHeaderSpecific(svd,SVD_CLASSID,1);
     901          76 :   PetscValidLogicalCollectiveBool(svd,explicitmat,2);
     902          19 :   PetscTryMethod(svd,"SVDCyclicSetExplicitMatrix_C",(SVD,PetscBool),(svd,explicitmat));
     903          19 :   PetscFunctionReturn(PETSC_SUCCESS);
     904             : }
     905             : 
     906           1 : static PetscErrorCode SVDCyclicGetExplicitMatrix_Cyclic(SVD svd,PetscBool *explicitmat)
     907             : {
     908           1 :   SVD_CYCLIC *cyclic = (SVD_CYCLIC*)svd->data;
     909             : 
     910           1 :   PetscFunctionBegin;
     911           1 :   *explicitmat = cyclic->explicitmatrix;
     912           1 :   PetscFunctionReturn(PETSC_SUCCESS);
     913             : }
     914             : 
     915             : /*@
     916             :    SVDCyclicGetExplicitMatrix - Returns the flag indicating if H(A) is built explicitly.
     917             : 
     918             :    Not Collective
     919             : 
     920             :    Input Parameter:
     921             : .  svd  - singular value solver
     922             : 
     923             :    Output Parameter:
     924             : .  explicitmat - the mode flag
     925             : 
     926             :    Level: advanced
     927             : 
     928             : .seealso: SVDCyclicSetExplicitMatrix()
     929             : @*/
     930           1 : PetscErrorCode SVDCyclicGetExplicitMatrix(SVD svd,PetscBool *explicitmat)
     931             : {
     932           1 :   PetscFunctionBegin;
     933           1 :   PetscValidHeaderSpecific(svd,SVD_CLASSID,1);
     934           1 :   PetscAssertPointer(explicitmat,2);
     935           1 :   PetscUseMethod(svd,"SVDCyclicGetExplicitMatrix_C",(SVD,PetscBool*),(svd,explicitmat));
     936           1 :   PetscFunctionReturn(PETSC_SUCCESS);
     937             : }
     938             : 
     939           1 : static PetscErrorCode SVDCyclicSetEPS_Cyclic(SVD svd,EPS eps)
     940             : {
     941           1 :   SVD_CYCLIC      *cyclic = (SVD_CYCLIC*)svd->data;
     942             : 
     943           1 :   PetscFunctionBegin;
     944           1 :   PetscCall(PetscObjectReference((PetscObject)eps));
     945           1 :   PetscCall(EPSDestroy(&cyclic->eps));
     946           1 :   cyclic->eps     = eps;
     947           1 :   cyclic->usereps = PETSC_TRUE;
     948           1 :   svd->state      = SVD_STATE_INITIAL;
     949           1 :   PetscFunctionReturn(PETSC_SUCCESS);
     950             : }
     951             : 
     952             : /*@
     953             :    SVDCyclicSetEPS - Associate an eigensolver object (EPS) to the
     954             :    singular value solver.
     955             : 
     956             :    Collective
     957             : 
     958             :    Input Parameters:
     959             : +  svd - singular value solver
     960             : -  eps - the eigensolver object
     961             : 
     962             :    Level: advanced
     963             : 
     964             : .seealso: SVDCyclicGetEPS()
     965             : @*/
     966           1 : PetscErrorCode SVDCyclicSetEPS(SVD svd,EPS eps)
     967             : {
     968           1 :   PetscFunctionBegin;
     969           1 :   PetscValidHeaderSpecific(svd,SVD_CLASSID,1);
     970           1 :   PetscValidHeaderSpecific(eps,EPS_CLASSID,2);
     971           1 :   PetscCheckSameComm(svd,1,eps,2);
     972           1 :   PetscTryMethod(svd,"SVDCyclicSetEPS_C",(SVD,EPS),(svd,eps));
     973           1 :   PetscFunctionReturn(PETSC_SUCCESS);
     974             : }
     975             : 
     976          31 : static PetscErrorCode SVDCyclicGetEPS_Cyclic(SVD svd,EPS *eps)
     977             : {
     978          31 :   SVD_CYCLIC     *cyclic = (SVD_CYCLIC*)svd->data;
     979             : 
     980          31 :   PetscFunctionBegin;
     981          31 :   if (!cyclic->eps) {
     982          31 :     PetscCall(EPSCreate(PetscObjectComm((PetscObject)svd),&cyclic->eps));
     983          31 :     PetscCall(PetscObjectIncrementTabLevel((PetscObject)cyclic->eps,(PetscObject)svd,1));
     984          31 :     PetscCall(EPSSetOptionsPrefix(cyclic->eps,((PetscObject)svd)->prefix));
     985          31 :     PetscCall(EPSAppendOptionsPrefix(cyclic->eps,"svd_cyclic_"));
     986          31 :     PetscCall(PetscObjectSetOptions((PetscObject)cyclic->eps,((PetscObject)svd)->options));
     987          31 :     PetscCall(EPSSetWhichEigenpairs(cyclic->eps,EPS_LARGEST_REAL));
     988          31 :     PetscCall(EPSMonitorSet(cyclic->eps,EPSMonitor_Cyclic,svd,NULL));
     989             :   }
     990          31 :   *eps = cyclic->eps;
     991          31 :   PetscFunctionReturn(PETSC_SUCCESS);
     992             : }
     993             : 
     994             : /*@
     995             :    SVDCyclicGetEPS - Retrieve the eigensolver object (EPS) associated
     996             :    to the singular value solver.
     997             : 
     998             :    Collective
     999             : 
    1000             :    Input Parameter:
    1001             : .  svd - singular value solver
    1002             : 
    1003             :    Output Parameter:
    1004             : .  eps - the eigensolver object
    1005             : 
    1006             :    Level: advanced
    1007             : 
    1008             : .seealso: SVDCyclicSetEPS()
    1009             : @*/
    1010          31 : PetscErrorCode SVDCyclicGetEPS(SVD svd,EPS *eps)
    1011             : {
    1012          31 :   PetscFunctionBegin;
    1013          31 :   PetscValidHeaderSpecific(svd,SVD_CLASSID,1);
    1014          31 :   PetscAssertPointer(eps,2);
    1015          31 :   PetscUseMethod(svd,"SVDCyclicGetEPS_C",(SVD,EPS*),(svd,eps));
    1016          31 :   PetscFunctionReturn(PETSC_SUCCESS);
    1017             : }
    1018             : 
    1019           1 : static PetscErrorCode SVDView_Cyclic(SVD svd,PetscViewer viewer)
    1020             : {
    1021           1 :   SVD_CYCLIC     *cyclic = (SVD_CYCLIC*)svd->data;
    1022           1 :   PetscBool      isascii;
    1023             : 
    1024           1 :   PetscFunctionBegin;
    1025           1 :   PetscCall(PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&isascii));
    1026           1 :   if (isascii) {
    1027           1 :     if (!cyclic->eps) PetscCall(SVDCyclicGetEPS(svd,&cyclic->eps));
    1028           1 :     PetscCall(PetscViewerASCIIPrintf(viewer,"  %s matrix\n",cyclic->explicitmatrix?"explicit":"implicit"));
    1029           1 :     PetscCall(PetscViewerASCIIPushTab(viewer));
    1030           1 :     PetscCall(EPSView(cyclic->eps,viewer));
    1031           1 :     PetscCall(PetscViewerASCIIPopTab(viewer));
    1032             :   }
    1033           1 :   PetscFunctionReturn(PETSC_SUCCESS);
    1034             : }
    1035             : 
    1036          33 : static PetscErrorCode SVDReset_Cyclic(SVD svd)
    1037             : {
    1038          33 :   SVD_CYCLIC     *cyclic = (SVD_CYCLIC*)svd->data;
    1039             : 
    1040          33 :   PetscFunctionBegin;
    1041          33 :   PetscCall(EPSReset(cyclic->eps));
    1042          33 :   PetscCall(MatDestroy(&cyclic->C));
    1043          33 :   PetscCall(MatDestroy(&cyclic->D));
    1044          33 :   PetscFunctionReturn(PETSC_SUCCESS);
    1045             : }
    1046             : 
    1047          32 : static PetscErrorCode SVDDestroy_Cyclic(SVD svd)
    1048             : {
    1049          32 :   SVD_CYCLIC     *cyclic = (SVD_CYCLIC*)svd->data;
    1050             : 
    1051          32 :   PetscFunctionBegin;
    1052          32 :   PetscCall(EPSDestroy(&cyclic->eps));
    1053          32 :   PetscCall(PetscFree(svd->data));
    1054          32 :   PetscCall(PetscObjectComposeFunction((PetscObject)svd,"SVDCyclicSetEPS_C",NULL));
    1055          32 :   PetscCall(PetscObjectComposeFunction((PetscObject)svd,"SVDCyclicGetEPS_C",NULL));
    1056          32 :   PetscCall(PetscObjectComposeFunction((PetscObject)svd,"SVDCyclicSetExplicitMatrix_C",NULL));
    1057          32 :   PetscCall(PetscObjectComposeFunction((PetscObject)svd,"SVDCyclicGetExplicitMatrix_C",NULL));
    1058          32 :   PetscFunctionReturn(PETSC_SUCCESS);
    1059             : }
    1060             : 
    1061          32 : SLEPC_EXTERN PetscErrorCode SVDCreate_Cyclic(SVD svd)
    1062             : {
    1063          32 :   SVD_CYCLIC     *cyclic;
    1064             : 
    1065          32 :   PetscFunctionBegin;
    1066          32 :   PetscCall(PetscNew(&cyclic));
    1067          32 :   svd->data                = (void*)cyclic;
    1068          32 :   svd->ops->solve          = SVDSolve_Cyclic;
    1069          32 :   svd->ops->solveg         = SVDSolve_Cyclic;
    1070          32 :   svd->ops->solveh         = SVDSolve_Cyclic;
    1071          32 :   svd->ops->setup          = SVDSetUp_Cyclic;
    1072          32 :   svd->ops->setfromoptions = SVDSetFromOptions_Cyclic;
    1073          32 :   svd->ops->destroy        = SVDDestroy_Cyclic;
    1074          32 :   svd->ops->reset          = SVDReset_Cyclic;
    1075          32 :   svd->ops->view           = SVDView_Cyclic;
    1076          32 :   svd->ops->computevectors = SVDComputeVectors_Cyclic;
    1077          32 :   PetscCall(PetscObjectComposeFunction((PetscObject)svd,"SVDCyclicSetEPS_C",SVDCyclicSetEPS_Cyclic));
    1078          32 :   PetscCall(PetscObjectComposeFunction((PetscObject)svd,"SVDCyclicGetEPS_C",SVDCyclicGetEPS_Cyclic));
    1079          32 :   PetscCall(PetscObjectComposeFunction((PetscObject)svd,"SVDCyclicSetExplicitMatrix_C",SVDCyclicSetExplicitMatrix_Cyclic));
    1080          32 :   PetscCall(PetscObjectComposeFunction((PetscObject)svd,"SVDCyclicGetExplicitMatrix_C",SVDCyclicGetExplicitMatrix_Cyclic));
    1081          32 :   PetscFunctionReturn(PETSC_SUCCESS);
    1082             : }

Generated by: LCOV version 1.14