Actual source code: fncombine.c
slepc-3.15.0 2021-03-31
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: 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>
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: {
97: PetscErrorCode ierr;
98: FN_COMBINE *ctx = (FN_COMBINE*)fn->data;
99: PetscScalar *Ba,*Wa,one=1.0,zero=0.0;
100: const PetscScalar *Za;
101: PetscBLASInt n,ld,ld2,inc=1,*ipiv,info;
102: PetscInt m;
103: Mat W,Z;
106: FN_AllocateWorkMat(fn,A,&W);
107: MatGetSize(A,&m,NULL);
108: PetscBLASIntCast(m,&n);
109: ld = n;
110: ld2 = ld*ld;
112: switch (ctx->comb) {
113: case FN_COMBINE_ADD:
114: FNEvaluateFunctionMat_Private(ctx->f1,A,W,PETSC_FALSE);
115: FNEvaluateFunctionMat_Private(ctx->f2,A,B,PETSC_FALSE);
116: MatDenseGetArray(B,&Ba);
117: MatDenseGetArray(W,&Wa);
118: PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&ld2,&one,Wa,&inc,Ba,&inc));
119: PetscLogFlops(1.0*n*n);
120: MatDenseRestoreArray(B,&Ba);
121: MatDenseRestoreArray(W,&Wa);
122: break;
123: case FN_COMBINE_MULTIPLY:
124: FN_AllocateWorkMat(fn,A,&Z);
125: FNEvaluateFunctionMat_Private(ctx->f1,A,W,PETSC_FALSE);
126: FNEvaluateFunctionMat_Private(ctx->f2,A,Z,PETSC_FALSE);
127: MatDenseGetArray(B,&Ba);
128: MatDenseGetArray(W,&Wa);
129: MatDenseGetArrayRead(Z,&Za);
130: PetscStackCallBLAS("BLASgemm",BLASgemm_("N","N",&n,&n,&n,&one,Wa,&ld,Za,&ld,&zero,Ba,&ld));
131: PetscLogFlops(2.0*n*n*n);
132: MatDenseRestoreArray(B,&Ba);
133: MatDenseRestoreArray(W,&Wa);
134: MatDenseRestoreArrayRead(Z,&Za);
135: FN_FreeWorkMat(fn,&Z);
136: break;
137: case FN_COMBINE_DIVIDE:
138: FNEvaluateFunctionMat_Private(ctx->f2,A,W,PETSC_FALSE);
139: FNEvaluateFunctionMat_Private(ctx->f1,A,B,PETSC_FALSE);
140: PetscMalloc1(ld,&ipiv);
141: MatDenseGetArray(B,&Ba);
142: MatDenseGetArray(W,&Wa);
143: PetscStackCallBLAS("LAPACKgesv",LAPACKgesv_(&n,&n,Wa,&ld,ipiv,Ba,&ld,&info));
144: SlepcCheckLapackInfo("gesv",info);
145: PetscLogFlops(2.0*n*n*n/3.0+2.0*n*n*n);
146: MatDenseRestoreArray(B,&Ba);
147: MatDenseRestoreArray(W,&Wa);
148: PetscFree(ipiv);
149: break;
150: case FN_COMBINE_COMPOSE:
151: FNEvaluateFunctionMat_Private(ctx->f1,A,W,PETSC_FALSE);
152: FNEvaluateFunctionMat_Private(ctx->f2,W,B,PETSC_FALSE);
153: break;
154: }
156: FN_FreeWorkMat(fn,&W);
157: return(0);
158: }
160: PetscErrorCode FNEvaluateFunctionMatVec_Combine(FN fn,Mat A,Vec v)
161: {
163: FN_COMBINE *ctx = (FN_COMBINE*)fn->data;
164: PetscScalar *va,*Za;
165: PetscBLASInt n,ld,*ipiv,info,one=1;
166: PetscInt m;
167: Mat Z;
168: Vec w;
171: MatGetSize(A,&m,NULL);
172: PetscBLASIntCast(m,&n);
173: ld = n;
175: switch (ctx->comb) {
176: case FN_COMBINE_ADD:
177: VecDuplicate(v,&w);
178: FNEvaluateFunctionMatVec(ctx->f1,A,w);
179: FNEvaluateFunctionMatVec(ctx->f2,A,v);
180: VecAXPY(v,1.0,w);
181: VecDestroy(&w);
182: break;
183: case FN_COMBINE_MULTIPLY:
184: VecDuplicate(v,&w);
185: FN_AllocateWorkMat(fn,A,&Z);
186: FNEvaluateFunctionMat_Private(ctx->f1,A,Z,PETSC_FALSE);
187: FNEvaluateFunctionMatVec_Private(ctx->f2,A,w,PETSC_FALSE);
188: MatMult(Z,w,v);
189: FN_FreeWorkMat(fn,&Z);
190: VecDestroy(&w);
191: break;
192: case FN_COMBINE_DIVIDE:
193: VecDuplicate(v,&w);
194: FN_AllocateWorkMat(fn,A,&Z);
195: FNEvaluateFunctionMat_Private(ctx->f2,A,Z,PETSC_FALSE);
196: FNEvaluateFunctionMatVec_Private(ctx->f1,A,v,PETSC_FALSE);
197: PetscMalloc1(ld,&ipiv);
198: MatDenseGetArray(Z,&Za);
199: VecGetArray(v,&va);
200: PetscStackCallBLAS("LAPACKgesv",LAPACKgesv_(&n,&one,Za,&ld,ipiv,va,&ld,&info));
201: SlepcCheckLapackInfo("gesv",info);
202: PetscLogFlops(2.0*n*n*n/3.0+2.0*n*n);
203: VecRestoreArray(v,&va);
204: MatDenseRestoreArray(Z,&Za);
205: PetscFree(ipiv);
206: FN_FreeWorkMat(fn,&Z);
207: VecDestroy(&w);
208: break;
209: case FN_COMBINE_COMPOSE:
210: FN_AllocateWorkMat(fn,A,&Z);
211: FNEvaluateFunctionMat_Private(ctx->f1,A,Z,PETSC_FALSE);
212: FNEvaluateFunctionMatVec_Private(ctx->f2,Z,v,PETSC_FALSE);
213: FN_FreeWorkMat(fn,&Z);
214: break;
215: }
216: return(0);
217: }
219: PetscErrorCode FNView_Combine(FN fn,PetscViewer viewer)
220: {
222: FN_COMBINE *ctx = (FN_COMBINE*)fn->data;
223: PetscBool isascii;
226: PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&isascii);
227: if (isascii) {
228: switch (ctx->comb) {
229: case FN_COMBINE_ADD:
230: PetscViewerASCIIPrintf(viewer," Two added functions f1+f2\n");
231: break;
232: case FN_COMBINE_MULTIPLY:
233: PetscViewerASCIIPrintf(viewer," Two multiplied functions f1*f2\n");
234: break;
235: case FN_COMBINE_DIVIDE:
236: PetscViewerASCIIPrintf(viewer," A quotient of two functions f1/f2\n");
237: break;
238: case FN_COMBINE_COMPOSE:
239: PetscViewerASCIIPrintf(viewer," Two composed functions f2(f1(.))\n");
240: break;
241: }
242: PetscViewerASCIIPushTab(viewer);
243: FNView(ctx->f1,viewer);
244: FNView(ctx->f2,viewer);
245: PetscViewerASCIIPopTab(viewer);
246: }
247: return(0);
248: }
250: static PetscErrorCode FNCombineSetChildren_Combine(FN fn,FNCombineType comb,FN f1,FN f2)
251: {
253: FN_COMBINE *ctx = (FN_COMBINE*)fn->data;
256: ctx->comb = comb;
257: PetscObjectReference((PetscObject)f1);
258: FNDestroy(&ctx->f1);
259: ctx->f1 = f1;
260: PetscLogObjectParent((PetscObject)fn,(PetscObject)ctx->f1);
261: PetscObjectReference((PetscObject)f2);
262: FNDestroy(&ctx->f2);
263: ctx->f2 = f2;
264: PetscLogObjectParent((PetscObject)fn,(PetscObject)ctx->f2);
265: return(0);
266: }
268: /*@
269: FNCombineSetChildren - Sets the two child functions that constitute this
270: combined function, and the way they must be combined.
272: Logically Collective on fn
274: Input Parameters:
275: + fn - the math function context
276: . comb - how to combine the functions (addition, multiplication, division or composition)
277: . f1 - first function
278: - f2 - second function
280: Level: intermediate
282: .seealso: FNCombineGetChildren()
283: @*/
284: PetscErrorCode FNCombineSetChildren(FN fn,FNCombineType comb,FN f1,FN f2)
285: {
293: PetscTryMethod(fn,"FNCombineSetChildren_C",(FN,FNCombineType,FN,FN),(fn,comb,f1,f2));
294: return(0);
295: }
297: static PetscErrorCode FNCombineGetChildren_Combine(FN fn,FNCombineType *comb,FN *f1,FN *f2)
298: {
300: FN_COMBINE *ctx = (FN_COMBINE*)fn->data;
303: if (comb) *comb = ctx->comb;
304: if (f1) {
305: if (!ctx->f1) {
306: FNCreate(PetscObjectComm((PetscObject)fn),&ctx->f1);
307: PetscLogObjectParent((PetscObject)fn,(PetscObject)ctx->f1);
308: }
309: *f1 = ctx->f1;
310: }
311: if (f2) {
312: if (!ctx->f2) {
313: FNCreate(PetscObjectComm((PetscObject)fn),&ctx->f2);
314: PetscLogObjectParent((PetscObject)fn,(PetscObject)ctx->f2);
315: }
316: *f2 = ctx->f2;
317: }
318: return(0);
319: }
321: /*@
322: FNCombineGetChildren - Gets the two child functions that constitute this
323: combined function, and the way they are combined.
325: Not Collective
327: Input Parameter:
328: . fn - the math function context
330: Output Parameters:
331: + comb - how to combine the functions (addition, multiplication, division or composition)
332: . f1 - first function
333: - f2 - second function
335: Level: intermediate
337: .seealso: FNCombineSetChildren()
338: @*/
339: PetscErrorCode FNCombineGetChildren(FN fn,FNCombineType *comb,FN *f1,FN *f2)
340: {
345: PetscUseMethod(fn,"FNCombineGetChildren_C",(FN,FNCombineType*,FN*,FN*),(fn,comb,f1,f2));
346: return(0);
347: }
349: PetscErrorCode FNDuplicate_Combine(FN fn,MPI_Comm comm,FN *newfn)
350: {
352: FN_COMBINE *ctx = (FN_COMBINE*)fn->data,*ctx2 = (FN_COMBINE*)(*newfn)->data;
355: ctx2->comb = ctx->comb;
356: FNDuplicate(ctx->f1,comm,&ctx2->f1);
357: FNDuplicate(ctx->f2,comm,&ctx2->f2);
358: return(0);
359: }
361: PetscErrorCode FNDestroy_Combine(FN fn)
362: {
364: FN_COMBINE *ctx = (FN_COMBINE*)fn->data;
367: FNDestroy(&ctx->f1);
368: FNDestroy(&ctx->f2);
369: PetscFree(fn->data);
370: PetscObjectComposeFunction((PetscObject)fn,"FNCombineSetChildren_C",NULL);
371: PetscObjectComposeFunction((PetscObject)fn,"FNCombineGetChildren_C",NULL);
372: return(0);
373: }
375: SLEPC_EXTERN PetscErrorCode FNCreate_Combine(FN fn)
376: {
378: FN_COMBINE *ctx;
381: PetscNewLog(fn,&ctx);
382: fn->data = (void*)ctx;
384: fn->ops->evaluatefunction = FNEvaluateFunction_Combine;
385: fn->ops->evaluatederivative = FNEvaluateDerivative_Combine;
386: fn->ops->evaluatefunctionmat[0] = FNEvaluateFunctionMat_Combine;
387: fn->ops->evaluatefunctionmatvec[0] = FNEvaluateFunctionMatVec_Combine;
388: fn->ops->view = FNView_Combine;
389: fn->ops->duplicate = FNDuplicate_Combine;
390: fn->ops->destroy = FNDestroy_Combine;
391: PetscObjectComposeFunction((PetscObject)fn,"FNCombineSetChildren_C",FNCombineSetChildren_Combine);
392: PetscObjectComposeFunction((PetscObject)fn,"FNCombineGetChildren_C",FNCombineGetChildren_Combine);
393: return(0);
394: }