1: /*
2: - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
3: SLEPc - Scalable Library for Eigenvalue Problem Computations
4: Copyright (c) 2002-2021, 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,const 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,adummy,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,&adummy,&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,&adummy,&ld,&dummy,&a,&lwork,&info));
554: PetscBLASIntCast((PetscInt)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: {
591: PetscErrorCode ierr;
592: PetscInt m;
593: const PetscScalar *As;
594: PetscScalar *Bs;
597: MatDenseGetArrayRead(A,&As);
598: MatDenseGetArray(B,&Bs);
599: MatGetSize(A,&m,NULL);
600: FNEvaluateFunctionMat_Sym_Private(fn,As,Bs,m,PETSC_FALSE);
601: MatDenseRestoreArrayRead(A,&As);
602: MatDenseRestoreArray(B,&Bs);
603: return(0);
604: }
606: PetscErrorCode FNEvaluateFunctionMat_Private(FN fn,Mat A,Mat B,PetscBool sync)607: {
609: PetscBool set,flg,symm=PETSC_FALSE;
610: PetscInt m,n;
611: PetscMPIInt size,rank;
612: PetscScalar *pF;
613: Mat M,F;
616: /* destination matrix */
617: F = B?B:A;
619: /* check symmetry of A */
620: MatIsHermitianKnown(A,&set,&flg);
621: symm = set? flg: PETSC_FALSE;
623: MPI_Comm_size(PetscObjectComm((PetscObject)fn),&size);CHKERRMPI(ierr);
624: MPI_Comm_rank(PetscObjectComm((PetscObject)fn),&rank);CHKERRMPI(ierr);
625: if (size==1 || fn->pmode==FN_PARALLEL_REDUNDANT || (fn->pmode==FN_PARALLEL_SYNCHRONIZED && !rank)) {
627: PetscFPTrapPush(PETSC_FP_TRAP_OFF);
628: if (symm && !fn->method) { /* prefer diagonalization */
629: PetscInfo(fn,"Computing matrix function via diagonalization\n");
630: FNEvaluateFunctionMat_Sym_Default(fn,A,F);
631: } else {
632: /* scale argument */
633: if (fn->alpha!=(PetscScalar)1.0) {
634: FN_AllocateWorkMat(fn,A,&M);
635: MatScale(M,fn->alpha);
636: } else M = A;
637: if (fn->ops->evaluatefunctionmat[fn->method]) {
638: (*fn->ops->evaluatefunctionmat[fn->method])(fn,M,F);
639: } else if (!fn->method) SETERRQ(PetscObjectComm((PetscObject)fn),PETSC_ERR_SUP,"Matrix functions not implemented in this FN type");
640: else SETERRQ(PetscObjectComm((PetscObject)fn),PETSC_ERR_ARG_OUTOFRANGE,"The specified method number does not exist for this FN type");
641: if (fn->alpha!=(PetscScalar)1.0) {
642: FN_FreeWorkMat(fn,&M);
643: }
644: /* scale result */
645: MatScale(F,fn->beta);
646: }
647: PetscFPTrapPop();
648: }
649: if (size>1 && fn->pmode==FN_PARALLEL_SYNCHRONIZED && sync) { /* synchronize */
650: MatGetSize(A,&m,&n);
651: MatDenseGetArray(F,&pF);
652: MPI_Bcast(pF,n*n,MPIU_SCALAR,0,PetscObjectComm((PetscObject)fn));CHKERRMPI(ierr);
653: MatDenseRestoreArray(F,&pF);
654: }
655: return(0);
656: }
658: /*@
659: FNEvaluateFunctionMat - Computes the value of the function f(A) for a given
660: matrix A, where the result is also a matrix.
662: Logically Collective on fn
664: Input Parameters:
665: + fn - the math function context
666: - A - matrix on which the function must be evaluated
668: Output Parameter:
669: . B - (optional) matrix resulting from evaluating f(A)
671: Notes:
672: Matrix A must be a square sequential dense Mat, with all entries equal on
673: all processes (otherwise each process will compute different results).
674: If matrix B is provided, it must also be a square sequential dense Mat, and
675: both matrices must have the same dimensions. If B is NULL (or B=A) then the
676: function will perform an in-place computation, overwriting A with f(A).
678: If A is known to be real symmetric or complex Hermitian then it is
679: recommended to set the appropriate flag with MatSetOption(), because
680: symmetry can sometimes be exploited by the algorithm.
682: Scaling factors are taken into account, so the actual function evaluation
683: will return beta*f(alpha*A).
685: Level: advanced
687: .seealso: FNEvaluateFunction(), FNEvaluateFunctionMatVec(), FNSetMethod()
688: @*/
689: PetscErrorCode FNEvaluateFunctionMat(FN fn,Mat A,Mat B)690: {
692: PetscBool inplace=PETSC_FALSE;
693: PetscInt m,n,n1;
700: if (B) {
703: } else inplace = PETSC_TRUE;
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) {
709: n1 = n;
710: MatGetSize(B,&m,&n);
711: if (m!=n) SETERRQ2(PetscObjectComm((PetscObject)fn),PETSC_ERR_ARG_SIZ,"Mat B is not square (has %D rows, %D cols)",m,n);
712: if (n1!=n) SETERRQ(PetscObjectComm((PetscObject)fn),PETSC_ERR_ARG_SIZ,"Matrices A and B must have the same dimension");
713: }
715: /* evaluate matrix function */
716: PetscLogEventBegin(FN_Evaluate,fn,0,0,0);
717: FNEvaluateFunctionMat_Private(fn,A,B,PETSC_TRUE);
718: PetscLogEventEnd(FN_Evaluate,fn,0,0,0);
719: return(0);
720: }
722: /*
723: FNEvaluateFunctionMatVec_Default - computes the full matrix f(A)
724: and then copies the first column.
725: */
726: static PetscErrorCode FNEvaluateFunctionMatVec_Default(FN fn,Mat A,Vec v)727: {
729: Mat F;
732: FN_AllocateWorkMat(fn,A,&F);
733: if (fn->ops->evaluatefunctionmat[fn->method]) {
734: (*fn->ops->evaluatefunctionmat[fn->method])(fn,A,F);
735: } else if (!fn->method) SETERRQ(PetscObjectComm((PetscObject)fn),PETSC_ERR_SUP,"Matrix functions not implemented in this FN type");
736: else SETERRQ(PetscObjectComm((PetscObject)fn),PETSC_ERR_ARG_OUTOFRANGE,"The specified method number does not exist for this FN type");
737: MatGetColumnVector(F,v,0);
738: FN_FreeWorkMat(fn,&F);
739: return(0);
740: }
742: /*
743: FNEvaluateFunctionMatVec_Sym_Default - given a symmetric matrix A,
744: compute the matrix function as f(A)=Q*f(D)*Q' where the spectral
745: decomposition of A is A=Q*D*Q'. Only the first column is computed.
746: */
747: static PetscErrorCode FNEvaluateFunctionMatVec_Sym_Default(FN fn,Mat A,Vec v)748: {
749: PetscErrorCode ierr;
750: PetscInt m;
751: const PetscScalar *As;
752: PetscScalar *vs;
755: MatDenseGetArrayRead(A,&As);
756: VecGetArray(v,&vs);
757: MatGetSize(A,&m,NULL);
758: FNEvaluateFunctionMat_Sym_Private(fn,As,vs,m,PETSC_TRUE);
759: MatDenseRestoreArrayRead(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);CHKERRMPI(ierr);
780: MPI_Comm_rank(PetscObjectComm((PetscObject)fn),&rank);CHKERRMPI(ierr);
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));CHKERRMPI(ierr);
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: PetscInt m,n;
850: MatGetSize(A,&m,&n);
851: if (m!=n) SETERRQ2(PetscObjectComm((PetscObject)fn),PETSC_ERR_ARG_SIZ,"Mat A is not square (has %D rows, %D cols)",m,n);
852: VecGetSize(v,&m);
853: if (m!=n) SETERRQ(PetscObjectComm((PetscObject)fn),PETSC_ERR_ARG_SIZ,"Matrix A and vector v must have the same size");
854: PetscLogEventBegin(FN_Evaluate,fn,0,0,0);
855: FNEvaluateFunctionMatVec_Private(fn,A,v,PETSC_TRUE);
856: PetscLogEventEnd(FN_Evaluate,fn,0,0,0);
857: return(0);
858: }
860: /*@
861: FNSetFromOptions - Sets FN options from the options database.
863: Collective on fn
865: Input Parameters:
866: . fn - the math function context
868: Notes:
869: To see all options, run your program with the -help option.
871: Level: beginner
872: @*/
873: PetscErrorCode FNSetFromOptions(FN fn)874: {
876: char type[256];
877: PetscScalar array[2];
878: PetscInt k,meth;
879: PetscBool flg;
880: FNParallelType pmode;
884: FNRegisterAll();
885: PetscObjectOptionsBegin((PetscObject)fn);
886: PetscOptionsFList("-fn_type","Math function type","FNSetType",FNList,(char*)(((PetscObject)fn)->type_name?((PetscObject)fn)->type_name:FNRATIONAL),type,sizeof(type),&flg);
887: if (flg) {
888: FNSetType(fn,type);
889: } else if (!((PetscObject)fn)->type_name) {
890: FNSetType(fn,FNRATIONAL);
891: }
893: k = 2;
894: array[0] = 0.0; array[1] = 0.0;
895: PetscOptionsScalarArray("-fn_scale","Scale factors (one or two scalar values separated with a comma without spaces)","FNSetScale",array,&k,&flg);
896: if (flg) {
897: if (k<2) array[1] = 1.0;
898: FNSetScale(fn,array[0],array[1]);
899: }
901: PetscOptionsInt("-fn_method","Method to be used for computing matrix functions","FNSetMethod",fn->method,&meth,&flg);
902: if (flg) { FNSetMethod(fn,meth); }
904: PetscOptionsEnum("-fn_parallel","Operation mode in parallel runs","FNSetParallel",FNParallelTypes,(PetscEnum)fn->pmode,(PetscEnum*)&pmode,&flg);
905: if (flg) { FNSetParallel(fn,pmode); }
907: if (fn->ops->setfromoptions) {
908: (*fn->ops->setfromoptions)(PetscOptionsObject,fn);
909: }
910: PetscObjectProcessOptionsHandlers(PetscOptionsObject,(PetscObject)fn);
911: PetscOptionsEnd();
912: return(0);
913: }
915: /*@C
916: FNView - Prints the FN data structure.
918: Collective on fn
920: Input Parameters:
921: + fn - the math function context
922: - viewer - optional visualization context
924: Note:
925: The available visualization contexts include
926: + PETSC_VIEWER_STDOUT_SELF - standard output (default)
927: - PETSC_VIEWER_STDOUT_WORLD - synchronized standard
928: output where only the first processor opens
929: the file. All other processors send their
930: data to the first processor to print.
932: The user can open an alternative visualization context with
933: PetscViewerASCIIOpen() - output to a specified file.
935: Level: beginner
936: @*/
937: PetscErrorCode FNView(FN fn,PetscViewer viewer)938: {
939: PetscBool isascii;
941: PetscMPIInt size;
945: if (!viewer) {
946: PetscViewerASCIIGetStdout(PetscObjectComm((PetscObject)fn),&viewer);
947: }
950: PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&isascii);
951: if (isascii) {
952: PetscObjectPrintClassNamePrefixType((PetscObject)fn,viewer);
953: MPI_Comm_size(PetscObjectComm((PetscObject)fn),&size);CHKERRMPI(ierr);
954: if (size>1) {
955: PetscViewerASCIIPrintf(viewer," parallel operation mode: %s\n",FNParallelTypes[fn->pmode]);
956: }
957: if (fn->ops->view) {
958: PetscViewerASCIIPushTab(viewer);
959: (*fn->ops->view)(fn,viewer);
960: PetscViewerASCIIPopTab(viewer);
961: }
962: }
963: return(0);
964: }
966: /*@C
967: FNViewFromOptions - View from options
969: Collective on FN971: Input Parameters:
972: + fn - the math function context
973: . obj - optional object
974: - name - command line option
976: Level: intermediate
978: .seealso: FNView(), FNCreate()
979: @*/
980: PetscErrorCode FNViewFromOptions(FN fn,PetscObject obj,const char name[])981: {
986: PetscObjectViewFromOptions((PetscObject)fn,obj,name);
987: return(0);
988: }
990: /*@
991: FNDuplicate - Duplicates a math function, copying all parameters, possibly with a
992: different communicator.
994: Collective on fn
996: Input Parameters:
997: + fn - the math function context
998: - comm - MPI communicator
1000: Output Parameter:
1001: . newfn - location to put the new FN context
1003: Note:
1004: In order to use the same MPI communicator as in the original object,
1005: use PetscObjectComm((PetscObject)fn).
1007: Level: developer
1009: .seealso: FNCreate()
1010: @*/
1011: PetscErrorCode FNDuplicate(FN fn,MPI_Comm comm,FN *newfn)1012: {
1014: FNType type;
1015: PetscScalar alpha,beta;
1016: PetscInt meth;
1017: FNParallelType ptype;
1023: FNCreate(comm,newfn);
1024: FNGetType(fn,&type);
1025: FNSetType(*newfn,type);
1026: FNGetScale(fn,&alpha,&beta);
1027: FNSetScale(*newfn,alpha,beta);
1028: FNGetMethod(fn,&meth);
1029: FNSetMethod(*newfn,meth);
1030: FNGetParallel(fn,&ptype);
1031: FNSetParallel(*newfn,ptype);
1032: if (fn->ops->duplicate) {
1033: (*fn->ops->duplicate)(fn,comm,newfn);
1034: }
1035: return(0);
1036: }
1038: /*@C
1039: FNDestroy - Destroys FN context that was created with FNCreate().
1041: Collective on fn
1043: Input Parameter:
1044: . fn - the math function context
1046: Level: beginner
1048: .seealso: FNCreate()
1049: @*/
1050: PetscErrorCode FNDestroy(FN *fn)1051: {
1053: PetscInt i;
1056: if (!*fn) return(0);
1058: if (--((PetscObject)(*fn))->refct > 0) { *fn = 0; return(0); }
1059: if ((*fn)->ops->destroy) { (*(*fn)->ops->destroy)(*fn); }
1060: for (i=0;i<(*fn)->nw;i++) {
1061: MatDestroy(&(*fn)->W[i]);
1062: }
1063: PetscHeaderDestroy(fn);
1064: return(0);
1065: }
1067: /*@C
1068: FNRegister - Adds a mathematical function to the FN package.
1070: Not collective
1072: Input Parameters:
1073: + name - name of a new user-defined FN1074: - function - routine to create context
1076: Notes:
1077: FNRegister() may be called multiple times to add several user-defined functions.
1079: Level: advanced
1081: .seealso: FNRegisterAll()
1082: @*/
1083: PetscErrorCode FNRegister(const char *name,PetscErrorCode (*function)(FN))1084: {
1088: FNInitializePackage();
1089: PetscFunctionListAdd(&FNList,name,function);
1090: return(0);
1091: }