xref: /petsc/src/vec/pf/impls/string/cstring.c (revision d71ae5a4db6382e7f06317b8d368875286fe9008)
1 
2 #include <../src/vec/pf/pfimpl.h> /*I "petscpf.h" I*/
3 
4 /*
5         This PF generates a function on the fly and loads it into the running
6    program.
7 */
8 
9 static PetscErrorCode PFView_String(void *value, PetscViewer viewer)
10 {
11   PetscBool iascii;
12 
13   PetscFunctionBegin;
14   PetscCall(PetscObjectTypeCompare((PetscObject)viewer, PETSCVIEWERASCII, &iascii));
15   if (iascii) PetscCall(PetscViewerASCIIPrintf(viewer, "String = %s\n", (char *)value));
16   PetscFunctionReturn(0);
17 }
18 
19 static PetscErrorCode PFDestroy_String(void *value)
20 {
21   PetscFunctionBegin;
22   PetscCall(PetscFree(value));
23   PetscFunctionReturn(0);
24 }
25 
26 /*
27     PFStringCreateFunction - Creates a function from a string
28 
29    Collective over PF
30 
31   Input Parameters:
32 +    pf - the function object
33 -    string - the string that defines the function
34 
35   Output Parameter:
36 .    f - the function pointer.
37 
38 .seealso: `PFSetFromOptions()`
39 
40 */
41 PetscErrorCode PFStringCreateFunction(PF pf, char *string, void **f)
42 {
43 #if defined(PETSC_HAVE_DYNAMIC_LIBRARIES)
44   char      task[1024], tmp[256], lib[PETSC_MAX_PATH_LEN], username[64];
45   FILE     *fd;
46   PetscBool tmpshared, wdshared, keeptmpfiles = PETSC_FALSE;
47   MPI_Comm  comm;
48 #endif
49 
50   PetscFunctionBegin;
51 #if defined(PETSC_HAVE_DYNAMIC_LIBRARIES)
52   PetscCall(PetscFree(pf->data));
53   PetscCall(PetscStrallocpy(string, (char **)&pf->data));
54 
55   /* create the new C function and compile it */
56   PetscCall(PetscSharedTmp(PetscObjectComm((PetscObject)pf), &tmpshared));
57   PetscCall(PetscSharedWorkingDirectory(PetscObjectComm((PetscObject)pf), &wdshared));
58   if (tmpshared) { /* do it in /tmp since everyone has one */
59     PetscCall(PetscGetTmp(PetscObjectComm((PetscObject)pf), tmp, PETSC_MAX_PATH_LEN));
60     PetscCall(PetscObjectGetComm((PetscObject)pf, &comm));
61   } else if (!wdshared) { /* each one does in private /tmp */
62     PetscCall(PetscGetTmp(PetscObjectComm((PetscObject)pf), tmp, PETSC_MAX_PATH_LEN));
63     comm = PETSC_COMM_SELF;
64   } else { /* do it in current directory */
65     PetscCall(PetscStrcpy(tmp, "."));
66     PetscCall(PetscObjectGetComm((PetscObject)pf, &comm));
67   }
68   PetscCall(PetscOptionsGetBool(((PetscObject)pf)->options, ((PetscObject)pf)->prefix, "-pf_string_keep_files", &keeptmpfiles, NULL));
69   if (keeptmpfiles)
70     sprintf(task, "cd %s ; mkdir ${USERNAME} ; cd ${USERNAME} ; \\cp -f ${PETSC_DIR}/src/pf/impls/string/makefile ./makefile ; ke  MIN=%d NOUT=%d petscdlib STRINGFUNCTION=\"%s\" ; sync\n", tmp, (int)pf->dimin, (int)pf->dimout, string);
71   else
72     sprintf(task, "cd %s ; mkdir ${USERNAME} ; cd ${USERNAME} ; \\cp -f ${PETSC_DIR}/src/pf/impls/string/makefile ./makefile ; make  MIN=%d NOUT=%d -f makefile petscdlib STRINGFUNCTION=\"%s\" ; \\rm -f makefile petscdlib.c libpetscdlib.a ;  sync\n", tmp,
73             (int)pf->dimin, (int)pf->dimout, string);
74 
75   #if defined(PETSC_HAVE_POPEN)
76   PetscCall(PetscPOpen(comm, NULL, task, "r", &fd));
77   PetscCall(PetscPClose(comm, fd));
78   #else
79   SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP_SYS, "Cannot run external programs on this machine");
80   #endif
81 
82   PetscCallMPI(MPI_Barrier(comm));
83 
84   /* load the apply function from the dynamic library */
85   PetscCall(PetscGetUserName(username, 64));
86   sprintf(lib, "%s/%s/libpetscdlib", tmp, username);
87   PetscCall(PetscDLLibrarySym(comm, NULL, lib, "PFApply_String", f));
88   PetscCheck(f, PetscObjectComm((PetscObject)pf), PETSC_ERR_ARG_WRONGSTATE, "Cannot find function %s", lib);
89 #endif
90   PetscFunctionReturn(0);
91 }
92 
93 static PetscErrorCode PFSetFromOptions_String(PF pf, PetscOptionItems *PetscOptionsObject)
94 {
95   PetscBool flag;
96   char      value[PETSC_MAX_PATH_LEN];
97   PetscErrorCode (*f)(void *, PetscInt, const PetscScalar *, PetscScalar *) = NULL;
98 
99   PetscFunctionBegin;
100   PetscOptionsHeadBegin(PetscOptionsObject, "String function options");
101   PetscCall(PetscOptionsString("-pf_string", "Enter the function", "PFStringCreateFunction", "", value, sizeof(value), &flag));
102   if (flag) {
103     PetscCall(PFStringCreateFunction(pf, value, (void **)&f));
104     pf->ops->apply = f;
105   }
106   PetscOptionsHeadEnd();
107   PetscFunctionReturn(0);
108 }
109 
110 typedef PetscErrorCode (*FCN)(void *, PetscInt, const PetscScalar *, PetscScalar *); /* force argument to next function to not be extern C*/
111 
112 PETSC_EXTERN PetscErrorCode PFCreate_String(PF pf, void *value)
113 {
114   FCN f = NULL;
115 
116   PetscFunctionBegin;
117   if (value) PetscCall(PFStringCreateFunction(pf, (char *)value, (void **)&f));
118   PetscCall(PFSet(pf, f, NULL, PFView_String, PFDestroy_String, NULL));
119   pf->ops->setfromoptions = PFSetFromOptions_String;
120   PetscFunctionReturn(0);
121 }
122