2: #include <../src/vec/pf/pfimpl.h>

  4: /*
  5:         Ths PF generates a function on the fly and loads it into the running
  6:    program.
  7: */

  9: static PetscErrorCode PFView_String(void *value,PetscViewer viewer)
 10: {
 12:   PetscBool      iascii;

 15:   PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);
 16:   if (iascii) {
 17:     PetscViewerASCIIPrintf(viewer,"String = %s\n",(char*)value);
 18:   }
 19:   return(0);
 20: }

 22: static PetscErrorCode PFDestroy_String(void *value)
 23: {

 27:   PetscFree(value);
 28:   return(0);
 29: }

 31: /*
 32:     PFStringCreateFunction - Creates a function from a string

 34:    Collective over PF

 36:   Input Parameters:
 37: +    pf - the function object
 38: -    string - the string that defines the function

 40:   Output Parameter:
 41: .    f - the function pointer.

 43: .seealso: PFSetFromOptions()

 45: */
 46: PetscErrorCode  PFStringCreateFunction(PF pf,char *string,void **f)
 47: {
 48: #if defined(PETSC_HAVE_DYNAMIC_LIBRARIES)
 50:   char           task[1024],tmp[256],lib[PETSC_MAX_PATH_LEN],username[64];
 51:   FILE           *fd;
 52:   PetscBool      tmpshared,wdshared,keeptmpfiles = PETSC_FALSE;
 53:   MPI_Comm       comm;
 54: #endif

 57: #if defined(PETSC_HAVE_DYNAMIC_LIBRARIES)
 58:   PetscFree(pf->data);
 59:   PetscStrallocpy(string,(char**)&pf->data);

 61:   /* create the new C function and compile it */
 62:   PetscSharedTmp(PetscObjectComm((PetscObject)pf),&tmpshared);
 63:   PetscSharedWorkingDirectory(PetscObjectComm((PetscObject)pf),&wdshared);
 64:   if (tmpshared) {  /* do it in /tmp since everyone has one */
 65:     PetscGetTmp(PetscObjectComm((PetscObject)pf),tmp,PETSC_MAX_PATH_LEN);
 66:     PetscObjectGetComm((PetscObject)pf,&comm);
 67:   } else if (!wdshared) {  /* each one does in private /tmp */
 68:     PetscGetTmp(PetscObjectComm((PetscObject)pf),tmp,PETSC_MAX_PATH_LEN);
 69:     comm = PETSC_COMM_SELF;
 70:   } else { /* do it in current directory */
 71:     PetscStrcpy(tmp,".");
 72:     PetscObjectGetComm((PetscObject)pf,&comm);
 73:   }
 74:   PetscOptionsGetBool(((PetscObject)pf)->options,((PetscObject)pf)->prefix,"-pf_string_keep_files",&keeptmpfiles,NULL);
 75:   if (keeptmpfiles) 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);
 76:   else              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,(int)pf->dimin,(int)pf->dimout,string);

 78: #if defined(PETSC_HAVE_POPEN)
 79:   PetscPOpen(comm,NULL,task,"r",&fd);
 80:   PetscPClose(comm,fd);
 81: #else
 82:   SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP_SYS,"Cannot run external programs on this machine");
 83: #endif

 85:   MPI_Barrier(comm);

 87:   /* load the apply function from the dynamic library */
 88:   PetscGetUserName(username,64);
 89:   sprintf(lib,"%s/%s/libpetscdlib",tmp,username);
 90:   PetscDLLibrarySym(comm,NULL,lib,"PFApply_String",f);
 91:   if (!f) SETERRQ1(PetscObjectComm((PetscObject)pf),PETSC_ERR_ARG_WRONGSTATE,"Cannot find function %s",lib);
 92: #endif
 93:   return(0);
 94: }

 96: static PetscErrorCode PFSetFromOptions_String(PetscOptionItems *PetscOptionsObject,PF pf)
 97: {
 99:   PetscBool      flag;
100:   char           value[PETSC_MAX_PATH_LEN];
101:   PetscErrorCode (*f)(void*,PetscInt,const PetscScalar*,PetscScalar*) = NULL;

104:   PetscOptionsHead(PetscOptionsObject,"String function options");
105:   PetscOptionsString("-pf_string","Enter the function","PFStringCreateFunction","",value,sizeof(value),&flag);
106:   if (flag) {
107:     PFStringCreateFunction(pf,value,(void**)&f);
108:     pf->ops->apply = f;
109:   }
110:   PetscOptionsTail();
111:   return(0);
112: }

114: typedef PetscErrorCode (*FCN)(void*,PetscInt,const PetscScalar*,PetscScalar*); /* force argument to next function to not be extern C*/

116: PETSC_EXTERN PetscErrorCode PFCreate_String(PF pf,void *value)
117: {
119:   FCN            f = NULL;

122:   if (value) {
123:     PFStringCreateFunction(pf,(char*)value,(void**)&f);
124:   }
125:   PFSet(pf,f,NULL,PFView_String,PFDestroy_String,NULL);
126:   pf->ops->setfromoptions = PFSetFromOptions_String;
127:   return(0);
128: }