1: /*
2: - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
3: SLEPc - Scalable Library for Eigenvalue Problem Computations
4: Copyright (c) 2002-2017, 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: char *className;
57: PetscBool opt;
58: PetscErrorCode ierr;
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 exclusions */
70: PetscOptionsGetString(NULL,NULL,"-info_exclude",logList,256,&opt);
71: if (opt) {
72: PetscStrstr(logList,"fn",&className);
73: if (className) {
74: PetscInfoDeactivateClass(FN_CLASSID);
75: }
76: }
77: /* Process summary exclusions */
78: PetscOptionsGetString(NULL,NULL,"-log_exclude",logList,256,&opt);
79: if (opt) {
80: PetscStrstr(logList,"fn",&className);
81: if (className) {
82: PetscLogEventDeactivateClass(FN_CLASSID);
83: }
84: }
85: PetscRegisterFinalize(FNFinalizePackage);
86: return(0);
87: }
89: /*@
90: FNCreate - Creates an FN context.
92: Collective on MPI_Comm
94: Input Parameter:
95: . comm - MPI communicator
97: Output Parameter:
98: . newfn - location to put the FN context
100: Level: beginner
102: .seealso: FNDestroy(), FN103: @*/
104: PetscErrorCode FNCreate(MPI_Comm comm,FN *newfn)105: {
106: FN fn;
111: *newfn = 0;
112: FNInitializePackage();
113: SlepcHeaderCreate(fn,FN_CLASSID,"FN","Math Function","FN",comm,FNDestroy,FNView);
115: fn->alpha = 1.0;
116: fn->beta = 1.0;
117: fn->method = 0;
119: fn->nw = 0;
120: fn->cw = 0;
121: fn->data = NULL;
123: *newfn = fn;
124: return(0);
125: }
127: /*@C
128: FNSetOptionsPrefix - Sets the prefix used for searching for all
129: FN options in the database.
131: Logically Collective on FN133: Input Parameters:
134: + fn - the math function context
135: - prefix - the prefix string to prepend to all FN option requests
137: Notes:
138: A hyphen (-) must NOT be given at the beginning of the prefix name.
139: The first character of all runtime options is AUTOMATICALLY the
140: hyphen.
142: Level: advanced
144: .seealso: FNAppendOptionsPrefix()
145: @*/
146: PetscErrorCode FNSetOptionsPrefix(FN fn,const char *prefix)147: {
152: PetscObjectSetOptionsPrefix((PetscObject)fn,prefix);
153: return(0);
154: }
156: /*@C
157: FNAppendOptionsPrefix - Appends to the prefix used for searching for all
158: FN options in the database.
160: Logically Collective on FN162: Input Parameters:
163: + fn - the math function context
164: - prefix - the prefix string to prepend to all FN option requests
166: Notes:
167: A hyphen (-) must NOT be given at the beginning of the prefix name.
168: The first character of all runtime options is AUTOMATICALLY the hyphen.
170: Level: advanced
172: .seealso: FNSetOptionsPrefix()
173: @*/
174: PetscErrorCode FNAppendOptionsPrefix(FN fn,const char *prefix)175: {
180: PetscObjectAppendOptionsPrefix((PetscObject)fn,prefix);
181: return(0);
182: }
184: /*@C
185: FNGetOptionsPrefix - Gets the prefix used for searching for all
186: FN options in the database.
188: Not Collective
190: Input Parameters:
191: . fn - the math function context
193: Output Parameters:
194: . prefix - pointer to the prefix string used is returned
196: Note:
197: On the Fortran side, the user should pass in a string 'prefix' of
198: sufficient length to hold the prefix.
200: Level: advanced
202: .seealso: FNSetOptionsPrefix(), FNAppendOptionsPrefix()
203: @*/
204: PetscErrorCode FNGetOptionsPrefix(FN fn,const char *prefix[])205: {
211: PetscObjectGetOptionsPrefix((PetscObject)fn,prefix);
212: return(0);
213: }
215: /*@C
216: FNSetType - Selects the type for the FN object.
218: Logically Collective on FN220: Input Parameter:
221: + fn - the math function context
222: - type - a known type
224: Notes:
225: The default is FNRATIONAL, which includes polynomials as a particular
226: case as well as simple functions such as f(x)=x and f(x)=constant.
228: Level: intermediate
230: .seealso: FNGetType()
231: @*/
232: PetscErrorCode FNSetType(FN fn,FNType type)233: {
234: PetscErrorCode ierr,(*r)(FN);
235: PetscBool match;
241: PetscObjectTypeCompare((PetscObject)fn,type,&match);
242: if (match) return(0);
244: PetscFunctionListFind(FNList,type,&r);
245: if (!r) SETERRQ1(PetscObjectComm((PetscObject)fn),PETSC_ERR_ARG_UNKNOWN_TYPE,"Unable to find requested FN type %s",type);
247: if (fn->ops->destroy) { (*fn->ops->destroy)(fn); }
248: PetscMemzero(fn->ops,sizeof(struct _FNOps));
250: PetscObjectChangeTypeName((PetscObject)fn,type);
251: (*r)(fn);
252: return(0);
253: }
255: /*@C
256: FNGetType - Gets the FN type name (as a string) from the FN context.
258: Not Collective
260: Input Parameter:
261: . fn - the math function context
263: Output Parameter:
264: . name - name of the math function
266: Level: intermediate
268: .seealso: FNSetType()
269: @*/
270: PetscErrorCode FNGetType(FN fn,FNType *type)271: {
275: *type = ((PetscObject)fn)->type_name;
276: return(0);
277: }
279: /*@
280: FNSetScale - Sets the scaling parameters that define the matematical function.
282: Logically Collective on FN284: Input Parameters:
285: + fn - the math function context
286: . alpha - inner scaling (argument)
287: - beta - outer scaling (result)
289: Notes:
290: Given a function f(x) specified by the FN type, the scaling parameters can
291: be used to realize the function beta*f(alpha*x). So when these values are given,
292: the procedure for function evaluation will first multiply the argument by alpha,
293: then evaluate the function itself, and finally scale the result by beta.
294: Likewise, these values are also considered when evaluating the derivative.
296: If you want to provide only one of the two scaling factors, set the other
297: one to 1.0.
299: Level: intermediate
301: .seealso: FNGetScale(), FNEvaluateFunction()
302: @*/
303: PetscErrorCode FNSetScale(FN fn,PetscScalar alpha,PetscScalar beta)304: {
309: fn->alpha = alpha;
310: fn->beta = beta;
311: return(0);
312: }
314: /*@
315: FNGetScale - Gets the scaling parameters that define the matematical function.
317: Not Collective
319: Input Parameter:
320: . fn - the math function context
322: Output Parameters:
323: + alpha - inner scaling (argument)
324: - beta - outer scaling (result)
326: Level: intermediate
328: .seealso: FNSetScale()
329: @*/
330: PetscErrorCode FNGetScale(FN fn,PetscScalar *alpha,PetscScalar *beta)331: {
334: if (alpha) *alpha = fn->alpha;
335: if (beta) *beta = fn->beta;
336: return(0);
337: }
339: /*@
340: FNSetMethod - Selects the method to be used to evaluate functions of matrices.
342: Logically Collective on FN344: Input Parameter:
345: + fn - the math function context
346: - meth - an index indentifying the method
348: Options Database Key:
349: . -fn_method <meth> - Sets the method
351: Notes:
352: In some FN types there are more than one algorithms available for computing
353: matrix functions. In that case, this function allows choosing the wanted method.
355: If meth is currently set to 0 (the default) and the input argument A of
356: FNEvaluateFunctionMat() is a symmetric/Hermitian matrix, then the computation
357: is done via the eigendecomposition of A, rather than with the general algorithm.
359: Level: intermediate
361: .seealso: FNGetMethod(), FNEvaluateFunctionMat()
362: @*/
363: PetscErrorCode FNSetMethod(FN fn,PetscInt meth)364: {
368: if (meth<0) SETERRQ(PetscObjectComm((PetscObject)fn),PETSC_ERR_ARG_OUTOFRANGE,"The method must be a non-negative integer");
369: if (meth>FN_MAX_SOLVE) SETERRQ(PetscObjectComm((PetscObject)fn),PETSC_ERR_ARG_OUTOFRANGE,"Too large value for the method");
370: fn->method = meth;
371: return(0);
372: }
374: /*@
375: FNGetMethod - Gets the method currently used in the FN.
377: Not Collective
379: Input Parameter:
380: . fn - the math function context
382: Output Parameter:
383: . meth - identifier of the method
385: Level: intermediate
387: .seealso: FNSetMethod()
388: @*/
389: PetscErrorCode FNGetMethod(FN fn,PetscInt *meth)390: {
394: *meth = fn->method;
395: return(0);
396: }
398: /*@
399: FNSetParallel - Selects the mode of operation in parallel runs.
401: Logically Collective on FN403: Input Parameter:
404: + fn - the math function context
405: - pmode - the parallel mode
407: Options Database Key:
408: . -fn_parallel <mode> - Sets the parallel mode, either 'redundant' or 'synchronized'
410: Notes:
411: This is relevant only when the function is evaluated on a matrix, with
412: either FNEvaluateFunctionMat() or FNEvaluateFunctionMatVec().
414: In the 'redundant' parallel mode, all processes will make the computation
415: redundantly, starting from the same data, and producing the same result.
416: This result may be slightly different in the different processes if using a
417: multithreaded BLAS library, which may cause issues in ill-conditioned problems.
419: In the 'synchronized' parallel mode, only the first MPI process performs the
420: computation and then the computed matrix is broadcast to the other
421: processes in the communicator. This communication is done automatically at
422: the end of FNEvaluateFunctionMat() or FNEvaluateFunctionMatVec().
424: Level: advanced
426: .seealso: FNEvaluateFunctionMat() or FNEvaluateFunctionMatVec(), FNGetParallel()
427: @*/
428: PetscErrorCode FNSetParallel(FN fn,FNParallelType pmode)429: {
433: fn->pmode = pmode;
434: return(0);
435: }
437: /*@
438: FNGetParallel - Gets the mode of operation in parallel runs.
440: Not Collective
442: Input Parameter:
443: . fn - the math function context
445: Output Parameter:
446: . pmode - the parallel mode
448: Level: advanced
450: .seealso: FNSetParallel()
451: @*/
452: PetscErrorCode FNGetParallel(FN fn,FNParallelType *pmode)453: {
457: *pmode = fn->pmode;
458: return(0);
459: }
461: /*@
462: FNEvaluateFunction - Computes the value of the function f(x) for a given x.
464: Not collective
466: Input Parameters:
467: + fn - the math function context
468: - x - the value where the function must be evaluated
470: Output Parameter:
471: . y - the result of f(x)
473: Note:
474: Scaling factors are taken into account, so the actual function evaluation
475: will return beta*f(alpha*x).
477: Level: intermediate
479: .seealso: FNEvaluateDerivative(), FNEvaluateFunctionMat(), FNSetScale()
480: @*/
481: PetscErrorCode FNEvaluateFunction(FN fn,PetscScalar x,PetscScalar *y)482: {
484: PetscScalar xf,yf;
490: PetscLogEventBegin(FN_Evaluate,fn,0,0,0);
491: xf = fn->alpha*x;
492: (*fn->ops->evaluatefunction)(fn,xf,&yf);
493: *y = fn->beta*yf;
494: PetscLogEventEnd(FN_Evaluate,fn,0,0,0);
495: return(0);
496: }
498: /*@
499: FNEvaluateDerivative - Computes the value of the derivative f'(x) for a given x.
501: Not Collective
503: Input Parameters:
504: + fn - the math function context
505: - x - the value where the derivative must be evaluated
507: Output Parameter:
508: . y - the result of f'(x)
510: Note:
511: Scaling factors are taken into account, so the actual derivative evaluation will
512: return alpha*beta*f'(alpha*x).
514: Level: intermediate
516: .seealso: FNEvaluateFunction()
517: @*/
518: PetscErrorCode FNEvaluateDerivative(FN fn,PetscScalar x,PetscScalar *y)519: {
521: PetscScalar xf,yf;
527: PetscLogEventBegin(FN_Evaluate,fn,0,0,0);
528: xf = fn->alpha*x;
529: (*fn->ops->evaluatederivative)(fn,xf,&yf);
530: *y = fn->alpha*fn->beta*yf;
531: PetscLogEventEnd(FN_Evaluate,fn,0,0,0);
532: return(0);
533: }
535: static PetscErrorCode FNEvaluateFunctionMat_Sym_Private(FN fn,PetscScalar *As,PetscScalar *Bs,PetscInt m,PetscBool firstonly)536: {
537: #if defined(PETSC_MISSING_LAPACK_SYEV) || defined(SLEPC_MISSING_LAPACK_LACPY)
539: SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"SYEV/LACPY - Lapack routines are unavailable");
540: #else
542: PetscInt i,j;
543: PetscBLASInt n,k,ld,lwork,info;
544: PetscScalar *Q,*W,*work,a,x,y,one=1.0,zero=0.0;
545: PetscReal *eig,dummy;
546: #if defined(PETSC_USE_COMPLEX)
547: PetscReal *rwork,rdummy;
548: #endif
551: PetscBLASIntCast(m,&n);
552: ld = n;
553: k = firstonly? 1: n;
555: /* workspace query and memory allocation */
556: lwork = -1;
557: #if defined(PETSC_USE_COMPLEX)
558: PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","L",&n,As,&ld,&dummy,&a,&lwork,&rdummy,&info));
559: PetscBLASIntCast((PetscInt)PetscRealPart(a),&lwork);
560: PetscMalloc5(m,&eig,m*m,&Q,m*k,&W,lwork,&work,PetscMax(1,3*m-2),&rwork);
561: #else
562: PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","L",&n,As,&ld,&dummy,&a,&lwork,&info));
563: PetscBLASIntCast((PetscInt)PetscRealPart(a),&lwork);
564: PetscMalloc4(m,&eig,m*m,&Q,m*k,&W,lwork,&work);
565: #endif
567: /* compute eigendecomposition */
568: PetscStackCallBLAS("LAPACKlacpy",LAPACKlacpy_("L",&n,&n,As,&ld,Q,&ld));
569: #if defined(PETSC_USE_COMPLEX)
570: PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","L",&n,Q,&ld,eig,work,&lwork,rwork,&info));
571: #else
572: PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","L",&n,Q,&ld,eig,work,&lwork,&info));
573: #endif
574: SlepcCheckLapackInfo("syev",info);
576: /* W = f(Lambda)*Q' */
577: for (i=0;i<n;i++) {
578: x = eig[i];
579: (*fn->ops->evaluatefunction)(fn,x,&y); /* y = f(x) */
580: for (j=0;j<k;j++) W[i+j*ld] = Q[j+i*ld]*y;
581: }
582: /* Bs = Q*W */
583: PetscStackCallBLAS("BLASgemm",BLASgemm_("N","N",&n,&k,&n,&one,Q,&ld,W,&ld,&zero,Bs,&ld));
584: #if defined(PETSC_USE_COMPLEX)
585: PetscFree5(eig,Q,W,work,rwork);
586: #else
587: PetscFree4(eig,Q,W,work);
588: #endif
589: PetscLogFlops(9.0*n*n*n+2.0*n*n*n);
590: return(0);
591: #endif
592: }
594: /*
595: FNEvaluateFunctionMat_Sym_Default - given a symmetric matrix A,
596: compute the matrix function as f(A)=Q*f(D)*Q' where the spectral
597: decomposition of A is A=Q*D*Q'
598: */
599: static PetscErrorCode FNEvaluateFunctionMat_Sym_Default(FN fn,Mat A,Mat B)600: {
602: PetscInt m;
603: PetscScalar *As,*Bs;
606: MatDenseGetArray(A,&As);
607: MatDenseGetArray(B,&Bs);
608: MatGetSize(A,&m,NULL);
609: FNEvaluateFunctionMat_Sym_Private(fn,As,Bs,m,PETSC_FALSE);
610: MatDenseRestoreArray(A,&As);
611: MatDenseRestoreArray(B,&Bs);
612: return(0);
613: }
615: PetscErrorCode FNEvaluateFunctionMat_Private(FN fn,Mat A,Mat B,PetscBool sync)616: {
618: PetscBool set,flg,symm=PETSC_FALSE;
619: PetscInt m,n;
620: PetscMPIInt size,rank;
621: PetscScalar *pF;
622: Mat M,F;
625: /* destination matrix */
626: F = B?B:A;
628: /* check symmetry of A */
629: MatIsHermitianKnown(A,&set,&flg);
630: symm = set? flg: PETSC_FALSE;
632: MPI_Comm_size(PetscObjectComm((PetscObject)fn),&size);
633: MPI_Comm_rank(PetscObjectComm((PetscObject)fn),&rank);
634: if (size==1 || fn->pmode==FN_PARALLEL_REDUNDANT || (fn->pmode==FN_PARALLEL_SYNCHRONIZED && !rank)) {
635: /* scale argument */
636: if (fn->alpha!=(PetscScalar)1.0) {
637: FN_AllocateWorkMat(fn,A,&M);
638: MatScale(M,fn->alpha);
639: } else M = A;
640: 641: PetscFPTrapPush(PETSC_FP_TRAP_OFF);
642: if (symm && !fn->method) { /* prefer diagonalization */
643: FNEvaluateFunctionMat_Sym_Default(fn,M,F);
644: } else {
645: if (fn->ops->evaluatefunctionmat[fn->method]) {
646: (*fn->ops->evaluatefunctionmat[fn->method])(fn,M,F);
647: } else SETERRQ(PetscObjectComm((PetscObject)fn),PETSC_ERR_ARG_OUTOFRANGE,"The specified method number does not exist for this FN");
648: }
649: PetscFPTrapPop();
650: if (fn->alpha!=(PetscScalar)1.0) {
651: FN_FreeWorkMat(fn,&M);
652: }
653: /* scale result */
654: MatScale(F,fn->beta);
655: }
656: if (size>1 && fn->pmode==FN_PARALLEL_SYNCHRONIZED && sync) { /* synchronize */
657: MatGetSize(A,&m,&n);
658: MatDenseGetArray(F,&pF);
659: MPI_Bcast(pF,n*n,MPIU_SCALAR,0,PetscObjectComm((PetscObject)fn));
660: MatDenseRestoreArray(F,&pF);
661: }
662: return(0);
663: }
665: /*@
666: FNEvaluateFunctionMat - Computes the value of the function f(A) for a given
667: matrix A, where the result is also a matrix.
669: Logically Collective on FN671: Input Parameters:
672: + fn - the math function context
673: - A - matrix on which the function must be evaluated
675: Output Parameter:
676: . B - (optional) matrix resulting from evaluating f(A)
678: Notes:
679: Matrix A must be a square sequential dense Mat, with all entries equal on
680: all processes (otherwise each process will compute different results).
681: If matrix B is provided, it must also be a square sequential dense Mat, and
682: both matrices must have the same dimensions. If B is NULL (or B=A) then the
683: function will perform an in-place computation, overwriting A with f(A).
685: If A is known to be real symmetric or complex Hermitian then it is
686: recommended to set the appropriate flag with MatSetOption(), because
687: symmetry can sometimes be exploited by the algorithm.
689: Scaling factors are taken into account, so the actual function evaluation
690: will return beta*f(alpha*A).
692: Level: advanced
694: .seealso: FNEvaluateFunction(), FNEvaluateFunctionMatVec(), FNSetMethod()
695: @*/
696: PetscErrorCode FNEvaluateFunctionMat(FN fn,Mat A,Mat B)697: {
699: PetscBool match,inplace=PETSC_FALSE;
700: PetscInt m,n,n1;
707: if (B) {
710: } else inplace = PETSC_TRUE;
711: PetscObjectTypeCompare((PetscObject)A,MATSEQDENSE,&match);
712: if (!match) SETERRQ(PetscObjectComm((PetscObject)fn),PETSC_ERR_SUP,"Mat A must be of type seqdense");
713: MatGetSize(A,&m,&n);
714: if (m!=n) SETERRQ2(PetscObjectComm((PetscObject)fn),PETSC_ERR_ARG_SIZ,"Mat A is not square (has %D rows, %D cols)",m,n);
715: if (!inplace) {
716: PetscObjectTypeCompare((PetscObject)B,MATSEQDENSE,&match);
717: if (!match) SETERRQ(PetscObjectComm((PetscObject)fn),PETSC_ERR_SUP,"Mat B must be of type seqdense");
718: n1 = n;
719: MatGetSize(B,&m,&n);
720: if (m!=n) SETERRQ2(PetscObjectComm((PetscObject)fn),PETSC_ERR_ARG_SIZ,"Mat B is not square (has %D rows, %D cols)",m,n);
721: if (n1!=n) SETERRQ(PetscObjectComm((PetscObject)fn),PETSC_ERR_ARG_SIZ,"Matrices A and B must have the same dimension");
722: }
724: /* evaluate matrix function */
725: PetscLogEventBegin(FN_Evaluate,fn,0,0,0);
726: FNEvaluateFunctionMat_Private(fn,A,B,PETSC_TRUE);
727: PetscLogEventEnd(FN_Evaluate,fn,0,0,0);
728: return(0);
729: }
731: /*
732: FNEvaluateFunctionMatVec_Default - computes the full matrix f(A)
733: and then copies the first column.
734: */
735: static PetscErrorCode FNEvaluateFunctionMatVec_Default(FN fn,Mat A,Vec v)736: {
738: Mat F;
741: FN_AllocateWorkMat(fn,A,&F);
742: if (fn->ops->evaluatefunctionmat[fn->method]) {
743: (*fn->ops->evaluatefunctionmat[fn->method])(fn,A,F);
744: } else SETERRQ(PetscObjectComm((PetscObject)fn),PETSC_ERR_ARG_OUTOFRANGE,"The specified method number does not exist for this FN");
745: MatGetColumnVector(F,v,0);
746: FN_FreeWorkMat(fn,&F);
747: return(0);
748: }
750: /*
751: FNEvaluateFunctionMatVec_Sym_Default - given a symmetric matrix A,
752: compute the matrix function as f(A)=Q*f(D)*Q' where the spectral
753: decomposition of A is A=Q*D*Q'. Only the first column is computed.
754: */
755: static PetscErrorCode FNEvaluateFunctionMatVec_Sym_Default(FN fn,Mat A,Vec v)756: {
758: PetscInt m;
759: PetscScalar *As,*vs;
762: MatDenseGetArray(A,&As);
763: VecGetArray(v,&vs);
764: MatGetSize(A,&m,NULL);
765: FNEvaluateFunctionMat_Sym_Private(fn,As,vs,m,PETSC_TRUE);
766: MatDenseRestoreArray(A,&As);
767: VecRestoreArray(v,&vs);
768: return(0);
769: }
771: PetscErrorCode FNEvaluateFunctionMatVec_Private(FN fn,Mat A,Vec v,PetscBool sync)772: {
774: PetscBool set,flg,symm=PETSC_FALSE;
775: PetscInt m,n;
776: Mat M;
777: PetscMPIInt size,rank;
778: PetscScalar *pv;
781: /* check symmetry of A */
782: MatIsHermitianKnown(A,&set,&flg);
783: symm = set? flg: PETSC_FALSE;
785: /* evaluate matrix function */
786: MPI_Comm_size(PetscObjectComm((PetscObject)fn),&size);
787: MPI_Comm_rank(PetscObjectComm((PetscObject)fn),&rank);
788: if (size==1 || fn->pmode==FN_PARALLEL_REDUNDANT || (fn->pmode==FN_PARALLEL_SYNCHRONIZED && !rank)) {
789: /* scale argument */
790: if (fn->alpha!=(PetscScalar)1.0) {
791: FN_AllocateWorkMat(fn,A,&M);
792: MatScale(M,fn->alpha);
793: } else M = A;
794: PetscFPTrapPush(PETSC_FP_TRAP_OFF);
795: if (symm && !fn->method) { /* prefer diagonalization */
796: FNEvaluateFunctionMatVec_Sym_Default(fn,M,v);
797: } else {
798: if (fn->ops->evaluatefunctionmatvec[fn->method]) {
799: (*fn->ops->evaluatefunctionmatvec[fn->method])(fn,M,v);
800: } else {
801: FNEvaluateFunctionMatVec_Default(fn,M,v);
802: }
803: }
804: PetscFPTrapPop();
805: if (fn->alpha!=(PetscScalar)1.0) {
806: FN_FreeWorkMat(fn,&M);
807: }
809: /* scale result */
810: VecScale(v,fn->beta);
811: }
813: /* synchronize */
814: if (size>1 && fn->pmode==FN_PARALLEL_SYNCHRONIZED && sync) {
815: MatGetSize(A,&m,&n);
816: VecGetArray(v,&pv);
817: MPI_Bcast(pv,n,MPIU_SCALAR,0,PetscObjectComm((PetscObject)fn));
818: VecRestoreArray(v,&pv);
819: }
820: return(0);
821: }
823: /*@
824: FNEvaluateFunctionMatVec - Computes the first column of the matrix f(A)
825: for a given matrix A.
827: Logically Collective on FN829: Input Parameters:
830: + fn - the math function context
831: - A - matrix on which the function must be evaluated
833: Output Parameter:
834: . v - vector to hold the first column of f(A)
836: Notes:
837: This operation is similar to FNEvaluateFunctionMat() but returns only
838: the first column of f(A), hence saving computations in most cases.
840: Level: advanced
842: .seealso: FNEvaluateFunction(), FNEvaluateFunctionMat(), FNSetMethod()
843: @*/
844: PetscErrorCode FNEvaluateFunctionMatVec(FN fn,Mat A,Vec v)845: {
847: PetscBool match;
848: PetscInt m,n;
857: PetscObjectTypeCompare((PetscObject)A,MATSEQDENSE,&match);
858: if (!match) SETERRQ(PetscObjectComm((PetscObject)fn),PETSC_ERR_SUP,"Mat A must be of type seqdense");
859: MatGetSize(A,&m,&n);
860: if (m!=n) SETERRQ2(PetscObjectComm((PetscObject)fn),PETSC_ERR_ARG_SIZ,"Mat A is not square (has %D rows, %D cols)",m,n);
861: VecGetSize(v,&m);
862: if (m!=n) SETERRQ(PetscObjectComm((PetscObject)fn),PETSC_ERR_ARG_SIZ,"Matrix A and vector v must have the same size");
863: PetscLogEventBegin(FN_Evaluate,fn,0,0,0);
864: FNEvaluateFunctionMatVec_Private(fn,A,v,PETSC_TRUE);
865: PetscLogEventEnd(FN_Evaluate,fn,0,0,0);
866: return(0);
867: }
869: /*@
870: FNSetFromOptions - Sets FN options from the options database.
872: Collective on FN874: Input Parameters:
875: . fn - the math function context
877: Notes:
878: To see all options, run your program with the -help option.
880: Level: beginner
881: @*/
882: PetscErrorCode FNSetFromOptions(FN fn)883: {
885: char type[256];
886: PetscScalar array[2];
887: PetscInt k,meth;
888: PetscBool flg;
889: FNParallelType pmode;
893: FNRegisterAll();
894: PetscObjectOptionsBegin((PetscObject)fn);
895: PetscOptionsFList("-fn_type","Math function type","FNSetType",FNList,(char*)(((PetscObject)fn)->type_name?((PetscObject)fn)->type_name:FNRATIONAL),type,256,&flg);
896: if (flg) {
897: FNSetType(fn,type);
898: } else if (!((PetscObject)fn)->type_name) {
899: FNSetType(fn,FNRATIONAL);
900: }
902: k = 2;
903: array[0] = 0.0; array[1] = 0.0;
904: PetscOptionsScalarArray("-fn_scale","Scale factors (one or two scalar values separated with a comma without spaces)","FNSetScale",array,&k,&flg);
905: if (flg) {
906: if (k<2) array[1] = 1.0;
907: FNSetScale(fn,array[0],array[1]);
908: }
910: PetscOptionsInt("-fn_method","Method to be used for computing matrix functions","FNSetMethod",fn->method,&meth,&flg);
911: if (flg) { FNSetMethod(fn,meth); }
913: PetscOptionsEnum("-fn_parallel","Operation mode in parallel runs","FNSetParallel",FNParallelTypes,(PetscEnum)fn->pmode,(PetscEnum*)&pmode,&flg);
914: if (flg) { FNSetParallel(fn,pmode); }
916: if (fn->ops->setfromoptions) {
917: (*fn->ops->setfromoptions)(PetscOptionsObject,fn);
918: }
919: PetscObjectProcessOptionsHandlers(PetscOptionsObject,(PetscObject)fn);
920: PetscOptionsEnd();
921: return(0);
922: }
924: /*@C
925: FNView - Prints the FN data structure.
927: Collective on FN929: Input Parameters:
930: + fn - the math function context
931: - viewer - optional visualization context
933: Note:
934: The available visualization contexts include
935: + PETSC_VIEWER_STDOUT_SELF - standard output (default)
936: - PETSC_VIEWER_STDOUT_WORLD - synchronized standard
937: output where only the first processor opens
938: the file. All other processors send their
939: data to the first processor to print.
941: The user can open an alternative visualization context with
942: PetscViewerASCIIOpen() - output to a specified file.
944: Level: beginner
945: @*/
946: PetscErrorCode FNView(FN fn,PetscViewer viewer)947: {
948: PetscBool isascii;
950: PetscMPIInt size;
954: if (!viewer) viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)fn));
957: PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&isascii);
958: if (isascii) {
959: PetscObjectPrintClassNamePrefixType((PetscObject)fn,viewer);
960: MPI_Comm_size(PetscObjectComm((PetscObject)fn),&size);
961: if (size>1) {
962: PetscViewerASCIIPrintf(viewer," parallel operation mode: %s\n",FNParallelTypes[fn->pmode]);
963: }
964: if (fn->ops->view) {
965: PetscViewerASCIIPushTab(viewer);
966: (*fn->ops->view)(fn,viewer);
967: PetscViewerASCIIPopTab(viewer);
968: }
969: }
970: return(0);
971: }
973: /*@
974: FNDuplicate - Duplicates a math function, copying all parameters, possibly with a
975: different communicator.
977: Collective on FN979: Input Parameters:
980: + fn - the math function context
981: - comm - MPI communicator
983: Output Parameter:
984: . newfn - location to put the new FN context
986: Note:
987: In order to use the same MPI communicator as in the original object,
988: use PetscObjectComm((PetscObject)fn).
990: Level: developer
992: .seealso: FNCreate()
993: @*/
994: PetscErrorCode FNDuplicate(FN fn,MPI_Comm comm,FN *newfn)995: {
997: FNType type;
998: PetscScalar alpha,beta;
999: PetscInt meth;
1000: FNParallelType ptype;
1006: FNCreate(comm,newfn);
1007: FNGetType(fn,&type);
1008: FNSetType(*newfn,type);
1009: FNGetScale(fn,&alpha,&beta);
1010: FNSetScale(*newfn,alpha,beta);
1011: FNGetMethod(fn,&meth);
1012: FNSetMethod(*newfn,meth);
1013: FNGetParallel(fn,&ptype);
1014: FNSetParallel(*newfn,ptype);
1015: if (fn->ops->duplicate) {
1016: (*fn->ops->duplicate)(fn,comm,newfn);
1017: }
1018: return(0);
1019: }
1021: /*@
1022: FNDestroy - Destroys FN context that was created with FNCreate().
1024: Collective on FN1026: Input Parameter:
1027: . fn - the math function context
1029: Level: beginner
1031: .seealso: FNCreate()
1032: @*/
1033: PetscErrorCode FNDestroy(FN *fn)1034: {
1036: PetscInt i;
1039: if (!*fn) return(0);
1041: if (--((PetscObject)(*fn))->refct > 0) { *fn = 0; return(0); }
1042: if ((*fn)->ops->destroy) { (*(*fn)->ops->destroy)(*fn); }
1043: for (i=0;i<(*fn)->nw;i++) {
1044: MatDestroy(&(*fn)->W[i]);
1045: }
1046: PetscHeaderDestroy(fn);
1047: return(0);
1048: }
1050: /*@C
1051: FNRegister - Adds a mathematical function to the FN package.
1053: Not collective
1055: Input Parameters:
1056: + name - name of a new user-defined FN1057: - function - routine to create context
1059: Notes:
1060: FNRegister() may be called multiple times to add several user-defined functions.
1062: Level: advanced
1064: .seealso: FNRegisterAll()
1065: @*/
1066: PetscErrorCode FNRegister(const char *name,PetscErrorCode (*function)(FN))1067: {
1071: PetscFunctionListAdd(&FNList,name,function);
1072: return(0);
1073: }