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