LCOV - code coverage report
Current view: top level - eps/impls/external/primme - primme.c (source / functions) Hit Total Coverage
Test: coverage.info Lines: 262 286 91.6 %
Date: 2020-05-28 03:14:05 Functions: 21 22 95.5 %

          Line data    Source code
       1             : /*
       2             :    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
       3             :    SLEPc - Scalable Library for Eigenvalue Problem Computations
       4             :    Copyright (c) 2002-2020, 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             :    This file implements a wrapper to the PRIMME package
      12             : */
      13             : 
      14             : #include <slepc/private/epsimpl.h>    /*I "slepceps.h" I*/
      15             : 
      16             : #include <primme.h>
      17             : 
      18             : #if defined(PETSC_USE_COMPLEX)
      19             : #if defined(PETSC_USE_REAL_SINGLE)
      20             : #define PRIMME_DRIVER cprimme
      21             : #else
      22             : #define PRIMME_DRIVER zprimme
      23             : #endif
      24             : #else
      25             : #if defined(PETSC_USE_REAL_SINGLE)
      26             : #define PRIMME_DRIVER sprimme
      27             : #else
      28             : #define PRIMME_DRIVER dprimme
      29             : #endif
      30             : #endif
      31             : 
      32             : #if defined(PRIMME_VERSION_MAJOR) && PRIMME_VERSION_MAJOR*100+PRIMME_VERSION_MINOR >= 202
      33             : #define SLEPC_HAVE_PRIMME2p2
      34             : #endif
      35             : 
      36             : typedef struct {
      37             :   primme_params        primme;    /* param struc */
      38             :   PetscInt             bs;        /* block size */
      39             :   primme_preset_method method;    /* primme method */
      40             :   Mat                  A,B;       /* problem matrices */
      41             :   KSP                  ksp;       /* linear solver and preconditioner */
      42             :   Vec                  x,y;       /* auxiliary vectors */
      43             :   double               target;    /* a copy of eps's target */
      44             : } EPS_PRIMME;
      45             : 
      46         852 : static void par_GlobalSumReal(void *sendBuf,void *recvBuf,int *count,primme_params *primme,int *ierr)
      47             : {
      48         852 :   if (sendBuf == recvBuf) {
      49        1704 :     *ierr = MPI_Allreduce(MPI_IN_PLACE,recvBuf,*count,MPIU_REAL,MPIU_SUM,PetscObjectComm((PetscObject)primme->commInfo));CHKERRABORT(PetscObjectComm((PetscObject)primme->commInfo),*ierr);
      50             :   } else {
      51           0 :     *ierr = MPI_Allreduce(sendBuf,recvBuf,*count,MPIU_REAL,MPIU_SUM,PetscObjectComm((PetscObject)primme->commInfo));CHKERRABORT(PetscObjectComm((PetscObject)primme->commInfo),*ierr);
      52             :   }
      53         852 : }
      54             : 
      55             : #if defined(SLEPC_HAVE_PRIMME3)
      56        2252 : static void par_broadcastReal(void *buf,int *count,primme_params *primme,int *ierr)
      57             : {
      58        4504 :   *ierr = MPI_Bcast(buf,*count,MPIU_REAL,0/*root*/,PetscObjectComm((PetscObject)primme->commInfo));CHKERRABORT(PetscObjectComm((PetscObject)primme->commInfo),*ierr);
      59        2252 : }
      60             : #endif
      61             : 
      62             : #if defined(SLEPC_HAVE_PRIMME2p2)
      63        7723 : static void convTestFun(double *eval,void *evec,double *resNorm,int *isconv,primme_params *primme,int *err)
      64             : {
      65             :   PetscErrorCode ierr;
      66        7723 :   EPS            eps = (EPS)primme->commInfo;
      67        7723 :   PetscScalar    eigvr = eval?*eval:0.0;
      68        7723 :   PetscReal      r = resNorm?*resNorm:HUGE_VAL,errest;
      69             : 
      70        7723 :   *err = 1;
      71        7723 :   ierr = (*eps->converged)(eps,eigvr,0.0,r,&errest,eps->convergedctx);CHKERRABORT(PetscObjectComm((PetscObject)eps),ierr);
      72        7723 :   *isconv = (errest<=eps->tol?1:0);
      73        7723 :   *err = 0;
      74        7723 : }
      75             : 
      76        6860 : static void monitorFun(void *basisEvals,int *basisSize,int *basisFlags,int *iblock,int *blockSize,void *basisNorms,int *numConverged,void *lockedEvals,int *numLocked,int *lockedFlags,void *lockedNorms,int *inner_its,void *LSRes,
      77             : #if defined(SLEPC_HAVE_PRIMME3)
      78             :                        const char *msg,double *time,
      79             : #endif
      80             :                        primme_event *event,struct primme_params *primme,int *err)
      81             : {
      82             :   PetscErrorCode ierr;
      83        6860 :   EPS            eps = (EPS)primme->commInfo;
      84             :   PetscInt       i,k,nerrest;
      85             : 
      86        6860 :   *err = 1;
      87        6860 :   switch (*event) {
      88             :     case primme_event_outer_iteration:
      89             :       /* Update EPS */
      90         805 :       eps->its = primme->stats.numOuterIterations;
      91         805 :       eps->nconv = primme->initSize;
      92         805 :       k=0;
      93         805 :       if (lockedEvals && numLocked) for (i=0; i<*numLocked && k<eps->ncv; i++) eps->eigr[k++] = ((PetscReal*)lockedEvals)[i];
      94         805 :       nerrest = k;
      95         805 :       if (iblock && blockSize) {
      96        1354 :         for (i=0; i<*blockSize && k+iblock[i]<eps->ncv; i++) eps->errest[k+iblock[i]] = ((PetscReal*)basisNorms)[i];
      97         805 :         nerrest = k+(*blockSize>0?1+iblock[*blockSize-1]:0);
      98             :       }
      99         805 :       if (basisEvals && basisSize) for (i=0; i<*basisSize && k<eps->ncv; i++) eps->eigr[k++] = ((PetscReal*)basisEvals)[i];
     100             :       /* Show progress */
     101         805 :       ierr = EPSMonitor(eps,eps->its,numConverged?*numConverged:0,eps->eigr,eps->eigi,eps->errest,nerrest);CHKERRABORT(PetscObjectComm((PetscObject)eps),ierr);
     102             :       break;
     103             : #if defined(SLEPC_HAVE_PRIMME3)
     104             :     case primme_event_message:
     105             :       /* Print PRIMME information messages */
     106           0 :       ierr = PetscInfo(eps,msg);CHKERRABORT(PetscObjectComm((PetscObject)eps),ierr);
     107             :       break;
     108             : #endif
     109             :     default:
     110             :       break;
     111             :   }
     112        6860 :   *err = 0;
     113        6860 : }
     114             : #endif /* SLEPC_HAVE_PRIMME2p2 */
     115             : 
     116        5926 : static void matrixMatvec_PRIMME(void *xa,PRIMME_INT *ldx,void *ya,PRIMME_INT *ldy,int *blockSize,struct primme_params *primme,int *ierr)
     117             : {
     118             :   PetscInt   i;
     119        5926 :   EPS_PRIMME *ops = (EPS_PRIMME*)primme->matrix;
     120        5926 :   Vec        x = ops->x,y = ops->y;
     121        5926 :   Mat        A = ops->A;
     122             : 
     123        5926 :   PetscFunctionBegin;
     124        8158 :   for (i=0;i<*blockSize;i++) {
     125        8158 :     *ierr = VecPlaceArray(x,(PetscScalar*)xa+(*ldx)*i);CHKERRABORT(PetscObjectComm((PetscObject)A),*ierr);
     126        8158 :     *ierr = VecPlaceArray(y,(PetscScalar*)ya+(*ldy)*i);CHKERRABORT(PetscObjectComm((PetscObject)A),*ierr);
     127        8158 :     *ierr = MatMult(A,x,y);CHKERRABORT(PetscObjectComm((PetscObject)A),*ierr);
     128        8158 :     *ierr = VecResetArray(x);CHKERRABORT(PetscObjectComm((PetscObject)A),*ierr);
     129        8158 :     *ierr = VecResetArray(y);CHKERRABORT(PetscObjectComm((PetscObject)A),*ierr);
     130             :   }
     131        5926 :   PetscFunctionReturnVoid();
     132             : }
     133             : 
     134             : #if defined(SLEPC_HAVE_PRIMME3)
     135        4641 : static void massMatrixMatvec_PRIMME(void *xa,PRIMME_INT *ldx,void *ya,PRIMME_INT *ldy,int *blockSize,struct primme_params *primme,int *ierr)
     136             : {
     137             :   PetscInt   i;
     138        4641 :   EPS_PRIMME *ops = (EPS_PRIMME*)primme->massMatrix;
     139        4641 :   Vec        x = ops->x,y = ops->y;
     140        4641 :   Mat        B = ops->B;
     141             : 
     142        4641 :   PetscFunctionBegin;
     143        4641 :   for (i=0;i<*blockSize;i++) {
     144        4641 :     *ierr = VecPlaceArray(x,(PetscScalar*)xa+(*ldx)*i);CHKERRABORT(PetscObjectComm((PetscObject)B),*ierr);
     145        4641 :     *ierr = VecPlaceArray(y,(PetscScalar*)ya+(*ldy)*i);CHKERRABORT(PetscObjectComm((PetscObject)B),*ierr);
     146        4641 :     *ierr = MatMult(B,x,y);CHKERRABORT(PetscObjectComm((PetscObject)B),*ierr);
     147        4641 :     *ierr = VecResetArray(x);CHKERRABORT(PetscObjectComm((PetscObject)B),*ierr);
     148        4641 :     *ierr = VecResetArray(y);CHKERRABORT(PetscObjectComm((PetscObject)B),*ierr);
     149             :   }
     150        4641 :   PetscFunctionReturnVoid();
     151             : }
     152             : #endif
     153             : 
     154        5306 : static void applyPreconditioner_PRIMME(void *xa,PRIMME_INT *ldx,void *ya,PRIMME_INT *ldy,int *blockSize,struct primme_params *primme,int *ierr)
     155             : {
     156             :   PetscInt   i;
     157        5306 :   EPS_PRIMME *ops = (EPS_PRIMME*)primme->matrix;
     158        5306 :   Vec        x = ops->x,y = ops->y;
     159             : 
     160        5306 :   PetscFunctionBegin;
     161        7341 :   for (i=0;i<*blockSize;i++) {
     162        7341 :     *ierr = VecPlaceArray(x,(PetscScalar*)xa+(*ldx)*i);CHKERRABORT(PetscObjectComm((PetscObject)ops->ksp),*ierr);
     163        7341 :     *ierr = VecPlaceArray(y,(PetscScalar*)ya+(*ldy)*i);CHKERRABORT(PetscObjectComm((PetscObject)ops->ksp),*ierr);
     164        7341 :     *ierr = KSPSolve(ops->ksp,x,y);CHKERRABORT(PetscObjectComm((PetscObject)ops->ksp),*ierr);
     165        7341 :     *ierr = VecResetArray(x);CHKERRABORT(PetscObjectComm((PetscObject)ops->ksp),*ierr);
     166        7341 :     *ierr = VecResetArray(y);CHKERRABORT(PetscObjectComm((PetscObject)ops->ksp),*ierr);
     167             :   }
     168        5306 :   PetscFunctionReturnVoid();
     169             : }
     170             : 
     171          10 : PetscErrorCode EPSSetUp_PRIMME(EPS eps)
     172             : {
     173             :   PetscErrorCode ierr;
     174             :   PetscMPIInt    numProcs,procID;
     175          10 :   EPS_PRIMME     *ops = (EPS_PRIMME*)eps->data;
     176          10 :   primme_params  *primme = &ops->primme;
     177             :   PetscBool      flg;
     178             : 
     179          10 :   PetscFunctionBegin;
     180          10 :   EPSCheckHermitianDefinite(eps);
     181          10 :   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)eps),&numProcs);CHKERRQ(ierr);
     182          10 :   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)eps),&procID);CHKERRQ(ierr);
     183             : 
     184             :   /* Check some constraints and set some default values */
     185          10 :   if (eps->max_it==PETSC_DEFAULT) eps->max_it = PETSC_MAX_INT;
     186          10 :   ierr = STGetMatrix(eps->st,0,&ops->A);CHKERRQ(ierr);
     187          10 :   if (eps->isgeneralized) {
     188             : #if defined(SLEPC_HAVE_PRIMME3)
     189           1 :     ierr = STGetMatrix(eps->st,1,&ops->B);CHKERRQ(ierr);
     190             : #else
     191             :     SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_SUP,"This version of PRIMME is not available for generalized problems");
     192             : #endif
     193             :   }
     194          10 :   EPSCheckUnsupported(eps,EPS_FEATURE_ARBITRARY | EPS_FEATURE_REGION | EPS_FEATURE_STOPPING);
     195          10 :   EPSCheckIgnored(eps,EPS_FEATURE_BALANCE);
     196          10 :   if (!eps->which) eps->which = EPS_LARGEST_REAL;
     197             : #if !defined(SLEPC_HAVE_PRIMME2p2)
     198             :   if (eps->converged != EPSConvergedAbsolute) { ierr = PetscInfo(eps,"Warning: using absolute convergence test\n");CHKERRQ(ierr); }
     199             : #else
     200          10 :   EPSCheckIgnored(eps,EPS_FEATURE_CONVERGENCE);
     201             : #endif
     202             : 
     203             :   /* Transfer SLEPc options to PRIMME options */
     204          10 :   primme_free(primme);
     205          10 :   primme_initialize(primme);
     206          10 :   primme->n                             = eps->n;
     207          10 :   primme->nLocal                        = eps->nloc;
     208          10 :   primme->numEvals                      = eps->nev;
     209          10 :   primme->matrix                        = ops;
     210          10 :   primme->matrixMatvec                  = matrixMatvec_PRIMME;
     211             : #if defined(SLEPC_HAVE_PRIMME3)
     212          10 :   if (eps->isgeneralized) {
     213           1 :     primme->massMatrix                  = ops;
     214           1 :     primme->massMatrixMatvec            = massMatrixMatvec_PRIMME;
     215             :   }
     216             : #endif
     217          10 :   primme->commInfo                      = eps;
     218          10 :   primme->maxOuterIterations            = eps->max_it;
     219             : #if !defined(SLEPC_HAVE_PRIMME2p2)
     220             :   primme->eps                           = eps->tol==PETSC_DEFAULT?SLEPC_DEFAULT_TOL:eps->tol;
     221             : #endif
     222          10 :   primme->numProcs                      = numProcs;
     223          10 :   primme->procID                        = procID;
     224          10 :   primme->printLevel                    = 1;
     225          10 :   primme->correctionParams.precondition = 1;
     226          10 :   primme->globalSumReal                 = par_GlobalSumReal;
     227             : #if defined(SLEPC_HAVE_PRIMME3)
     228          10 :   primme->broadcastReal                 = par_broadcastReal;
     229             : #endif
     230             : #if defined(SLEPC_HAVE_PRIMME2p2)
     231          10 :   primme->convTestFun                   = convTestFun;
     232          10 :   primme->monitorFun                    = monitorFun;
     233             : #endif
     234          10 :   if (ops->bs > 0) primme->maxBlockSize = ops->bs;
     235             : 
     236          10 :   switch (eps->which) {
     237             :     case EPS_LARGEST_REAL:
     238           4 :       primme->target = primme_largest;
     239           4 :       break;
     240             :     case EPS_SMALLEST_REAL:
     241           2 :       primme->target = primme_smallest;
     242           2 :       break;
     243             :     case EPS_LARGEST_MAGNITUDE:
     244           0 :       primme->target = primme_largest_abs;
     245           0 :       ops->target = 0.0;
     246           0 :       primme->numTargetShifts = 1;
     247           0 :       primme->targetShifts = &ops->target;
     248           0 :       break;
     249             :     case EPS_SMALLEST_MAGNITUDE:
     250           1 :       primme->target = primme_closest_abs;
     251           1 :       ops->target = 0.0;
     252           1 :       primme->numTargetShifts = 1;
     253           1 :       primme->targetShifts = &ops->target;
     254           1 :       break;
     255             :     case EPS_TARGET_MAGNITUDE:
     256             :     case EPS_TARGET_REAL:
     257           3 :       primme->target = primme_closest_abs;
     258           3 :       primme->numTargetShifts = 1;
     259           3 :       ops->target = PetscRealPart(eps->target);
     260           3 :       primme->targetShifts = &ops->target;
     261           3 :       break;
     262             :     default:
     263           0 :       SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_SUP,"'which' value not supported by PRIMME");
     264             :       break;
     265             :   }
     266             : 
     267          10 :   switch (eps->extraction) {
     268             :     case EPS_RITZ:
     269           7 :       primme->projectionParams.projection = primme_proj_RR;
     270           7 :       break;
     271             :     case EPS_HARMONIC:
     272           1 :       primme->projectionParams.projection = primme_proj_harmonic;
     273           1 :       break;
     274             :     case EPS_REFINED:
     275           2 :       primme->projectionParams.projection = primme_proj_refined;
     276           2 :       break;
     277             :     default:
     278           0 :       SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_SUP,"'extraction' value not supported by PRIMME");
     279             :       break;
     280             :   }
     281             : 
     282             :   /* If user sets mpd or ncv, maxBasisSize is modified */
     283          10 :   if (eps->mpd!=PETSC_DEFAULT) {
     284           1 :     primme->maxBasisSize = eps->mpd;
     285           1 :     if (eps->ncv!=PETSC_DEFAULT) { ierr = PetscInfo(eps,"Warning: 'ncv' is ignored by PRIMME\n");CHKERRQ(ierr); }
     286           9 :   } else if (eps->ncv!=PETSC_DEFAULT) primme->maxBasisSize = eps->ncv;
     287             : 
     288          10 :   if (primme_set_method(ops->method,primme) < 0) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_SUP,"PRIMME method not valid");
     289             : 
     290          10 :   eps->mpd = primme->maxBasisSize;
     291          10 :   eps->ncv = (primme->locking?eps->nev:0)+primme->maxBasisSize;
     292          10 :   ops->bs  = primme->maxBlockSize;
     293             : 
     294             :   /* Set workspace */
     295          10 :   ierr = EPSAllocateSolution(eps,0);CHKERRQ(ierr);
     296             : 
     297             :   /* Setup the preconditioner */
     298          10 :   if (primme->correctionParams.precondition) {
     299          10 :     ierr = STGetKSP(eps->st,&ops->ksp);CHKERRQ(ierr);
     300          10 :     ierr = PetscObjectTypeCompare((PetscObject)ops->ksp,KSPPREONLY,&flg);CHKERRQ(ierr);
     301          10 :     if (!flg) { ierr = PetscInfo(eps,"Warning: ignoring KSP, should use KSPPREONLY\n");CHKERRQ(ierr); }
     302          10 :     primme->preconditioner = NULL;
     303          10 :     primme->applyPreconditioner = applyPreconditioner_PRIMME;
     304             :   }
     305             : 
     306             :   /* Prepare auxiliary vectors */
     307          10 :   if (!ops->x) {
     308           9 :     ierr = MatCreateVecsEmpty(ops->A,&ops->x,&ops->y);CHKERRQ(ierr);
     309           9 :     ierr = PetscLogObjectParent((PetscObject)eps,(PetscObject)ops->x);CHKERRQ(ierr);
     310           9 :     ierr = PetscLogObjectParent((PetscObject)eps,(PetscObject)ops->y);CHKERRQ(ierr);
     311             :   }
     312          10 :   PetscFunctionReturn(0);
     313             : }
     314             : 
     315          10 : PetscErrorCode EPSSolve_PRIMME(EPS eps)
     316             : {
     317             :   PetscErrorCode ierr;
     318          10 :   EPS_PRIMME     *ops = (EPS_PRIMME*)eps->data;
     319             :   PetscScalar    *a;
     320             :   PetscInt       i,ierrprimme;
     321             :   PetscReal      *evals,*rnorms;
     322             : 
     323          10 :   PetscFunctionBegin;
     324             :   /* Reset some parameters left from previous runs */
     325             : #if defined(SLEPC_HAVE_PRIMME2p2)
     326          10 :   ops->primme.aNorm    = 0.0;
     327             : #else
     328             :   /* Force PRIMME to stop by absolute error */
     329             :   ops->primme.aNorm    = 1.0;
     330             : #endif
     331          10 :   ops->primme.initSize = eps->nini;
     332          10 :   ops->primme.iseed[0] = -1;
     333          10 :   ops->primme.iseed[1] = -1;
     334          10 :   ops->primme.iseed[2] = -1;
     335          10 :   ops->primme.iseed[3] = -1;
     336             : 
     337             :   /* Call PRIMME solver */
     338          10 :   ierr = BVGetArray(eps->V,&a);CHKERRQ(ierr);
     339          10 :   ierr = PetscMalloc2(eps->ncv,&evals,eps->ncv,&rnorms);CHKERRQ(ierr);
     340          10 :   ierrprimme = PRIMME_DRIVER(evals,a,rnorms,&ops->primme);
     341          10 :   for (i=0;i<eps->ncv;i++) eps->eigr[i] = evals[i];
     342         243 :   for (i=0;i<eps->ncv;i++) eps->errest[i] = rnorms[i];
     343          10 :   ierr = PetscFree2(evals,rnorms);CHKERRQ(ierr);
     344          10 :   ierr = BVRestoreArray(eps->V,&a);CHKERRQ(ierr);
     345             : 
     346          10 :   eps->nconv  = ops->primme.initSize >= 0 ? ops->primme.initSize : 0;
     347          10 :   eps->reason = eps->nconv >= eps->nev ? EPS_CONVERGED_TOL: EPS_DIVERGED_ITS;
     348          10 :   eps->its    = ops->primme.stats.numOuterIterations;
     349             : 
     350             :   /* Process PRIMME error code */
     351          10 :   if (ierrprimme == 0) {
     352             :     /* no error */
     353           0 :   } else if (ierrprimme == -1) SETERRQ1(PetscObjectComm((PetscObject)eps),PETSC_ERR_LIB,"PRIMME library failed with error code=%d: unexpected error",ierrprimme);
     354           0 :   else if (ierrprimme == -2) SETERRQ1(PetscObjectComm((PetscObject)eps),PETSC_ERR_LIB,"PRIMME library failed with error code=%d: allocation error",ierrprimme);
     355           0 :   else if (ierrprimme == -3) {
     356             :     /* stop by maximum number of iteration or matvecs */
     357           0 :   } else if (ierrprimme >= -39) SETERRQ1(PetscObjectComm((PetscObject)eps),PETSC_ERR_LIB,"PRIMME library failed with error code=%d: configuration error; check PRIMME's manual",ierrprimme);
     358           0 :   else SETERRQ1(PetscObjectComm((PetscObject)eps),PETSC_ERR_LIB,"PRIMME library failed with error code=%d: runtime error; check PRIMME's manual",ierrprimme);
     359          10 :   PetscFunctionReturn(0);
     360             : }
     361             : 
     362           9 : PetscErrorCode EPSReset_PRIMME(EPS eps)
     363             : {
     364             :   PetscErrorCode ierr;
     365           9 :   EPS_PRIMME     *ops = (EPS_PRIMME*)eps->data;
     366             : 
     367           9 :   PetscFunctionBegin;
     368           9 :   primme_free(&ops->primme);
     369           9 :   ierr = VecDestroy(&ops->x);CHKERRQ(ierr);
     370           9 :   ierr = VecDestroy(&ops->y);CHKERRQ(ierr);
     371           9 :   PetscFunctionReturn(0);
     372             : }
     373             : 
     374           9 : PetscErrorCode EPSDestroy_PRIMME(EPS eps)
     375             : {
     376             :   PetscErrorCode ierr;
     377             : 
     378           9 :   PetscFunctionBegin;
     379           9 :   ierr = PetscFree(eps->data);CHKERRQ(ierr);
     380           9 :   ierr = PetscObjectComposeFunction((PetscObject)eps,"EPSPRIMMESetBlockSize_C",NULL);CHKERRQ(ierr);
     381           9 :   ierr = PetscObjectComposeFunction((PetscObject)eps,"EPSPRIMMESetMethod_C",NULL);CHKERRQ(ierr);
     382           9 :   ierr = PetscObjectComposeFunction((PetscObject)eps,"EPSPRIMMEGetBlockSize_C",NULL);CHKERRQ(ierr);
     383           9 :   ierr = PetscObjectComposeFunction((PetscObject)eps,"EPSPRIMMEGetMethod_C",NULL);CHKERRQ(ierr);
     384           9 :   PetscFunctionReturn(0);
     385             : }
     386             : 
     387           0 : PetscErrorCode EPSView_PRIMME(EPS eps,PetscViewer viewer)
     388             : {
     389             :   PetscErrorCode ierr;
     390             :   PetscBool      isascii;
     391           0 :   EPS_PRIMME     *ctx = (EPS_PRIMME*)eps->data;
     392             :   PetscMPIInt    rank;
     393             : 
     394           0 :   PetscFunctionBegin;
     395           0 :   ierr = PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&isascii);CHKERRQ(ierr);
     396           0 :   if (isascii) {
     397           0 :     ierr = PetscViewerASCIIPrintf(viewer,"  block size=%D\n",ctx->bs);CHKERRQ(ierr);
     398           0 :     ierr = PetscViewerASCIIPrintf(viewer,"  solver method: %s\n",EPSPRIMMEMethods[(EPSPRIMMEMethod)ctx->method]);CHKERRQ(ierr);
     399             : 
     400             :     /* Display PRIMME params */
     401           0 :     ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)eps),&rank);CHKERRQ(ierr);
     402           0 :     if (!rank) primme_display_params(ctx->primme);
     403             :   }
     404           0 :   PetscFunctionReturn(0);
     405             : }
     406             : 
     407           8 : PetscErrorCode EPSSetFromOptions_PRIMME(PetscOptionItems *PetscOptionsObject,EPS eps)
     408             : {
     409             :   PetscErrorCode  ierr;
     410           8 :   EPS_PRIMME      *ctx = (EPS_PRIMME*)eps->data;
     411             :   PetscInt        bs;
     412             :   EPSPRIMMEMethod meth;
     413             :   PetscBool       flg;
     414             : 
     415           8 :   PetscFunctionBegin;
     416           8 :   ierr = PetscOptionsHead(PetscOptionsObject,"EPS PRIMME Options");CHKERRQ(ierr);
     417             : 
     418           8 :     ierr = PetscOptionsInt("-eps_primme_blocksize","Maximum block size","EPSPRIMMESetBlockSize",ctx->bs,&bs,&flg);CHKERRQ(ierr);
     419           8 :     if (flg) { ierr = EPSPRIMMESetBlockSize(eps,bs);CHKERRQ(ierr); }
     420             : 
     421           8 :     ierr = PetscOptionsEnum("-eps_primme_method","Method for solving the eigenproblem","EPSPRIMMESetMethod",EPSPRIMMEMethods,(PetscEnum)ctx->method,(PetscEnum*)&meth,&flg);CHKERRQ(ierr);
     422           8 :     if (flg) { ierr = EPSPRIMMESetMethod(eps,meth);CHKERRQ(ierr); }
     423             : 
     424           8 :   ierr = PetscOptionsTail();CHKERRQ(ierr);
     425           8 :   PetscFunctionReturn(0);
     426             : }
     427             : 
     428           5 : static PetscErrorCode EPSPRIMMESetBlockSize_PRIMME(EPS eps,PetscInt bs)
     429             : {
     430           5 :   EPS_PRIMME *ops = (EPS_PRIMME*)eps->data;
     431             : 
     432           5 :   PetscFunctionBegin;
     433           5 :   if (bs == PETSC_DEFAULT) ops->bs = 0;
     434           5 :   else if (bs <= 0) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_OUTOFRANGE,"PRIMME: block size must be positive");
     435           5 :   else ops->bs = bs;
     436           5 :   PetscFunctionReturn(0);
     437             : }
     438             : 
     439             : /*@
     440             :    EPSPRIMMESetBlockSize - The maximum block size that PRIMME will try to use.
     441             : 
     442             :    Logically Collective on eps
     443             : 
     444             :    Input Parameters:
     445             : +  eps - the eigenproblem solver context
     446             : -  bs - block size
     447             : 
     448             :    Options Database Key:
     449             : .  -eps_primme_blocksize - Sets the max allowed block size value
     450             : 
     451             :    Notes:
     452             :    If the block size is not set, the value established by primme_initialize
     453             :    is used.
     454             : 
     455             :    The user should set the block size based on the architecture specifics
     456             :    of the target computer, as well as any a priori knowledge of multiplicities.
     457             :    The code does NOT require bs > 1 to find multiple eigenvalues. For some
     458             :    methods, keeping bs = 1 yields the best overall performance.
     459             : 
     460             :    Level: advanced
     461             : 
     462             : .seealso: EPSPRIMMEGetBlockSize()
     463             : @*/
     464           5 : PetscErrorCode EPSPRIMMESetBlockSize(EPS eps,PetscInt bs)
     465             : {
     466             :   PetscErrorCode ierr;
     467             : 
     468           5 :   PetscFunctionBegin;
     469           5 :   PetscValidHeaderSpecific(eps,EPS_CLASSID,1);
     470          10 :   PetscValidLogicalCollectiveInt(eps,bs,2);
     471           5 :   ierr = PetscTryMethod(eps,"EPSPRIMMESetBlockSize_C",(EPS,PetscInt),(eps,bs));CHKERRQ(ierr);
     472          10 :   PetscFunctionReturn(0);
     473             : }
     474             : 
     475           4 : static PetscErrorCode EPSPRIMMEGetBlockSize_PRIMME(EPS eps,PetscInt *bs)
     476             : {
     477           4 :   EPS_PRIMME *ops = (EPS_PRIMME*)eps->data;
     478             : 
     479           4 :   PetscFunctionBegin;
     480           4 :   *bs = ops->bs;
     481           4 :   PetscFunctionReturn(0);
     482             : }
     483             : 
     484             : /*@
     485             :    EPSPRIMMEGetBlockSize - Get the maximum block size the code will try to use.
     486             : 
     487             :    Not Collective
     488             : 
     489             :    Input Parameter:
     490             : .  eps - the eigenproblem solver context
     491             : 
     492             :    Output Parameter:
     493             : .  bs - returned block size
     494             : 
     495             :    Level: advanced
     496             : 
     497             : .seealso: EPSPRIMMESetBlockSize()
     498             : @*/
     499           4 : PetscErrorCode EPSPRIMMEGetBlockSize(EPS eps,PetscInt *bs)
     500             : {
     501             :   PetscErrorCode ierr;
     502             : 
     503           4 :   PetscFunctionBegin;
     504           4 :   PetscValidHeaderSpecific(eps,EPS_CLASSID,1);
     505           4 :   PetscValidIntPointer(bs,2);
     506           4 :   ierr = PetscUseMethod(eps,"EPSPRIMMEGetBlockSize_C",(EPS,PetscInt*),(eps,bs));CHKERRQ(ierr);
     507           8 :   PetscFunctionReturn(0);
     508             : }
     509             : 
     510           5 : static PetscErrorCode EPSPRIMMESetMethod_PRIMME(EPS eps,EPSPRIMMEMethod method)
     511             : {
     512           5 :   EPS_PRIMME *ops = (EPS_PRIMME*)eps->data;
     513             : 
     514           5 :   PetscFunctionBegin;
     515           5 :   ops->method = (primme_preset_method)method;
     516           5 :   PetscFunctionReturn(0);
     517             : }
     518             : 
     519             : /*@
     520             :    EPSPRIMMESetMethod - Sets the method for the PRIMME library.
     521             : 
     522             :    Logically Collective on eps
     523             : 
     524             :    Input Parameters:
     525             : +  eps - the eigenproblem solver context
     526             : -  method - method that will be used by PRIMME
     527             : 
     528             :    Options Database Key:
     529             : .  -eps_primme_method - Sets the method for the PRIMME library
     530             : 
     531             :    Note:
     532             :    If not set, the method defaults to EPS_PRIMME_DEFAULT_MIN_TIME.
     533             : 
     534             :    Level: advanced
     535             : 
     536             : .seealso: EPSPRIMMEGetMethod(), EPSPRIMMEMethod
     537             : @*/
     538           5 : PetscErrorCode EPSPRIMMESetMethod(EPS eps,EPSPRIMMEMethod method)
     539             : {
     540             :   PetscErrorCode ierr;
     541             : 
     542           5 :   PetscFunctionBegin;
     543           5 :   PetscValidHeaderSpecific(eps,EPS_CLASSID,1);
     544          10 :   PetscValidLogicalCollectiveEnum(eps,method,2);
     545           5 :   ierr = PetscTryMethod(eps,"EPSPRIMMESetMethod_C",(EPS,EPSPRIMMEMethod),(eps,method));CHKERRQ(ierr);
     546          10 :   PetscFunctionReturn(0);
     547             : }
     548             : 
     549           4 : static PetscErrorCode EPSPRIMMEGetMethod_PRIMME(EPS eps,EPSPRIMMEMethod *method)
     550             : {
     551           4 :   EPS_PRIMME *ops = (EPS_PRIMME*)eps->data;
     552             : 
     553           4 :   PetscFunctionBegin;
     554           4 :   *method = (EPSPRIMMEMethod)ops->method;
     555           4 :   PetscFunctionReturn(0);
     556             : }
     557             : 
     558             : /*@
     559             :    EPSPRIMMEGetMethod - Gets the method for the PRIMME library.
     560             : 
     561             :    Not Collective
     562             : 
     563             :    Input Parameter:
     564             : .  eps - the eigenproblem solver context
     565             : 
     566             :    Output Parameter:
     567             : .  method - method that will be used by PRIMME
     568             : 
     569             :    Level: advanced
     570             : 
     571             : .seealso: EPSPRIMMESetMethod(), EPSPRIMMEMethod
     572             : @*/
     573           4 : PetscErrorCode EPSPRIMMEGetMethod(EPS eps,EPSPRIMMEMethod *method)
     574             : {
     575             :   PetscErrorCode ierr;
     576             : 
     577           4 :   PetscFunctionBegin;
     578           4 :   PetscValidHeaderSpecific(eps,EPS_CLASSID,1);
     579           4 :   PetscValidPointer(method,2);
     580           4 :   ierr = PetscUseMethod(eps,"EPSPRIMMEGetMethod_C",(EPS,EPSPRIMMEMethod*),(eps,method));CHKERRQ(ierr);
     581           8 :   PetscFunctionReturn(0);
     582             : }
     583             : 
     584           9 : SLEPC_EXTERN PetscErrorCode EPSCreate_PRIMME(EPS eps)
     585             : {
     586             :   PetscErrorCode ierr;
     587             :   EPS_PRIMME     *primme;
     588             : 
     589           9 :   PetscFunctionBegin;
     590           9 :   ierr = PetscNewLog(eps,&primme);CHKERRQ(ierr);
     591           9 :   eps->data = (void*)primme;
     592             : 
     593           9 :   primme_initialize(&primme->primme);
     594           9 :   primme->primme.globalSumReal = par_GlobalSumReal;
     595             : #if defined(SLEPC_HAVE_PRIMME3)
     596           9 :   primme->primme.broadcastReal = par_broadcastReal;
     597             : #endif
     598             : #if defined(SLEPC_HAVE_PRIMME2p2)
     599           9 :   primme->primme.convTestFun = convTestFun;
     600           9 :   primme->primme.monitorFun = monitorFun;
     601             : #endif
     602           9 :   primme->method = (primme_preset_method)EPS_PRIMME_DEFAULT_MIN_TIME;
     603             : 
     604           9 :   eps->categ = EPS_CATEGORY_PRECOND;
     605             : 
     606           9 :   eps->ops->solve          = EPSSolve_PRIMME;
     607           9 :   eps->ops->setup          = EPSSetUp_PRIMME;
     608           9 :   eps->ops->setupsort      = EPSSetUpSort_Basic;
     609           9 :   eps->ops->setfromoptions = EPSSetFromOptions_PRIMME;
     610           9 :   eps->ops->destroy        = EPSDestroy_PRIMME;
     611           9 :   eps->ops->reset          = EPSReset_PRIMME;
     612           9 :   eps->ops->view           = EPSView_PRIMME;
     613           9 :   eps->ops->backtransform  = EPSBackTransform_Default;
     614           9 :   eps->ops->setdefaultst   = EPSSetDefaultST_GMRES;
     615             : 
     616           9 :   ierr = PetscObjectComposeFunction((PetscObject)eps,"EPSPRIMMESetBlockSize_C",EPSPRIMMESetBlockSize_PRIMME);CHKERRQ(ierr);
     617           9 :   ierr = PetscObjectComposeFunction((PetscObject)eps,"EPSPRIMMESetMethod_C",EPSPRIMMESetMethod_PRIMME);CHKERRQ(ierr);
     618           9 :   ierr = PetscObjectComposeFunction((PetscObject)eps,"EPSPRIMMEGetBlockSize_C",EPSPRIMMEGetBlockSize_PRIMME);CHKERRQ(ierr);
     619           9 :   ierr = PetscObjectComposeFunction((PetscObject)eps,"EPSPRIMMEGetMethod_C",EPSPRIMMEGetMethod_PRIMME);CHKERRQ(ierr);
     620           9 :   PetscFunctionReturn(0);
     621             : }
     622             : 

Generated by: LCOV version 1.13