Actual source code: fnbasic.c

slepc-3.14.0 2020-09-30
Report Typos and Errors
  1: /*
  2:    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  3:    SLEPc - Scalable Library for Eigenvalue Problem Computations
  4:    Copyright (c) 2002-2020, Universitat Politecnica de Valencia, Spain

  6:    This file is part of SLEPc.
  7:    SLEPc is distributed under a 2-clause BSD license (see LICENSE).
  8:    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  9: */
 10: /*
 11:    Basic FN routines
 12: */

 14: #include <slepc/private/fnimpl.h>
 15: #include <slepcblaslapack.h>

 17: PetscFunctionList FNList = 0;
 18: PetscBool         FNRegisterAllCalled = PETSC_FALSE;
 19: PetscClassId      FN_CLASSID = 0;
 20: PetscLogEvent     FN_Evaluate = 0;
 21: static PetscBool  FNPackageInitialized = PETSC_FALSE;

 23: const char *FNParallelTypes[] = {"REDUNDANT","SYNCHRONIZED","FNParallelType","FN_PARALLEL_",0};

 25: /*@C
 26:    FNFinalizePackage - This function destroys everything in the Slepc interface
 27:    to the FN package. It is called from SlepcFinalize().

 29:    Level: developer

 31: .seealso: SlepcFinalize()
 32: @*/
 33: PetscErrorCode FNFinalizePackage(void)
 34: {

 38:   PetscFunctionListDestroy(&FNList);
 39:   FNPackageInitialized = PETSC_FALSE;
 40:   FNRegisterAllCalled  = PETSC_FALSE;
 41:   return(0);
 42: }

 44: /*@C
 45:   FNInitializePackage - This function initializes everything in the FN package.
 46:   It is called from PetscDLLibraryRegister() when using dynamic libraries, and
 47:   on the first call to FNCreate() when using static libraries.

 49:   Level: developer

 51: .seealso: SlepcInitialize()
 52: @*/
 53: PetscErrorCode FNInitializePackage(void)
 54: {
 55:   char           logList[256];
 56:   PetscBool      opt,pkg;
 57:   PetscClassId   classids[1];

 61:   if (FNPackageInitialized) return(0);
 62:   FNPackageInitialized = PETSC_TRUE;
 63:   /* Register Classes */
 64:   PetscClassIdRegister("Math Function",&FN_CLASSID);
 65:   /* Register Constructors */
 66:   FNRegisterAll();
 67:   /* Register Events */
 68:   PetscLogEventRegister("FNEvaluate",FN_CLASSID,&FN_Evaluate);
 69:   /* Process Info */
 70:   classids[0] = FN_CLASSID;
 71:   PetscInfoProcessClass("fn",1,&classids[0]);
 72:   /* Process summary exclusions */
 73:   PetscOptionsGetString(NULL,NULL,"-log_exclude",logList,sizeof(logList),&opt);
 74:   if (opt) {
 75:     PetscStrInList("fn",logList,',',&pkg);
 76:     if (pkg) { PetscLogEventDeactivateClass(FN_CLASSID); }
 77:   }
 78:   /* Register package finalizer */
 79:   PetscRegisterFinalize(FNFinalizePackage);
 80:   return(0);
 81: }

 83: /*@
 84:    FNCreate - Creates an FN context.

 86:    Collective

 88:    Input Parameter:
 89: .  comm - MPI communicator

 91:    Output Parameter:
 92: .  newfn - location to put the FN context

 94:    Level: beginner

 96: .seealso: FNDestroy(), FN
 97: @*/
 98: PetscErrorCode FNCreate(MPI_Comm comm,FN *newfn)
 99: {
100:   FN             fn;

105:   *newfn = 0;
106:   FNInitializePackage();
107:   SlepcHeaderCreate(fn,FN_CLASSID,"FN","Math Function","FN",comm,FNDestroy,FNView);

109:   fn->alpha    = 1.0;
110:   fn->beta     = 1.0;
111:   fn->method   = 0;

113:   fn->nw       = 0;
114:   fn->cw       = 0;
115:   fn->data     = NULL;

117:   *newfn = fn;
118:   return(0);
119: }

121: /*@C
122:    FNSetOptionsPrefix - Sets the prefix used for searching for all
123:    FN options in the database.

125:    Logically Collective on fn

127:    Input Parameters:
128: +  fn - the math function context
129: -  prefix - the prefix string to prepend to all FN option requests

131:    Notes:
132:    A hyphen (-) must NOT be given at the beginning of the prefix name.
133:    The first character of all runtime options is AUTOMATICALLY the
134:    hyphen.

136:    Level: advanced

138: .seealso: FNAppendOptionsPrefix()
139: @*/
140: PetscErrorCode FNSetOptionsPrefix(FN fn,const char *prefix)
141: {

146:   PetscObjectSetOptionsPrefix((PetscObject)fn,prefix);
147:   return(0);
148: }

150: /*@C
151:    FNAppendOptionsPrefix - Appends to the prefix used for searching for all
152:    FN options in the database.

154:    Logically Collective on fn

156:    Input Parameters:
157: +  fn - the math function context
158: -  prefix - the prefix string to prepend to all FN option requests

160:    Notes:
161:    A hyphen (-) must NOT be given at the beginning of the prefix name.
162:    The first character of all runtime options is AUTOMATICALLY the hyphen.

164:    Level: advanced

166: .seealso: FNSetOptionsPrefix()
167: @*/
168: PetscErrorCode FNAppendOptionsPrefix(FN fn,const char *prefix)
169: {

174:   PetscObjectAppendOptionsPrefix((PetscObject)fn,prefix);
175:   return(0);
176: }

178: /*@C
179:    FNGetOptionsPrefix - Gets the prefix used for searching for all
180:    FN options in the database.

182:    Not Collective

184:    Input Parameters:
185: .  fn - the math function context

187:    Output Parameters:
188: .  prefix - pointer to the prefix string used is returned

190:    Note:
191:    On the Fortran side, the user should pass in a string 'prefix' of
192:    sufficient length to hold the prefix.

194:    Level: advanced

196: .seealso: FNSetOptionsPrefix(), FNAppendOptionsPrefix()
197: @*/
198: PetscErrorCode FNGetOptionsPrefix(FN fn,const char *prefix[])
199: {

205:   PetscObjectGetOptionsPrefix((PetscObject)fn,prefix);
206:   return(0);
207: }

209: /*@C
210:    FNSetType - Selects the type for the FN object.

212:    Logically Collective on fn

214:    Input Parameter:
215: +  fn   - the math function context
216: -  type - a known type

218:    Notes:
219:    The default is FNRATIONAL, which includes polynomials as a particular
220:    case as well as simple functions such as f(x)=x and f(x)=constant.

222:    Level: intermediate

224: .seealso: FNGetType()
225: @*/
226: PetscErrorCode FNSetType(FN fn,FNType type)
227: {
228:   PetscErrorCode ierr,(*r)(FN);
229:   PetscBool      match;


235:   PetscObjectTypeCompare((PetscObject)fn,type,&match);
236:   if (match) return(0);

238:    PetscFunctionListFind(FNList,type,&r);
239:   if (!r) SETERRQ1(PetscObjectComm((PetscObject)fn),PETSC_ERR_ARG_UNKNOWN_TYPE,"Unable to find requested FN type %s",type);

241:   if (fn->ops->destroy) { (*fn->ops->destroy)(fn); }
242:   PetscMemzero(fn->ops,sizeof(struct _FNOps));

244:   PetscObjectChangeTypeName((PetscObject)fn,type);
245:   (*r)(fn);
246:   return(0);
247: }

249: /*@C
250:    FNGetType - Gets the FN type name (as a string) from the FN context.

252:    Not Collective

254:    Input Parameter:
255: .  fn - the math function context

257:    Output Parameter:
258: .  name - name of the math function

260:    Level: intermediate

262: .seealso: FNSetType()
263: @*/
264: PetscErrorCode FNGetType(FN fn,FNType *type)
265: {
269:   *type = ((PetscObject)fn)->type_name;
270:   return(0);
271: }

273: /*@
274:    FNSetScale - Sets the scaling parameters that define the matematical function.

276:    Logically Collective on fn

278:    Input Parameters:
279: +  fn    - the math function context
280: .  alpha - inner scaling (argument)
281: -  beta  - outer scaling (result)

283:    Notes:
284:    Given a function f(x) specified by the FN type, the scaling parameters can
285:    be used to realize the function beta*f(alpha*x). So when these values are given,
286:    the procedure for function evaluation will first multiply the argument by alpha,
287:    then evaluate the function itself, and finally scale the result by beta.
288:    Likewise, these values are also considered when evaluating the derivative.

290:    If you want to provide only one of the two scaling factors, set the other
291:    one to 1.0.

293:    Level: intermediate

295: .seealso: FNGetScale(), FNEvaluateFunction()
296: @*/
297: PetscErrorCode FNSetScale(FN fn,PetscScalar alpha,PetscScalar beta)
298: {
303:   if (PetscAbsScalar(alpha)==0.0 || PetscAbsScalar(beta)==0.0) SETERRQ(PetscObjectComm((PetscObject)fn),PETSC_ERR_ARG_WRONG,"Scaling factors must be nonzero");
304:   fn->alpha = alpha;
305:   fn->beta  = beta;
306:   return(0);
307: }

309: /*@
310:    FNGetScale - Gets the scaling parameters that define the matematical function.

312:    Not Collective

314:    Input Parameter:
315: .  fn    - the math function context

317:    Output Parameters:
318: +  alpha - inner scaling (argument)
319: -  beta  - outer scaling (result)

321:    Level: intermediate

323: .seealso: FNSetScale()
324: @*/
325: PetscErrorCode FNGetScale(FN fn,PetscScalar *alpha,PetscScalar *beta)
326: {
329:   if (alpha) *alpha = fn->alpha;
330:   if (beta)  *beta  = fn->beta;
331:   return(0);
332: }

334: /*@
335:    FNSetMethod - Selects the method to be used to evaluate functions of matrices.

337:    Logically Collective on fn

339:    Input Parameter:
340: +  fn   - the math function context
341: -  meth - an index indentifying the method

343:    Options Database Key:
344: .  -fn_method <meth> - Sets the method

346:    Notes:
347:    In some FN types there are more than one algorithms available for computing
348:    matrix functions. In that case, this function allows choosing the wanted method.

350:    If meth is currently set to 0 (the default) and the input argument A of
351:    FNEvaluateFunctionMat() is a symmetric/Hermitian matrix, then the computation
352:    is done via the eigendecomposition of A, rather than with the general algorithm.

354:    Level: intermediate

356: .seealso: FNGetMethod(), FNEvaluateFunctionMat()
357: @*/
358: PetscErrorCode FNSetMethod(FN fn,PetscInt meth)
359: {
363:   if (meth<0) SETERRQ(PetscObjectComm((PetscObject)fn),PETSC_ERR_ARG_OUTOFRANGE,"The method must be a non-negative integer");
364:   if (meth>FN_MAX_SOLVE) SETERRQ(PetscObjectComm((PetscObject)fn),PETSC_ERR_ARG_OUTOFRANGE,"Too large value for the method");
365:   fn->method = meth;
366:   return(0);
367: }

369: /*@
370:    FNGetMethod - Gets the method currently used in the FN.

372:    Not Collective

374:    Input Parameter:
375: .  fn - the math function context

377:    Output Parameter:
378: .  meth - identifier of the method

380:    Level: intermediate

382: .seealso: FNSetMethod()
383: @*/
384: PetscErrorCode FNGetMethod(FN fn,PetscInt *meth)
385: {
389:   *meth = fn->method;
390:   return(0);
391: }

393: /*@
394:    FNSetParallel - Selects the mode of operation in parallel runs.

396:    Logically Collective on fn

398:    Input Parameter:
399: +  fn    - the math function context
400: -  pmode - the parallel mode

402:    Options Database Key:
403: .  -fn_parallel <mode> - Sets the parallel mode, either 'redundant' or 'synchronized'

405:    Notes:
406:    This is relevant only when the function is evaluated on a matrix, with
407:    either FNEvaluateFunctionMat() or FNEvaluateFunctionMatVec().

409:    In the 'redundant' parallel mode, all processes will make the computation
410:    redundantly, starting from the same data, and producing the same result.
411:    This result may be slightly different in the different processes if using a
412:    multithreaded BLAS library, which may cause issues in ill-conditioned problems.

414:    In the 'synchronized' parallel mode, only the first MPI process performs the
415:    computation and then the computed matrix is broadcast to the other
416:    processes in the communicator. This communication is done automatically at
417:    the end of FNEvaluateFunctionMat() or FNEvaluateFunctionMatVec().

419:    Level: advanced

421: .seealso: FNEvaluateFunctionMat() or FNEvaluateFunctionMatVec(), FNGetParallel()
422: @*/
423: PetscErrorCode FNSetParallel(FN fn,FNParallelType pmode)
424: {
428:   fn->pmode = pmode;
429:   return(0);
430: }

432: /*@
433:    FNGetParallel - Gets the mode of operation in parallel runs.

435:    Not Collective

437:    Input Parameter:
438: .  fn - the math function context

440:    Output Parameter:
441: .  pmode - the parallel mode

443:    Level: advanced

445: .seealso: FNSetParallel()
446: @*/
447: PetscErrorCode FNGetParallel(FN fn,FNParallelType *pmode)
448: {
452:   *pmode = fn->pmode;
453:   return(0);
454: }

456: /*@
457:    FNEvaluateFunction - Computes the value of the function f(x) for a given x.

459:    Not collective

461:    Input Parameters:
462: +  fn - the math function context
463: -  x  - the value where the function must be evaluated

465:    Output Parameter:
466: .  y  - the result of f(x)

468:    Note:
469:    Scaling factors are taken into account, so the actual function evaluation
470:    will return beta*f(alpha*x).

472:    Level: intermediate

474: .seealso: FNEvaluateDerivative(), FNEvaluateFunctionMat(), FNSetScale()
475: @*/
476: PetscErrorCode FNEvaluateFunction(FN fn,PetscScalar x,PetscScalar *y)
477: {
479:   PetscScalar    xf,yf;

485:   PetscLogEventBegin(FN_Evaluate,fn,0,0,0);
486:   xf = fn->alpha*x;
487:   (*fn->ops->evaluatefunction)(fn,xf,&yf);
488:   *y = fn->beta*yf;
489:   PetscLogEventEnd(FN_Evaluate,fn,0,0,0);
490:   return(0);
491: }

493: /*@
494:    FNEvaluateDerivative - Computes the value of the derivative f'(x) for a given x.

496:    Not Collective

498:    Input Parameters:
499: +  fn - the math function context
500: -  x  - the value where the derivative must be evaluated

502:    Output Parameter:
503: .  y  - the result of f'(x)

505:    Note:
506:    Scaling factors are taken into account, so the actual derivative evaluation will
507:    return alpha*beta*f'(alpha*x).

509:    Level: intermediate

511: .seealso: FNEvaluateFunction()
512: @*/
513: PetscErrorCode FNEvaluateDerivative(FN fn,PetscScalar x,PetscScalar *y)
514: {
516:   PetscScalar    xf,yf;

522:   PetscLogEventBegin(FN_Evaluate,fn,0,0,0);
523:   xf = fn->alpha*x;
524:   (*fn->ops->evaluatederivative)(fn,xf,&yf);
525:   *y = fn->alpha*fn->beta*yf;
526:   PetscLogEventEnd(FN_Evaluate,fn,0,0,0);
527:   return(0);
528: }

530: static PetscErrorCode FNEvaluateFunctionMat_Sym_Private(FN fn,PetscScalar *As,PetscScalar *Bs,PetscInt m,PetscBool firstonly)
531: {
533:   PetscInt       i,j;
534:   PetscBLASInt   n,k,ld,lwork,info;
535:   PetscScalar    *Q,*W,*work,a,x,y,one=1.0,zero=0.0;
536:   PetscReal      *eig,dummy;
537: #if defined(PETSC_USE_COMPLEX)
538:   PetscReal      *rwork,rdummy;
539: #endif

542:   PetscBLASIntCast(m,&n);
543:   ld = n;
544:   k = firstonly? 1: n;

546:   /* workspace query and memory allocation */
547:   lwork = -1;
548: #if defined(PETSC_USE_COMPLEX)
549:   PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","L",&n,As,&ld,&dummy,&a,&lwork,&rdummy,&info));
550:   PetscBLASIntCast((PetscInt)PetscRealPart(a),&lwork);
551:   PetscMalloc5(m,&eig,m*m,&Q,m*k,&W,lwork,&work,PetscMax(1,3*m-2),&rwork);
552: #else
553:   PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","L",&n,As,&ld,&dummy,&a,&lwork,&info));
554:   PetscBLASIntCast((PetscInt)PetscRealPart(a),&lwork);
555:   PetscMalloc4(m,&eig,m*m,&Q,m*k,&W,lwork,&work);
556: #endif

558:   /* compute eigendecomposition */
559:   for (j=0;j<n;j++) for (i=j;i<n;i++) Q[i+j*ld] = As[i+j*ld];
560: #if defined(PETSC_USE_COMPLEX)
561:   PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","L",&n,Q,&ld,eig,work,&lwork,rwork,&info));
562: #else
563:   PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","L",&n,Q,&ld,eig,work,&lwork,&info));
564: #endif
565:   SlepcCheckLapackInfo("syev",info);

567:   /* W = f(Lambda)*Q' */
568:   for (i=0;i<n;i++) {
569:     x = fn->alpha*eig[i];
570:     (*fn->ops->evaluatefunction)(fn,x,&y);  /* y = f(x) */
571:     for (j=0;j<k;j++) W[i+j*ld] = PetscConj(Q[j+i*ld])*fn->beta*y;
572:   }
573:   /* Bs = Q*W */
574:   PetscStackCallBLAS("BLASgemm",BLASgemm_("N","N",&n,&k,&n,&one,Q,&ld,W,&ld,&zero,Bs,&ld));
575: #if defined(PETSC_USE_COMPLEX)
576:   PetscFree5(eig,Q,W,work,rwork);
577: #else
578:   PetscFree4(eig,Q,W,work);
579: #endif
580:   PetscLogFlops(9.0*n*n*n+2.0*n*n*n);
581:   return(0);
582: }

584: /*
585:    FNEvaluateFunctionMat_Sym_Default - given a symmetric matrix A,
586:    compute the matrix function as f(A)=Q*f(D)*Q' where the spectral
587:    decomposition of A is A=Q*D*Q'
588: */
589: static PetscErrorCode FNEvaluateFunctionMat_Sym_Default(FN fn,Mat A,Mat B)
590: {
592:   PetscInt       m;
593:   PetscScalar    *As,*Bs;

596:   MatDenseGetArray(A,&As);
597:   MatDenseGetArray(B,&Bs);
598:   MatGetSize(A,&m,NULL);
599:   FNEvaluateFunctionMat_Sym_Private(fn,As,Bs,m,PETSC_FALSE);
600:   MatDenseRestoreArray(A,&As);
601:   MatDenseRestoreArray(B,&Bs);
602:   return(0);
603: }

605: PetscErrorCode FNEvaluateFunctionMat_Private(FN fn,Mat A,Mat B,PetscBool sync)
606: {
608:   PetscBool      set,flg,symm=PETSC_FALSE;
609:   PetscInt       m,n;
610:   PetscMPIInt    size,rank;
611:   PetscScalar    *pF;
612:   Mat            M,F;

615:   /* destination matrix */
616:   F = B?B:A;

618:   /* check symmetry of A */
619:   MatIsHermitianKnown(A,&set,&flg);
620:   symm = set? flg: PETSC_FALSE;

622:   MPI_Comm_size(PetscObjectComm((PetscObject)fn),&size);
623:   MPI_Comm_rank(PetscObjectComm((PetscObject)fn),&rank);
624:   if (size==1 || fn->pmode==FN_PARALLEL_REDUNDANT || (fn->pmode==FN_PARALLEL_SYNCHRONIZED && !rank)) {

626:     PetscFPTrapPush(PETSC_FP_TRAP_OFF);
627:     if (symm && !fn->method) {  /* prefer diagonalization */
628:       PetscInfo(fn,"Computing matrix function via diagonalization\n");
629:       FNEvaluateFunctionMat_Sym_Default(fn,A,F);
630:     } else {
631:       /* scale argument */
632:       if (fn->alpha!=(PetscScalar)1.0) {
633:         FN_AllocateWorkMat(fn,A,&M);
634:         MatScale(M,fn->alpha);
635:       } else M = A;
636:       if (fn->ops->evaluatefunctionmat[fn->method]) {
637:         (*fn->ops->evaluatefunctionmat[fn->method])(fn,M,F);
638:       } else if (!fn->method) SETERRQ(PetscObjectComm((PetscObject)fn),PETSC_ERR_SUP,"Matrix functions not implemented in this FN type");
639:       else SETERRQ(PetscObjectComm((PetscObject)fn),PETSC_ERR_ARG_OUTOFRANGE,"The specified method number does not exist for this FN type");
640:       if (fn->alpha!=(PetscScalar)1.0) {
641:         FN_FreeWorkMat(fn,&M);
642:       }
643:       /* scale result */
644:       MatScale(F,fn->beta);
645:     }
646:     PetscFPTrapPop();
647:   }
648:   if (size>1 && fn->pmode==FN_PARALLEL_SYNCHRONIZED && sync) {  /* synchronize */
649:     MatGetSize(A,&m,&n);
650:     MatDenseGetArray(F,&pF);
651:     MPI_Bcast(pF,n*n,MPIU_SCALAR,0,PetscObjectComm((PetscObject)fn));
652:     MatDenseRestoreArray(F,&pF);
653:   }
654:   return(0);
655: }

657: /*@
658:    FNEvaluateFunctionMat - Computes the value of the function f(A) for a given
659:    matrix A, where the result is also a matrix.

661:    Logically Collective on fn

663:    Input Parameters:
664: +  fn - the math function context
665: -  A  - matrix on which the function must be evaluated

667:    Output Parameter:
668: .  B  - (optional) matrix resulting from evaluating f(A)

670:    Notes:
671:    Matrix A must be a square sequential dense Mat, with all entries equal on
672:    all processes (otherwise each process will compute different results).
673:    If matrix B is provided, it must also be a square sequential dense Mat, and
674:    both matrices must have the same dimensions. If B is NULL (or B=A) then the
675:    function will perform an in-place computation, overwriting A with f(A).

677:    If A is known to be real symmetric or complex Hermitian then it is
678:    recommended to set the appropriate flag with MatSetOption(), because
679:    symmetry can sometimes be exploited by the algorithm.

681:    Scaling factors are taken into account, so the actual function evaluation
682:    will return beta*f(alpha*A).

684:    Level: advanced

686: .seealso: FNEvaluateFunction(), FNEvaluateFunctionMatVec(), FNSetMethod()
687: @*/
688: PetscErrorCode FNEvaluateFunctionMat(FN fn,Mat A,Mat B)
689: {
691:   PetscBool      match,inplace=PETSC_FALSE;
692:   PetscInt       m,n,n1;

699:   if (B) {
702:   } else inplace = PETSC_TRUE;
703:   PetscObjectTypeCompare((PetscObject)A,MATSEQDENSE,&match);
704:   if (!match) SETERRQ(PetscObjectComm((PetscObject)fn),PETSC_ERR_SUP,"Mat A must be of type seqdense");
705:   MatGetSize(A,&m,&n);
706:   if (m!=n) SETERRQ2(PetscObjectComm((PetscObject)fn),PETSC_ERR_ARG_SIZ,"Mat A is not square (has %D rows, %D cols)",m,n);
707:   if (!inplace) {
708:     PetscObjectTypeCompare((PetscObject)B,MATSEQDENSE,&match);
709:     if (!match) SETERRQ(PetscObjectComm((PetscObject)fn),PETSC_ERR_SUP,"Mat B must be of type seqdense");
710:     n1 = n;
711:     MatGetSize(B,&m,&n);
712:     if (m!=n) SETERRQ2(PetscObjectComm((PetscObject)fn),PETSC_ERR_ARG_SIZ,"Mat B is not square (has %D rows, %D cols)",m,n);
713:     if (n1!=n) SETERRQ(PetscObjectComm((PetscObject)fn),PETSC_ERR_ARG_SIZ,"Matrices A and B must have the same dimension");
714:   }

716:   /* evaluate matrix function */
717:   PetscLogEventBegin(FN_Evaluate,fn,0,0,0);
718:   FNEvaluateFunctionMat_Private(fn,A,B,PETSC_TRUE);
719:   PetscLogEventEnd(FN_Evaluate,fn,0,0,0);
720:   return(0);
721: }

723: /*
724:    FNEvaluateFunctionMatVec_Default - computes the full matrix f(A)
725:    and then copies the first column.
726: */
727: static PetscErrorCode FNEvaluateFunctionMatVec_Default(FN fn,Mat A,Vec v)
728: {
730:   Mat            F;

733:   FN_AllocateWorkMat(fn,A,&F);
734:   if (fn->ops->evaluatefunctionmat[fn->method]) {
735:     (*fn->ops->evaluatefunctionmat[fn->method])(fn,A,F);
736:   } else if (!fn->method) SETERRQ(PetscObjectComm((PetscObject)fn),PETSC_ERR_SUP,"Matrix functions not implemented in this FN type");
737:   else SETERRQ(PetscObjectComm((PetscObject)fn),PETSC_ERR_ARG_OUTOFRANGE,"The specified method number does not exist for this FN type");
738:   MatGetColumnVector(F,v,0);
739:   FN_FreeWorkMat(fn,&F);
740:   return(0);
741: }

743: /*
744:    FNEvaluateFunctionMatVec_Sym_Default - given a symmetric matrix A,
745:    compute the matrix function as f(A)=Q*f(D)*Q' where the spectral
746:    decomposition of A is A=Q*D*Q'. Only the first column is computed.
747: */
748: static PetscErrorCode FNEvaluateFunctionMatVec_Sym_Default(FN fn,Mat A,Vec v)
749: {
751:   PetscInt       m;
752:   PetscScalar    *As,*vs;

755:   MatDenseGetArray(A,&As);
756:   VecGetArray(v,&vs);
757:   MatGetSize(A,&m,NULL);
758:   FNEvaluateFunctionMat_Sym_Private(fn,As,vs,m,PETSC_TRUE);
759:   MatDenseRestoreArray(A,&As);
760:   VecRestoreArray(v,&vs);
761:   return(0);
762: }

764: PetscErrorCode FNEvaluateFunctionMatVec_Private(FN fn,Mat A,Vec v,PetscBool sync)
765: {
767:   PetscBool      set,flg,symm=PETSC_FALSE;
768:   PetscInt       m,n;
769:   Mat            M;
770:   PetscMPIInt    size,rank;
771:   PetscScalar    *pv;

774:   /* check symmetry of A */
775:   MatIsHermitianKnown(A,&set,&flg);
776:   symm = set? flg: PETSC_FALSE;

778:   /* evaluate matrix function */
779:   MPI_Comm_size(PetscObjectComm((PetscObject)fn),&size);
780:   MPI_Comm_rank(PetscObjectComm((PetscObject)fn),&rank);
781:   if (size==1 || fn->pmode==FN_PARALLEL_REDUNDANT || (fn->pmode==FN_PARALLEL_SYNCHRONIZED && !rank)) {
782:     PetscFPTrapPush(PETSC_FP_TRAP_OFF);
783:     if (symm && !fn->method) {  /* prefer diagonalization */
784:       PetscInfo(fn,"Computing matrix function via diagonalization\n");
785:       FNEvaluateFunctionMatVec_Sym_Default(fn,A,v);
786:     } else {
787:       /* scale argument */
788:       if (fn->alpha!=(PetscScalar)1.0) {
789:         FN_AllocateWorkMat(fn,A,&M);
790:         MatScale(M,fn->alpha);
791:       } else M = A;
792:       if (fn->ops->evaluatefunctionmatvec[fn->method]) {
793:         (*fn->ops->evaluatefunctionmatvec[fn->method])(fn,M,v);
794:       } else {
795:         FNEvaluateFunctionMatVec_Default(fn,M,v);
796:       }
797:       if (fn->alpha!=(PetscScalar)1.0) {
798:         FN_FreeWorkMat(fn,&M);
799:       }
800:       /* scale result */
801:       VecScale(v,fn->beta);
802:     }
803:     PetscFPTrapPop();
804:   }

806:   /* synchronize */
807:   if (size>1 && fn->pmode==FN_PARALLEL_SYNCHRONIZED && sync) {
808:     MatGetSize(A,&m,&n);
809:     VecGetArray(v,&pv);
810:     MPI_Bcast(pv,n,MPIU_SCALAR,0,PetscObjectComm((PetscObject)fn));
811:     VecRestoreArray(v,&pv);
812:   }
813:   return(0);
814: }

816: /*@
817:    FNEvaluateFunctionMatVec - Computes the first column of the matrix f(A)
818:    for a given matrix A.

820:    Logically Collective on fn

822:    Input Parameters:
823: +  fn - the math function context
824: -  A  - matrix on which the function must be evaluated

826:    Output Parameter:
827: .  v  - vector to hold the first column of f(A)

829:    Notes:
830:    This operation is similar to FNEvaluateFunctionMat() but returns only
831:    the first column of f(A), hence saving computations in most cases.

833:    Level: advanced

835: .seealso: FNEvaluateFunction(), FNEvaluateFunctionMat(), FNSetMethod()
836: @*/
837: PetscErrorCode FNEvaluateFunctionMatVec(FN fn,Mat A,Vec v)
838: {
840:   PetscBool      match;
841:   PetscInt       m,n;

850:   PetscObjectTypeCompare((PetscObject)A,MATSEQDENSE,&match);
851:   if (!match) SETERRQ(PetscObjectComm((PetscObject)fn),PETSC_ERR_SUP,"Mat A must be of type seqdense");
852:   MatGetSize(A,&m,&n);
853:   if (m!=n) SETERRQ2(PetscObjectComm((PetscObject)fn),PETSC_ERR_ARG_SIZ,"Mat A is not square (has %D rows, %D cols)",m,n);
854:   VecGetSize(v,&m);
855:   if (m!=n) SETERRQ(PetscObjectComm((PetscObject)fn),PETSC_ERR_ARG_SIZ,"Matrix A and vector v must have the same size");
856:   PetscLogEventBegin(FN_Evaluate,fn,0,0,0);
857:   FNEvaluateFunctionMatVec_Private(fn,A,v,PETSC_TRUE);
858:   PetscLogEventEnd(FN_Evaluate,fn,0,0,0);
859:   return(0);
860: }

862: /*@
863:    FNSetFromOptions - Sets FN options from the options database.

865:    Collective on fn

867:    Input Parameters:
868: .  fn - the math function context

870:    Notes:
871:    To see all options, run your program with the -help option.

873:    Level: beginner
874: @*/
875: PetscErrorCode FNSetFromOptions(FN fn)
876: {
878:   char           type[256];
879:   PetscScalar    array[2];
880:   PetscInt       k,meth;
881:   PetscBool      flg;
882:   FNParallelType pmode;

886:   FNRegisterAll();
887:   PetscObjectOptionsBegin((PetscObject)fn);
888:     PetscOptionsFList("-fn_type","Math function type","FNSetType",FNList,(char*)(((PetscObject)fn)->type_name?((PetscObject)fn)->type_name:FNRATIONAL),type,sizeof(type),&flg);
889:     if (flg) {
890:       FNSetType(fn,type);
891:     } else if (!((PetscObject)fn)->type_name) {
892:       FNSetType(fn,FNRATIONAL);
893:     }

895:     k = 2;
896:     array[0] = 0.0; array[1] = 0.0;
897:     PetscOptionsScalarArray("-fn_scale","Scale factors (one or two scalar values separated with a comma without spaces)","FNSetScale",array,&k,&flg);
898:     if (flg) {
899:       if (k<2) array[1] = 1.0;
900:       FNSetScale(fn,array[0],array[1]);
901:     }

903:     PetscOptionsInt("-fn_method","Method to be used for computing matrix functions","FNSetMethod",fn->method,&meth,&flg);
904:     if (flg) { FNSetMethod(fn,meth); }

906:     PetscOptionsEnum("-fn_parallel","Operation mode in parallel runs","FNSetParallel",FNParallelTypes,(PetscEnum)fn->pmode,(PetscEnum*)&pmode,&flg);
907:     if (flg) { FNSetParallel(fn,pmode); }

909:     if (fn->ops->setfromoptions) {
910:       (*fn->ops->setfromoptions)(PetscOptionsObject,fn);
911:     }
912:     PetscObjectProcessOptionsHandlers(PetscOptionsObject,(PetscObject)fn);
913:   PetscOptionsEnd();
914:   return(0);
915: }

917: /*@C
918:    FNView - Prints the FN data structure.

920:    Collective on fn

922:    Input Parameters:
923: +  fn - the math function context
924: -  viewer - optional visualization context

926:    Note:
927:    The available visualization contexts include
928: +     PETSC_VIEWER_STDOUT_SELF - standard output (default)
929: -     PETSC_VIEWER_STDOUT_WORLD - synchronized standard
930:          output where only the first processor opens
931:          the file.  All other processors send their
932:          data to the first processor to print.

934:    The user can open an alternative visualization context with
935:    PetscViewerASCIIOpen() - output to a specified file.

937:    Level: beginner
938: @*/
939: PetscErrorCode FNView(FN fn,PetscViewer viewer)
940: {
941:   PetscBool      isascii;
943:   PetscMPIInt    size;

947:   if (!viewer) {
948:     PetscViewerASCIIGetStdout(PetscObjectComm((PetscObject)fn),&viewer);
949:   }
952:   PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&isascii);
953:   if (isascii) {
954:     PetscObjectPrintClassNamePrefixType((PetscObject)fn,viewer);
955:     MPI_Comm_size(PetscObjectComm((PetscObject)fn),&size);
956:     if (size>1) {
957:       PetscViewerASCIIPrintf(viewer,"  parallel operation mode: %s\n",FNParallelTypes[fn->pmode]);
958:     }
959:     if (fn->ops->view) {
960:       PetscViewerASCIIPushTab(viewer);
961:       (*fn->ops->view)(fn,viewer);
962:       PetscViewerASCIIPopTab(viewer);
963:     }
964:   }
965:   return(0);
966: }

968: /*@C
969:    FNViewFromOptions - View from options

971:    Collective on FN

973:    Input Parameters:
974: +  fn   - the math function context
975: .  obj  - optional object
976: -  name - command line option

978:    Level: intermediate

980: .seealso: FNView(), FNCreate()
981: @*/
982: PetscErrorCode FNViewFromOptions(FN fn,PetscObject obj,const char name[])
983: {

988:   PetscObjectViewFromOptions((PetscObject)fn,obj,name);
989:   return(0);
990: }

992: /*@
993:    FNDuplicate - Duplicates a math function, copying all parameters, possibly with a
994:    different communicator.

996:    Collective on fn

998:    Input Parameters:
999: +  fn   - the math function context
1000: -  comm - MPI communicator

1002:    Output Parameter:
1003: .  newfn - location to put the new FN context

1005:    Note:
1006:    In order to use the same MPI communicator as in the original object,
1007:    use PetscObjectComm((PetscObject)fn).

1009:    Level: developer

1011: .seealso: FNCreate()
1012: @*/
1013: PetscErrorCode FNDuplicate(FN fn,MPI_Comm comm,FN *newfn)
1014: {
1016:   FNType         type;
1017:   PetscScalar    alpha,beta;
1018:   PetscInt       meth;
1019:   FNParallelType ptype;

1025:   FNCreate(comm,newfn);
1026:   FNGetType(fn,&type);
1027:   FNSetType(*newfn,type);
1028:   FNGetScale(fn,&alpha,&beta);
1029:   FNSetScale(*newfn,alpha,beta);
1030:   FNGetMethod(fn,&meth);
1031:   FNSetMethod(*newfn,meth);
1032:   FNGetParallel(fn,&ptype);
1033:   FNSetParallel(*newfn,ptype);
1034:   if (fn->ops->duplicate) {
1035:     (*fn->ops->duplicate)(fn,comm,newfn);
1036:   }
1037:   return(0);
1038: }

1040: /*@
1041:    FNDestroy - Destroys FN context that was created with FNCreate().

1043:    Collective on fn

1045:    Input Parameter:
1046: .  fn - the math function context

1048:    Level: beginner

1050: .seealso: FNCreate()
1051: @*/
1052: PetscErrorCode FNDestroy(FN *fn)
1053: {
1055:   PetscInt       i;

1058:   if (!*fn) return(0);
1060:   if (--((PetscObject)(*fn))->refct > 0) { *fn = 0; return(0); }
1061:   if ((*fn)->ops->destroy) { (*(*fn)->ops->destroy)(*fn); }
1062:   for (i=0;i<(*fn)->nw;i++) {
1063:     MatDestroy(&(*fn)->W[i]);
1064:   }
1065:   PetscHeaderDestroy(fn);
1066:   return(0);
1067: }

1069: /*@C
1070:    FNRegister - Adds a mathematical function to the FN package.

1072:    Not collective

1074:    Input Parameters:
1075: +  name - name of a new user-defined FN
1076: -  function - routine to create context

1078:    Notes:
1079:    FNRegister() may be called multiple times to add several user-defined functions.

1081:    Level: advanced

1083: .seealso: FNRegisterAll()
1084: @*/
1085: PetscErrorCode FNRegister(const char *name,PetscErrorCode (*function)(FN))
1086: {

1090:   FNInitializePackage();
1091:   PetscFunctionListAdd(&FNList,name,function);
1092:   return(0);
1093: }