Actual source code: fncombine.c
slepc-3.13.1 2020-04-12
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: A function that is obtained by combining two other functions (either by
12: addition, multiplication, division or composition)
14: addition: f(x) = f1(x)+f2(x)
15: multiplication: f(x) = f1(x)*f2(x)
16: division: f(x) = f1(x)/f2(x) f(A) = f2(A)\f1(A)
17: composition: f(x) = f2(f1(x))
18: */
20: #include <slepc/private/fnimpl.h> /*I "slepcfn.h" I*/
21: #include <slepcblaslapack.h>
23: typedef struct {
24: FN f1,f2; /* functions */
25: FNCombineType comb; /* how the functions are combined */
26: } FN_COMBINE;
28: PetscErrorCode FNEvaluateFunction_Combine(FN fn,PetscScalar x,PetscScalar *y)
29: {
31: FN_COMBINE *ctx = (FN_COMBINE*)fn->data;
32: PetscScalar a,b;
35: FNEvaluateFunction(ctx->f1,x,&a);
36: switch (ctx->comb) {
37: case FN_COMBINE_ADD:
38: FNEvaluateFunction(ctx->f2,x,&b);
39: *y = a+b;
40: break;
41: case FN_COMBINE_MULTIPLY:
42: FNEvaluateFunction(ctx->f2,x,&b);
43: *y = a*b;
44: break;
45: case FN_COMBINE_DIVIDE:
46: FNEvaluateFunction(ctx->f2,x,&b);
47: if (b==0.0) SETERRQ(PETSC_COMM_SELF,1,"Function not defined in the requested value");
48: *y = a/b;
49: break;
50: case FN_COMBINE_COMPOSE:
51: FNEvaluateFunction(ctx->f2,a,y);
52: break;
53: }
54: return(0);
55: }
57: PetscErrorCode FNEvaluateDerivative_Combine(FN fn,PetscScalar x,PetscScalar *yp)
58: {
60: FN_COMBINE *ctx = (FN_COMBINE*)fn->data;
61: PetscScalar a,b,ap,bp;
64: switch (ctx->comb) {
65: case FN_COMBINE_ADD:
66: FNEvaluateDerivative(ctx->f1,x,&ap);
67: FNEvaluateDerivative(ctx->f2,x,&bp);
68: *yp = ap+bp;
69: break;
70: case FN_COMBINE_MULTIPLY:
71: FNEvaluateDerivative(ctx->f1,x,&ap);
72: FNEvaluateDerivative(ctx->f2,x,&bp);
73: FNEvaluateFunction(ctx->f1,x,&a);
74: FNEvaluateFunction(ctx->f2,x,&b);
75: *yp = ap*b+a*bp;
76: break;
77: case FN_COMBINE_DIVIDE:
78: FNEvaluateDerivative(ctx->f1,x,&ap);
79: FNEvaluateDerivative(ctx->f2,x,&bp);
80: FNEvaluateFunction(ctx->f1,x,&a);
81: FNEvaluateFunction(ctx->f2,x,&b);
82: if (b==0.0) SETERRQ(PETSC_COMM_SELF,1,"Derivative not defined in the requested value");
83: *yp = (ap*b-a*bp)/(b*b);
84: break;
85: case FN_COMBINE_COMPOSE:
86: FNEvaluateFunction(ctx->f1,x,&a);
87: FNEvaluateDerivative(ctx->f1,x,&ap);
88: FNEvaluateDerivative(ctx->f2,a,yp);
89: *yp *= ap;
90: break;
91: }
92: return(0);
93: }
95: PetscErrorCode FNEvaluateFunctionMat_Combine(FN fn,Mat A,Mat B)
96: {
98: FN_COMBINE *ctx = (FN_COMBINE*)fn->data;
99: PetscScalar *Aa,*Ba,*Wa,*Za,one=1.0,zero=0.0;
100: PetscBLASInt n,ld,ld2,inc=1,*ipiv,info;
101: PetscInt m;
102: Mat W,Z;
105: FN_AllocateWorkMat(fn,A,&W);
106: MatDenseGetArray(A,&Aa);
107: MatDenseGetArray(B,&Ba);
108: MatDenseGetArray(W,&Wa);
109: MatGetSize(A,&m,NULL);
110: PetscBLASIntCast(m,&n);
111: ld = n;
112: ld2 = ld*ld;
114: switch (ctx->comb) {
115: case FN_COMBINE_ADD:
116: FNEvaluateFunctionMat_Private(ctx->f1,A,W,PETSC_FALSE);
117: FNEvaluateFunctionMat_Private(ctx->f2,A,B,PETSC_FALSE);
118: PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&ld2,&one,Wa,&inc,Ba,&inc));
119: PetscLogFlops(1.0*n*n);
120: break;
121: case FN_COMBINE_MULTIPLY:
122: FN_AllocateWorkMat(fn,A,&Z);
123: MatDenseGetArray(Z,&Za);
124: FNEvaluateFunctionMat_Private(ctx->f1,A,W,PETSC_FALSE);
125: FNEvaluateFunctionMat_Private(ctx->f2,A,Z,PETSC_FALSE);
126: PetscStackCallBLAS("BLASgemm",BLASgemm_("N","N",&n,&n,&n,&one,Wa,&ld,Za,&ld,&zero,Ba,&ld));
127: PetscLogFlops(2.0*n*n*n);
128: MatDenseRestoreArray(Z,&Za);
129: FN_FreeWorkMat(fn,&Z);
130: break;
131: case FN_COMBINE_DIVIDE:
132: FNEvaluateFunctionMat_Private(ctx->f2,A,W,PETSC_FALSE);
133: FNEvaluateFunctionMat_Private(ctx->f1,A,B,PETSC_FALSE);
134: PetscMalloc1(ld,&ipiv);
135: PetscStackCallBLAS("LAPACKgesv",LAPACKgesv_(&n,&n,Wa,&ld,ipiv,Ba,&ld,&info));
136: SlepcCheckLapackInfo("gesv",info);
137: PetscLogFlops(2.0*n*n*n/3.0+2.0*n*n*n);
138: PetscFree(ipiv);
139: break;
140: case FN_COMBINE_COMPOSE:
141: FNEvaluateFunctionMat_Private(ctx->f1,A,W,PETSC_FALSE);
142: FNEvaluateFunctionMat_Private(ctx->f2,W,B,PETSC_FALSE);
143: break;
144: }
146: MatDenseRestoreArray(A,&Aa);
147: MatDenseRestoreArray(B,&Ba);
148: MatDenseRestoreArray(W,&Wa);
149: FN_FreeWorkMat(fn,&W);
150: return(0);
151: }
153: PetscErrorCode FNEvaluateFunctionMatVec_Combine(FN fn,Mat A,Vec v)
154: {
156: FN_COMBINE *ctx = (FN_COMBINE*)fn->data;
157: PetscScalar *va,*Za;
158: PetscBLASInt n,ld,*ipiv,info,one=1;
159: PetscInt m;
160: Mat Z;
161: Vec w;
164: MatGetSize(A,&m,NULL);
165: PetscBLASIntCast(m,&n);
166: ld = n;
168: switch (ctx->comb) {
169: case FN_COMBINE_ADD:
170: VecDuplicate(v,&w);
171: FNEvaluateFunctionMatVec(ctx->f1,A,w);
172: FNEvaluateFunctionMatVec(ctx->f2,A,v);
173: VecAXPY(v,1.0,w);
174: VecDestroy(&w);
175: break;
176: case FN_COMBINE_MULTIPLY:
177: VecDuplicate(v,&w);
178: FN_AllocateWorkMat(fn,A,&Z);
179: FNEvaluateFunctionMat_Private(ctx->f1,A,Z,PETSC_FALSE);
180: FNEvaluateFunctionMatVec_Private(ctx->f2,A,w,PETSC_FALSE);
181: MatMult(Z,w,v);
182: FN_FreeWorkMat(fn,&Z);
183: VecDestroy(&w);
184: break;
185: case FN_COMBINE_DIVIDE:
186: VecDuplicate(v,&w);
187: FN_AllocateWorkMat(fn,A,&Z);
188: FNEvaluateFunctionMat_Private(ctx->f2,A,Z,PETSC_FALSE);
189: FNEvaluateFunctionMatVec_Private(ctx->f1,A,v,PETSC_FALSE);
190: PetscMalloc1(ld,&ipiv);
191: MatDenseGetArray(Z,&Za);
192: VecGetArray(v,&va);
193: PetscStackCallBLAS("LAPACKgesv",LAPACKgesv_(&n,&one,Za,&ld,ipiv,va,&ld,&info));
194: SlepcCheckLapackInfo("gesv",info);
195: PetscLogFlops(2.0*n*n*n/3.0+2.0*n*n);
196: VecRestoreArray(v,&va);
197: MatDenseRestoreArray(Z,&Za);
198: PetscFree(ipiv);
199: FN_FreeWorkMat(fn,&Z);
200: VecDestroy(&w);
201: break;
202: case FN_COMBINE_COMPOSE:
203: FN_AllocateWorkMat(fn,A,&Z);
204: FNEvaluateFunctionMat_Private(ctx->f1,A,Z,PETSC_FALSE);
205: FNEvaluateFunctionMatVec_Private(ctx->f2,Z,v,PETSC_FALSE);
206: FN_FreeWorkMat(fn,&Z);
207: break;
208: }
209: return(0);
210: }
212: PetscErrorCode FNView_Combine(FN fn,PetscViewer viewer)
213: {
215: FN_COMBINE *ctx = (FN_COMBINE*)fn->data;
216: PetscBool isascii;
219: PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&isascii);
220: if (isascii) {
221: switch (ctx->comb) {
222: case FN_COMBINE_ADD:
223: PetscViewerASCIIPrintf(viewer," Two added functions f1+f2\n");
224: break;
225: case FN_COMBINE_MULTIPLY:
226: PetscViewerASCIIPrintf(viewer," Two multiplied functions f1*f2\n");
227: break;
228: case FN_COMBINE_DIVIDE:
229: PetscViewerASCIIPrintf(viewer," A quotient of two functions f1/f2\n");
230: break;
231: case FN_COMBINE_COMPOSE:
232: PetscViewerASCIIPrintf(viewer," Two composed functions f2(f1(.))\n");
233: break;
234: }
235: PetscViewerASCIIPushTab(viewer);
236: FNView(ctx->f1,viewer);
237: FNView(ctx->f2,viewer);
238: PetscViewerASCIIPopTab(viewer);
239: }
240: return(0);
241: }
243: static PetscErrorCode FNCombineSetChildren_Combine(FN fn,FNCombineType comb,FN f1,FN f2)
244: {
246: FN_COMBINE *ctx = (FN_COMBINE*)fn->data;
249: ctx->comb = comb;
250: PetscObjectReference((PetscObject)f1);
251: FNDestroy(&ctx->f1);
252: ctx->f1 = f1;
253: PetscLogObjectParent((PetscObject)fn,(PetscObject)ctx->f1);
254: PetscObjectReference((PetscObject)f2);
255: FNDestroy(&ctx->f2);
256: ctx->f2 = f2;
257: PetscLogObjectParent((PetscObject)fn,(PetscObject)ctx->f2);
258: return(0);
259: }
261: /*@
262: FNCombineSetChildren - Sets the two child functions that constitute this
263: combined function, and the way they must be combined.
265: Logically Collective on fn
267: Input Parameters:
268: + fn - the math function context
269: . comb - how to combine the functions (addition, multiplication, division or composition)
270: . f1 - first function
271: - f2 - second function
273: Level: intermediate
275: .seealso: FNCombineGetChildren()
276: @*/
277: PetscErrorCode FNCombineSetChildren(FN fn,FNCombineType comb,FN f1,FN f2)
278: {
286: PetscTryMethod(fn,"FNCombineSetChildren_C",(FN,FNCombineType,FN,FN),(fn,comb,f1,f2));
287: return(0);
288: }
290: static PetscErrorCode FNCombineGetChildren_Combine(FN fn,FNCombineType *comb,FN *f1,FN *f2)
291: {
293: FN_COMBINE *ctx = (FN_COMBINE*)fn->data;
296: if (comb) *comb = ctx->comb;
297: if (f1) {
298: if (!ctx->f1) {
299: FNCreate(PetscObjectComm((PetscObject)fn),&ctx->f1);
300: PetscLogObjectParent((PetscObject)fn,(PetscObject)ctx->f1);
301: }
302: *f1 = ctx->f1;
303: }
304: if (f2) {
305: if (!ctx->f2) {
306: FNCreate(PetscObjectComm((PetscObject)fn),&ctx->f2);
307: PetscLogObjectParent((PetscObject)fn,(PetscObject)ctx->f2);
308: }
309: *f2 = ctx->f2;
310: }
311: return(0);
312: }
314: /*@
315: FNCombineGetChildren - Gets the two child functions that constitute this
316: combined function, and the way they are combined.
318: Not Collective
320: Input Parameter:
321: . fn - the math function context
323: Output Parameters:
324: + comb - how to combine the functions (addition, multiplication, division or composition)
325: . f1 - first function
326: - f2 - second function
328: Level: intermediate
330: .seealso: FNCombineSetChildren()
331: @*/
332: PetscErrorCode FNCombineGetChildren(FN fn,FNCombineType *comb,FN *f1,FN *f2)
333: {
338: PetscUseMethod(fn,"FNCombineGetChildren_C",(FN,FNCombineType*,FN*,FN*),(fn,comb,f1,f2));
339: return(0);
340: }
342: PetscErrorCode FNDuplicate_Combine(FN fn,MPI_Comm comm,FN *newfn)
343: {
345: FN_COMBINE *ctx = (FN_COMBINE*)fn->data,*ctx2 = (FN_COMBINE*)(*newfn)->data;
348: ctx2->comb = ctx->comb;
349: FNDuplicate(ctx->f1,comm,&ctx2->f1);
350: FNDuplicate(ctx->f2,comm,&ctx2->f2);
351: return(0);
352: }
354: PetscErrorCode FNDestroy_Combine(FN fn)
355: {
357: FN_COMBINE *ctx = (FN_COMBINE*)fn->data;
360: FNDestroy(&ctx->f1);
361: FNDestroy(&ctx->f2);
362: PetscFree(fn->data);
363: PetscObjectComposeFunction((PetscObject)fn,"FNCombineSetChildren_C",NULL);
364: PetscObjectComposeFunction((PetscObject)fn,"FNCombineGetChildren_C",NULL);
365: return(0);
366: }
368: SLEPC_EXTERN PetscErrorCode FNCreate_Combine(FN fn)
369: {
371: FN_COMBINE *ctx;
374: PetscNewLog(fn,&ctx);
375: fn->data = (void*)ctx;
377: fn->ops->evaluatefunction = FNEvaluateFunction_Combine;
378: fn->ops->evaluatederivative = FNEvaluateDerivative_Combine;
379: fn->ops->evaluatefunctionmat[0] = FNEvaluateFunctionMat_Combine;
380: fn->ops->evaluatefunctionmatvec[0] = FNEvaluateFunctionMatVec_Combine;
381: fn->ops->view = FNView_Combine;
382: fn->ops->duplicate = FNDuplicate_Combine;
383: fn->ops->destroy = FNDestroy_Combine;
384: PetscObjectComposeFunction((PetscObject)fn,"FNCombineSetChildren_C",FNCombineSetChildren_Combine);
385: PetscObjectComposeFunction((PetscObject)fn,"FNCombineGetChildren_C",FNCombineGetChildren_Combine);
386: return(0);
387: }