1: #define PETSC_DLL
  2: /*
  3:       Some PETSc utilites routines to add simple parallel IO capability
  4: */
 5:  #include petsc.h
 6:  #include petscsys.h
  7: #include <stdarg.h>
  8: #if defined(PETSC_HAVE_STDLIB_H)
  9: #include <stdlib.h>
 10: #endif
 11: #include "petscfix.h"

 15: /*@C
 16:     PetscFOpen - Has the first process in the communicator open a file;
 17:     all others do nothing.

 19:     Collective on MPI_Comm

 21:     Input Parameters:
 22: +   comm - the communicator
 23: .   name - the filename
 24: -   mode - the mode for fopen(), usually "w"

 26:     Output Parameter:
 27: .   fp - the file pointer

 29:     Level: developer

 31:     Notes:
 32:        PETSC_NULL (0), "stderr" or "stdout" may be passed in as the filename
 33:   
 34:     Fortran Note:
 35:     This routine is not supported in Fortran.

 37:     Concepts: opening ASCII file
 38:     Concepts: files^opening ASCII

 40: .seealso: PetscFClose(), PetscSynchronizedFGets(), PetscSynchronizedPrintf(), PetscSynchronizedFlush(),
 41:           PetscFPrintf()
 42: @*/
 43: PetscErrorCode  PetscFOpen(MPI_Comm comm,const char name[],const char mode[],FILE **fp)
 44: {
 46:   PetscMPIInt    rank;
 47:   FILE           *fd;
 48:   char           fname[PETSC_MAX_PATH_LEN],tname[PETSC_MAX_PATH_LEN];

 51:   MPI_Comm_rank(comm,&rank);
 52:   if (!rank) {
 53:     PetscTruth isstdout,isstderr;
 54:     PetscStrcmp(name,"stdout",&isstdout);
 55:     PetscStrcmp(name,"stderr",&isstderr);
 56:     if (isstdout || !name) {
 57:       fd = stdout;
 58:     } else if (isstderr) {
 59:       fd = stderr;
 60:     } else {
 61:       PetscStrreplace(PETSC_COMM_SELF,name,tname,PETSC_MAX_PATH_LEN);
 62:       PetscFixFilename(tname,fname);
 63:       PetscInfo1(0,"Opening file %s\n",fname);
 64:       fd   = fopen(fname,mode);
 65:       if (!fd) SETERRQ1(PETSC_ERR_FILE_OPEN,"Unable to open file %s\n",fname);
 66:     }
 67:   } else fd = 0;
 68:   *fp = fd;
 69:   return(0);
 70: }

 74: /*@
 75:     PetscFClose - Has the first processor in the communicator close a 
 76:     file; all others do nothing.

 78:     Collective on MPI_Comm

 80:     Input Parameters:
 81: +   comm - the communicator
 82: -   fd - the file, opened with PetscFOpen()

 84:    Level: developer

 86:     Fortran Note:
 87:     This routine is not supported in Fortran.

 89:     Concepts: files^closing ASCII
 90:     Concepts: closing file

 92: .seealso: PetscFOpen()
 93: @*/
 94: PetscErrorCode  PetscFClose(MPI_Comm comm,FILE *fd)
 95: {
 97:   PetscMPIInt    rank;

100:   MPI_Comm_rank(comm,&rank);
101:   if (!rank && fd != stdout && fd != stderr) fclose(fd);
102:   return(0);
103: }

105: #if defined(PETSC_HAVE_POPEN)

109: /*@C
110:       PetscPClose - Closes (ends) a program on processor zero run with PetscPOpen()

112:      Collective on MPI_Comm, but only process 0 runs the command

114:    Input Parameters:
115: +   comm - MPI communicator, only processor zero runs the program
116: -   fp - the file pointer where program input or output may be read or PETSC_NULL if don't care

118:    Level: intermediate

120:    Notes:
121:        Does not work under Windows

123: .seealso: PetscFOpen(), PetscFClose(), PetscPOpen()

125: @*/
126: PetscErrorCode  PetscPClose(MPI_Comm comm,FILE *fd)
127: {
129:   PetscMPIInt    rank;

132:   MPI_Comm_rank(comm,&rank);
133:   if (!rank) {
134:     char buf[1024];
135:     while (fgets(buf,1024,fd)) {;} /* wait till it prints everything */
136:     pclose(fd);
137:   }
138:   return(0);
139: }


144: /*@C
145:       PetscPOpen - Runs a program on processor zero and sends either its input or output to 
146:           a file.

148:      Collective on MPI_Comm, but only process 0 runs the command

150:    Input Parameters:
151: +   comm - MPI communicator, only processor zero runs the program
152: .   machine - machine to run command on or PETSC_NULL, or string with 0 in first location
153: .   program - name of program to run
154: -   mode - either r or w

156:    Output Parameter:
157: .   fp - the file pointer where program input or output may be read or PETSC_NULL if don't care

159:    Level: intermediate

161:    Notes:
162:        Use PetscPClose() to close the file pointer when you are finished with it
163:        Does not work under Windows

165:        The program string may contain ${DISPLAY}, ${HOMEDIRECTORY} or ${WORKINGDIRECTORY}; these
166:     will be replaced with relevent values.

168: .seealso: PetscFOpen(), PetscFClose(), PetscPClose()

170: @*/
171: PetscErrorCode  PetscPOpen(MPI_Comm comm,const char machine[],const char program[],const char mode[],FILE **fp)
172: {
174:   PetscMPIInt    rank;
175:   size_t         i,len,cnt;
176:   char           commandt[PETSC_MAX_PATH_LEN],command[PETSC_MAX_PATH_LEN];
177:   FILE           *fd;


181:   /* all processors have to do the string manipulation because PetscStrreplace() is a collective operation */
182:   if (machine && machine[0]) {
183:     PetscStrcpy(command,"ssh ");
184:     PetscStrcat(command,machine);
185:     PetscStrcat(command," \" setenv DISPLAY ${DISPLAY}; ");
186:     /*
187:         Copy program into command but protect the " with a \ in front of it 
188:     */
189:     PetscStrlen(command,&cnt);
190:     PetscStrlen(program,&len);
191:     for (i=0; i<len; i++) {
192:       if (program[i] == '\"') {
193:         command[cnt++] = '\\';
194:       }
195:       command[cnt++] = program[i];
196:     }
197:     command[cnt] = 0;
198:     PetscStrcat(command,"\"");
199:   } else {
200:     PetscStrcpy(command,program);
201:   }

203:   PetscStrreplace(comm,command,commandt,1024);
204: 
205:   MPI_Comm_rank(comm,&rank);
206:   if (!rank) {
207:     PetscInfo1(0,"Running command :%s\n",commandt);
208:     if (!(fd = popen(commandt,mode))) {
209:        SETERRQ1(PETSC_ERR_LIB,"Cannot run command %s",commandt);
210:     }
211:     if (fp) *fp = fd;
212:   }
213:   return(0);
214: }

216: #endif