xref: /petsc/src/vec/pf/interface/pf.c (revision e5c89e4ece6e3231999e6896bd6dacaf81d4b32f)
1 #define PETSCVEC_DLL
2 /*
3     The PF mathematical functions interface routines, callable by users.
4 */
5 #include "src/vec/pf/pfimpl.h"            /*I "petscpf.h" I*/
6 
7 /* Logging support */
8 PetscCookie PF_COOKIE = 0;
9 
10 PetscFList PPetscFList         = PETSC_NULL; /* list of all registered PD functions */
11 PetscTruth PFRegisterAllCalled = PETSC_FALSE;
12 
13 #undef __FUNCT__
14 #define __FUNCT__ "PFSet"
15 /*@C
16    PFSet - Sets the C/C++/Fortran functions to be used by the PF function
17 
18    Collective on PF
19 
20    Input Parameter:
21 +  pf - the function context
22 .  apply - function to apply to an array
23 .  applyvec - function to apply to a Vec
24 .  view - function that prints information about the PF
25 .  destroy - function to free the private function context
26 -  ctx - private function context
27 
28    Level: beginner
29 
30 .keywords: PF, setting
31 
32 .seealso: PFCreate(), PFDestroy(), PFSetType(), PFApply(), PFApplyVec()
33 @*/
34 PetscErrorCode PETSCVEC_DLLEXPORT PFSet(PF pf,PetscErrorCode (*apply)(void*,PetscInt,PetscScalar*,PetscScalar*),PetscErrorCode (*applyvec)(void*,Vec,Vec),PetscErrorCode (*view)(void*,PetscViewer),PetscErrorCode (*destroy)(void*),void*ctx)
35 {
36   PetscFunctionBegin;
37   PetscValidHeaderSpecific(pf,PF_COOKIE,1);
38   pf->data             = ctx;
39 
40   pf->ops->destroy     = destroy;
41   pf->ops->apply       = apply;
42   pf->ops->applyvec    = applyvec;
43   pf->ops->view        = view;
44 
45   PetscFunctionReturn(0);
46 }
47 
48 #undef __FUNCT__
49 #define __FUNCT__ "PFDestroy"
50 /*@C
51    PFDestroy - Destroys PF context that was created with PFCreate().
52 
53    Collective on PF
54 
55    Input Parameter:
56 .  pf - the function context
57 
58    Level: beginner
59 
60 .keywords: PF, destroy
61 
62 .seealso: PFCreate(), PFSet(), PFSetType()
63 @*/
64 PetscErrorCode PETSCVEC_DLLEXPORT PFDestroy(PF pf)
65 {
66   PetscErrorCode ierr;
67   PetscTruth flg;
68 
69   PetscFunctionBegin;
70   PetscValidHeaderSpecific(pf,PF_COOKIE,1);
71   if (--pf->refct > 0) PetscFunctionReturn(0);
72 
73   ierr = PetscOptionsHasName(pf->prefix,"-pf_view",&flg);CHKERRQ(ierr);
74   if (flg) {
75     ierr = PFView(pf,PETSC_VIEWER_STDOUT_(pf->comm));CHKERRQ(ierr);
76   }
77 
78   /* if memory was published with AMS then destroy it */
79   ierr = PetscObjectDepublish(pf);CHKERRQ(ierr);
80 
81   if (pf->ops->destroy) {ierr =  (*pf->ops->destroy)(pf->data);CHKERRQ(ierr);}
82   ierr = PetscHeaderDestroy(pf);CHKERRQ(ierr);
83   PetscFunctionReturn(0);
84 }
85 
86 #undef __FUNCT__
87 #define __FUNCT__ "PFPublish_Petsc"
88 static PetscErrorCode PFPublish_Petsc(PetscObject obj)
89 {
90 #if defined(PETSC_HAVE_AMS)
91   PF          v = (PF) obj;
92   PetscErrorCode ierr;
93 #endif
94 
95   PetscFunctionBegin;
96 
97 #if defined(PETSC_HAVE_AMS)
98   /* if it is already published then return */
99   if (v->amem >=0) PetscFunctionReturn(0);
100 
101   ierr = PetscObjectPublishBaseBegin(obj);CHKERRQ(ierr);
102   ierr = PetscObjectPublishBaseEnd(obj);CHKERRQ(ierr);
103 #endif
104 
105   PetscFunctionReturn(0);
106 }
107 
108 #undef __FUNCT__
109 #define __FUNCT__ "PFCreate"
110 /*@C
111    PFCreate - Creates a mathematical function context.
112 
113    Collective on MPI_Comm
114 
115    Input Parameter:
116 +  comm - MPI communicator
117 .  dimin - dimension of the space you are mapping from
118 -  dimout - dimension of the space you are mapping to
119 
120    Output Parameter:
121 .  pf - the function context
122 
123    Level: developer
124 
125 .keywords: PF, create, context
126 
127 .seealso: PFSetUp(), PFApply(), PFDestroy(), PFApplyVec()
128 @*/
129 PetscErrorCode PETSCVEC_DLLEXPORT PFCreate(MPI_Comm comm,PetscInt dimin,PetscInt dimout,PF *pf)
130 {
131   PF  newpf;
132   PetscErrorCode ierr;
133 
134   PetscFunctionBegin;
135   PetscValidPointer(pf,1);
136   *pf = PETSC_NULL;
137 #ifndef PETSC_USE_DYNAMIC_LIBRARIES
138   ierr = VecInitializePackage(PETSC_NULL);CHKERRQ(ierr);
139 #endif
140 
141   ierr = PetscHeaderCreate(newpf,_p_PF,struct _PFOps,PF_COOKIE,-1,"PF",comm,PFDestroy,PFView);CHKERRQ(ierr);
142   newpf->bops->publish    = PFPublish_Petsc;
143   newpf->data             = 0;
144 
145   newpf->ops->destroy     = 0;
146   newpf->ops->apply       = 0;
147   newpf->ops->applyvec    = 0;
148   newpf->ops->view        = 0;
149   newpf->dimin            = dimin;
150   newpf->dimout           = dimout;
151 
152   *pf                     = newpf;
153   ierr = PetscPublishAll(pf);CHKERRQ(ierr);
154   PetscFunctionReturn(0);
155 
156 }
157 
158 /* -------------------------------------------------------------------------------*/
159 
160 #undef __FUNCT__
161 #define __FUNCT__ "PFApplyVec"
162 /*@
163    PFApplyVec - Applies the mathematical function to a vector
164 
165    Collective on PF
166 
167    Input Parameters:
168 +  pf - the function context
169 -  x - input vector (or PETSC_NULL for the vector (0,1, .... N-1)
170 
171    Output Parameter:
172 .  y - output vector
173 
174    Level: beginner
175 
176 .keywords: PF, apply
177 
178 .seealso: PFApply(), PFCreate(), PFDestroy(), PFSetType(), PFSet()
179 @*/
180 PetscErrorCode PETSCVEC_DLLEXPORT PFApplyVec(PF pf,Vec x,Vec y)
181 {
182   PetscErrorCode ierr;
183   PetscInt       i,rstart,rend,n,p;
184   PetscTruth     nox = PETSC_FALSE;
185 
186   PetscFunctionBegin;
187   PetscValidHeaderSpecific(pf,PF_COOKIE,1);
188   PetscValidHeaderSpecific(y,VEC_COOKIE,3);
189   if (x) {
190     PetscValidHeaderSpecific(x,VEC_COOKIE,2);
191     if (x == y) SETERRQ(PETSC_ERR_ARG_IDN,"x and y must be different vectors");
192   } else {
193     PetscScalar *xx;
194 
195     ierr = VecDuplicate(y,&x);CHKERRQ(ierr);
196     nox  = PETSC_TRUE;
197     ierr = VecGetOwnershipRange(x,&rstart,&rend);CHKERRQ(ierr);
198     ierr = VecGetArray(x,&xx);CHKERRQ(ierr);
199     for (i=rstart; i<rend; i++) {
200       xx[i-rstart] = (PetscScalar)i;
201     }
202     ierr = VecRestoreArray(x,&xx);CHKERRQ(ierr);
203   }
204 
205   ierr = VecGetLocalSize(x,&n);CHKERRQ(ierr);
206   ierr = VecGetLocalSize(y,&p);CHKERRQ(ierr);
207   if (pf->dimin*(n/pf->dimin) != n) SETERRQ2(PETSC_ERR_ARG_IDN,"Local input vector length %D not divisible by dimin %D of function",n,pf->dimin);
208   if (pf->dimout*(p/pf->dimout) != p) SETERRQ2(PETSC_ERR_ARG_IDN,"Local output vector length %D not divisible by dimout %D of function",p,pf->dimout);
209   if (n/pf->dimin != p/pf->dimout) SETERRQ4(PETSC_ERR_ARG_IDN,"Local vector lengths %D %D are wrong for dimin and dimout %D %D of function",n,p,pf->dimin,pf->dimout);
210 
211   if (pf->ops->applyvec) {
212     ierr = (*pf->ops->applyvec)(pf->data,x,y);CHKERRQ(ierr);
213   } else {
214     PetscScalar *xx,*yy;
215 
216     ierr = VecGetLocalSize(x,&n);CHKERRQ(ierr);
217     n    = n/pf->dimin;
218     ierr = VecGetArray(x,&xx);CHKERRQ(ierr);
219     ierr = VecGetArray(y,&yy);CHKERRQ(ierr);
220     if (!pf->ops->apply) SETERRQ(PETSC_ERR_ARG_WRONGSTATE,"No function has been provided for this PF");
221     ierr = (*pf->ops->apply)(pf->data,n,xx,yy);CHKERRQ(ierr);
222     ierr = VecRestoreArray(x,&xx);CHKERRQ(ierr);
223     ierr = VecRestoreArray(y,&yy);CHKERRQ(ierr);
224   }
225   if (nox) {
226     ierr = VecDestroy(x);CHKERRQ(ierr);
227   }
228   PetscFunctionReturn(0);
229 }
230 
231 #undef __FUNCT__
232 #define __FUNCT__ "PFApply"
233 /*@
234    PFApply - Applies the mathematical function to an array of values.
235 
236    Collective on PF
237 
238    Input Parameters:
239 +  pf - the function context
240 .  n - number of pointwise function evaluations to perform, each pointwise function evaluation
241        is a function of dimin variables and computes dimout variables where dimin and dimout are defined
242        in the call to PFCreate()
243 -  x - input array
244 
245    Output Parameter:
246 .  y - output array
247 
248    Level: beginner
249 
250    Notes:
251 
252 .keywords: PF, apply
253 
254 .seealso: PFApplyVec(), PFCreate(), PFDestroy(), PFSetType(), PFSet()
255 @*/
256 PetscErrorCode PETSCVEC_DLLEXPORT PFApply(PF pf,PetscInt n,PetscScalar* x,PetscScalar* y)
257 {
258   PetscErrorCode ierr;
259 
260   PetscFunctionBegin;
261   PetscValidHeaderSpecific(pf,PF_COOKIE,1);
262   PetscValidScalarPointer(x,2);
263   PetscValidScalarPointer(y,3);
264   if (x == y) SETERRQ(PETSC_ERR_ARG_IDN,"x and y must be different arrays");
265   if (!pf->ops->apply) SETERRQ(PETSC_ERR_ARG_WRONGSTATE,"No function has been provided for this PF");
266 
267   ierr = (*pf->ops->apply)(pf->data,n,x,y);CHKERRQ(ierr);
268   PetscFunctionReturn(0);
269 }
270 
271 #undef __FUNCT__
272 #define __FUNCT__ "PFView"
273 /*@
274    PFView - Prints information about a mathematical function
275 
276    Collective on PF unless PetscViewer is PETSC_VIEWER_STDOUT_SELF
277 
278    Input Parameters:
279 +  PF - the PF context
280 -  viewer - optional visualization context
281 
282    Note:
283    The available visualization contexts include
284 +     PETSC_VIEWER_STDOUT_SELF - standard output (default)
285 -     PETSC_VIEWER_STDOUT_WORLD - synchronized standard
286          output where only the first processor opens
287          the file.  All other processors send their
288          data to the first processor to print.
289 
290    The user can open an alternative visualization contexts with
291    PetscViewerASCIIOpen() (output to a specified file).
292 
293    Level: developer
294 
295 .keywords: PF, view
296 
297 .seealso: PetscViewerCreate(), PetscViewerASCIIOpen()
298 @*/
299 PetscErrorCode PETSCVEC_DLLEXPORT PFView(PF pf,PetscViewer viewer)
300 {
301   PFType            cstr;
302   PetscErrorCode ierr;
303   PetscTruth        iascii;
304   PetscViewerFormat format;
305 
306   PetscFunctionBegin;
307   PetscValidHeaderSpecific(pf,PF_COOKIE,1);
308   if (!viewer) viewer = PETSC_VIEWER_STDOUT_(pf->comm);
309   PetscValidHeaderSpecific(viewer,PETSC_VIEWER_COOKIE,2);
310   PetscCheckSameComm(pf,1,viewer,2);
311 
312   ierr = PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_ASCII,&iascii);CHKERRQ(ierr);
313   if (iascii) {
314     ierr = PetscViewerGetFormat(viewer,&format);CHKERRQ(ierr);
315     ierr = PetscViewerASCIIPrintf(viewer,"PF Object:\n");CHKERRQ(ierr);
316     ierr = PFGetType(pf,&cstr);CHKERRQ(ierr);
317     if (cstr) {
318       ierr = PetscViewerASCIIPrintf(viewer,"  type: %s\n",cstr);CHKERRQ(ierr);
319     } else {
320       ierr = PetscViewerASCIIPrintf(viewer,"  type: not yet set\n");CHKERRQ(ierr);
321     }
322     if (pf->ops->view) {
323       ierr = PetscViewerASCIIPushTab(viewer);CHKERRQ(ierr);
324       ierr = (*pf->ops->view)(pf->data,viewer);CHKERRQ(ierr);
325       ierr = PetscViewerASCIIPopTab(viewer);CHKERRQ(ierr);
326     }
327   } else {
328     SETERRQ1(PETSC_ERR_SUP,"Viewer type %s not supported by PF",((PetscObject)viewer)->type_name);
329   }
330   PetscFunctionReturn(0);
331 }
332 
333 /*MC
334    PFRegisterDynamic - Adds a method to the mathematical function package.
335 
336    Synopsis:
337    PetscErrorCode PFRegisterDynamic(char *name_solver,char *path,char *name_create,PetscErrorCode (*routine_create)(PF))
338 
339    Not collective
340 
341    Input Parameters:
342 +  name_solver - name of a new user-defined solver
343 .  path - path (either absolute or relative) the library containing this solver
344 .  name_create - name of routine to create method context
345 -  routine_create - routine to create method context
346 
347    Notes:
348    PFRegisterDynamic() may be called multiple times to add several user-defined functions
349 
350    If dynamic libraries are used, then the fourth input argument (routine_create)
351    is ignored.
352 
353    Sample usage:
354 .vb
355    PFRegisterDynamic("my_function","/home/username/my_lib/lib/libO/solaris/mylib",
356               "MyFunctionCreate",MyFunctionSetCreate);
357 .ve
358 
359    Then, your solver can be chosen with the procedural interface via
360 $     PFSetType(pf,"my_function")
361    or at runtime via the option
362 $     -pf_type my_function
363 
364    Level: advanced
365 
366    ${PETSC_ARCH}, ${PETSC_DIR}, ${PETSC_LIB_DIR}, or ${any environmental variable}
367  occuring in pathname will be replaced with appropriate values.
368 
369 .keywords: PF, register
370 
371 .seealso: PFRegisterAll(), PFRegisterDestroy(), PFRegister()
372 M*/
373 
374 #undef __FUNCT__
375 #define __FUNCT__ "PFRegister"
376 PetscErrorCode PETSCVEC_DLLEXPORT PFRegister(const char sname[],const char path[],const char name[],PetscErrorCode (*function)(PF,void*))
377 {
378   PetscErrorCode ierr;
379   char fullname[PETSC_MAX_PATH_LEN];
380 
381   PetscFunctionBegin;
382   ierr = PetscFListConcat(path,name,fullname);CHKERRQ(ierr);
383   ierr = PetscFListAdd(&PPetscFList,sname,fullname,(void (*)(void))function);CHKERRQ(ierr);
384   PetscFunctionReturn(0);
385 }
386 
387 
388 
389 #undef __FUNCT__
390 #define __FUNCT__ "PFGetType"
391 /*@C
392    PFGetType - Gets the PF method type and name (as a string) from the PF
393    context.
394 
395    Not Collective
396 
397    Input Parameter:
398 .  pf - the function context
399 
400    Output Parameter:
401 .  name - name of function
402 
403    Level: intermediate
404 
405 .keywords: PF, get, method, name, type
406 
407 .seealso: PFSetType()
408 
409 @*/
410 PetscErrorCode PETSCVEC_DLLEXPORT PFGetType(PF pf,PFType *meth)
411 {
412   PetscFunctionBegin;
413   *meth = (PFType) pf->type_name;
414   PetscFunctionReturn(0);
415 }
416 
417 
418 #undef __FUNCT__
419 #define __FUNCT__ "PFSetType"
420 /*@C
421    PFSetType - Builds PF for a particular function
422 
423    Collective on PF
424 
425    Input Parameter:
426 +  pf - the function context.
427 .  type - a known method
428 -  ctx - optional type dependent context
429 
430    Options Database Key:
431 .  -pf_type <type> - Sets PF type
432 
433 
434   Notes:
435   See "petsc/include/petscpf.h" for available methods (for instance,
436   PFCONSTANT)
437 
438   Level: intermediate
439 
440 .keywords: PF, set, method, type
441 
442 .seealso: PFSet(), PFRegisterDynamic(), PFCreate(), DACreatePF()
443 
444 @*/
445 PetscErrorCode PETSCVEC_DLLEXPORT PFSetType(PF pf,const PFType type,void *ctx)
446 {
447   PetscErrorCode ierr,(*r)(PF,void*);
448   PetscTruth match;
449 
450   PetscFunctionBegin;
451   PetscValidHeaderSpecific(pf,PF_COOKIE,1);
452   PetscValidCharPointer(type,2);
453 
454   ierr = PetscTypeCompare((PetscObject)pf,type,&match);CHKERRQ(ierr);
455   if (match) PetscFunctionReturn(0);
456 
457   if (pf->ops->destroy) {ierr =  (*pf->ops->destroy)(pf);CHKERRQ(ierr);}
458   pf->data        = 0;
459 
460   /* Get the function pointers for the method requested */
461   if (!PFRegisterAllCalled) {ierr = PFRegisterAll(0);CHKERRQ(ierr);}
462   /* Determine the PFCreateXXX routine for a particular function */
463   ierr =  PetscFListFind(pf->comm,PPetscFList,type,(void (**)(void)) &r);CHKERRQ(ierr);
464   if (!r) SETERRQ1(PETSC_ERR_ARG_UNKNOWN_TYPE,"Unable to find requested PF type %s",type);
465   pf->ops->destroy             = 0;
466   pf->ops->view                = 0;
467   pf->ops->apply               = 0;
468   pf->ops->applyvec            = 0;
469 
470   /* Call the PFCreateXXX routine for this particular function */
471   ierr = (*r)(pf,ctx);CHKERRQ(ierr);
472 
473   ierr = PetscObjectChangeTypeName((PetscObject)pf,type);CHKERRQ(ierr);
474   PetscFunctionReturn(0);
475 }
476 
477 #undef __FUNCT__
478 #define __FUNCT__ "PFSetFromOptions"
479 /*@
480    PFSetFromOptions - Sets PF options from the options database.
481 
482    Collective on PF
483 
484    Input Parameters:
485 .  pf - the mathematical function context
486 
487    Options Database Keys:
488 
489    Notes:
490    To see all options, run your program with the -help option
491    or consult the users manual.
492 
493    Level: intermediate
494 
495 .keywords: PF, set, from, options, database
496 
497 .seealso:
498 @*/
499 PetscErrorCode PETSCVEC_DLLEXPORT PFSetFromOptions(PF pf)
500 {
501   PetscErrorCode ierr;
502   char       type[256];
503   PetscTruth flg;
504 
505   PetscFunctionBegin;
506   PetscValidHeaderSpecific(pf,PF_COOKIE,1);
507 
508   if (!PFRegisterAllCalled) {ierr = PFRegisterAll(0);CHKERRQ(ierr);}
509   ierr = PetscOptionsBegin(pf->comm,pf->prefix,"Mathematical functions options","Vec");CHKERRQ(ierr);
510     ierr = PetscOptionsList("-pf_type","Type of function","PFSetType",PPetscFList,0,type,256,&flg);CHKERRQ(ierr);
511     if (flg) {
512       ierr = PFSetType(pf,type,PETSC_NULL);CHKERRQ(ierr);
513     }
514     if (pf->ops->setfromoptions) {
515       ierr = (*pf->ops->setfromoptions)(pf);CHKERRQ(ierr);
516     }
517   ierr = PetscOptionsEnd();CHKERRQ(ierr);
518 
519   PetscFunctionReturn(0);
520 }
521 
522 
523 
524 
525 
526 
527 
528 
529 
530 
531