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> /*I "slepcfn.h" I*/
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,256,&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 FN973: 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 FN1076: - 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: }