Actual source code: mpiuopen.c

petsc-3.3-p7 2013-05-11
  1: #define PETSC_DESIRE_FEATURE_TEST_MACROS /* for popen */
  2: /*
  3:       Some PETSc utilites routines to add simple parallel IO capability
  4: */
  5: #include <petscsys.h>
  6: #include <stdarg.h>
  7: #if defined(PETSC_HAVE_STDLIB_H)
  8: #include <stdlib.h>
  9: #endif

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

 17:     Logically Collective on MPI_Comm

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

 24:     Output Parameter:
 25: .   fp - the file pointer

 27:     Level: developer

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

 35:     Concepts: opening ASCII file
 36:     Concepts: files^opening ASCII

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

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

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

 76:     Logically Collective on MPI_Comm

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

 82:    Level: developer

 84:     Fortran Note:
 85:     This routine is not supported in Fortran.

 87:     Concepts: files^closing ASCII
 88:     Concepts: closing file

 90: .seealso: PetscFOpen()
 91: @*/
 92: PetscErrorCode  PetscFClose(MPI_Comm comm,FILE *fd)
 93: {
 95:   PetscMPIInt    rank;
 96:   int            err;

 99:   MPI_Comm_rank(comm,&rank);
100:   if (!rank && fd != PETSC_STDOUT && fd != PETSC_STDERR) {
101:     err = fclose(fd);
102:     if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fclose() failed on file");
103:   }
104:   return(0);
105: }

107: #if defined(PETSC_HAVE_POPEN)

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

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

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

120:    Level: intermediate

122:    Notes:
123:        Does not work under Windows

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

127: @*/
128: PetscErrorCode  PetscPClose(MPI_Comm comm,FILE *fd)
129: {
131:   PetscMPIInt    rank;
132:   int            err;

135:   MPI_Comm_rank(comm,&rank);
136:   if (!rank) {
137:     char buf[1024];
138:     while (fgets(buf,1024,fd)) {;} /* wait till it prints everything */
139:     err = pclose(fd);
140:     if (err) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SYS,"pclose() failed on process %D",err);
141:   }
142:   return(0);
143: }


148: /*@C
149:       PetscPOpen - Runs a program on processor zero and sends either its input or output to 
150:           a file.

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

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

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

163:    Level: intermediate

165:    Notes:
166:        Use PetscPClose() to close the file pointer when you are finished with it
167:        Does not work under Windows

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

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

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


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

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

220: #endif