1 #define PETSC_DESIRE_FEATURE_TEST_MACROS /* for popen() */
2 /*
3 Some PETSc utility routines to add simple parallel IO capabilities
4 */
5 #include <petscsys.h>
6 #include <petsc/private/logimpl.h>
7 #include <errno.h>
8
9 /*@C
10 PetscFOpen - Has the first process in the communicator open a file;
11 all others do nothing.
12
13 Logically Collective
14
15 Input Parameters:
16 + comm - the communicator
17 . name - the filename
18 - mode - the mode for fopen(), usually "w"
19
20 Output Parameter:
21 . fp - the file pointer
22
23 Level: developer
24
25 Notes:
26 NULL (0), "stderr" or "stdout" may be passed in as the filename
27
28 Fortran Note:
29 This routine is not supported in Fortran.
30
31
32 .seealso: PetscFClose(), PetscSynchronizedFGets(), PetscSynchronizedPrintf(), PetscSynchronizedFlush(),
33 PetscFPrintf()
34 @*/
PetscFOpen(MPI_Comm comm,const char name[],const char mode[],FILE ** fp)35 PetscErrorCode PetscFOpen(MPI_Comm comm,const char name[],const char mode[],FILE **fp)
36 {
37 PetscErrorCode ierr;
38 PetscMPIInt rank;
39 FILE *fd;
40 char fname[PETSC_MAX_PATH_LEN],tname[PETSC_MAX_PATH_LEN];
41
42 PetscFunctionBegin;
43 ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
44 if (!rank) {
45 PetscBool isstdout,isstderr;
46 ierr = PetscStrcmp(name,"stdout",&isstdout);CHKERRQ(ierr);
47 ierr = PetscStrcmp(name,"stderr",&isstderr);CHKERRQ(ierr);
48 if (isstdout || !name) fd = PETSC_STDOUT;
49 else if (isstderr) fd = PETSC_STDERR;
50 else {
51 PetscBool devnull;
52 ierr = PetscStrreplace(PETSC_COMM_SELF,name,tname,PETSC_MAX_PATH_LEN);CHKERRQ(ierr);
53 ierr = PetscFixFilename(tname,fname);CHKERRQ(ierr);
54 ierr = PetscStrbeginswith(fname,"/dev/null",&devnull);CHKERRQ(ierr);
55 if (devnull) {
56 ierr = PetscStrcpy(fname,"/dev/null");CHKERRQ(ierr);
57 }
58 ierr = PetscInfo1(0,"Opening file %s\n",fname);CHKERRQ(ierr);
59 fd = fopen(fname,mode);
60 if (!fd) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Unable to open file %s\n",fname);
61 }
62 } else fd = NULL;
63 *fp = fd;
64 PetscFunctionReturn(0);
65 }
66
67 /*@C
68 PetscFClose - Has the first processor in the communicator close a
69 file; all others do nothing.
70
71 Logically Collective
72
73 Input Parameters:
74 + comm - the communicator
75 - fd - the file, opened with PetscFOpen()
76
77 Level: developer
78
79 Fortran Note:
80 This routine is not supported in Fortran.
81
82
83 .seealso: PetscFOpen()
84 @*/
PetscFClose(MPI_Comm comm,FILE * fd)85 PetscErrorCode PetscFClose(MPI_Comm comm,FILE *fd)
86 {
87 PetscErrorCode ierr;
88 PetscMPIInt rank;
89 int err;
90
91 PetscFunctionBegin;
92 ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
93 if (!rank && fd != PETSC_STDOUT && fd != PETSC_STDERR) {
94 err = fclose(fd);
95 if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fclose() failed on file");
96 }
97 PetscFunctionReturn(0);
98 }
99
100 #if defined(PETSC_HAVE_POPEN)
101 static char PetscPOpenMachine[128] = "";
102
103 /*@C
104 PetscPClose - Closes (ends) a program on processor zero run with PetscPOpen()
105
106 Collective, but only process 0 runs the command
107
108 Input Parameters:
109 + comm - MPI communicator, only processor zero runs the program
110 - fp - the file pointer where program input or output may be read or NULL if don't care
111
112 Level: intermediate
113
114 Notes:
115 Does not work under Windows
116
117 .seealso: PetscFOpen(), PetscFClose(), PetscPOpen()
118
119 @*/
PetscPClose(MPI_Comm comm,FILE * fd)120 PetscErrorCode PetscPClose(MPI_Comm comm,FILE *fd)
121 {
122 PetscErrorCode ierr;
123 PetscMPIInt rank;
124
125 PetscFunctionBegin;
126 ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
127 if (!rank) {
128 char buf[1024];
129 while (fgets(buf,1024,fd)) ; /* wait till it prints everything */
130 (void) pclose(fd);
131 }
132 PetscFunctionReturn(0);
133 }
134
135
136 /*@C
137 PetscPOpen - Runs a program on processor zero and sends either its input or output to
138 a file.
139
140 Logically Collective, but only process 0 runs the command
141
142 Input Parameters:
143 + comm - MPI communicator, only processor zero runs the program
144 . machine - machine to run command on or NULL, or string with 0 in first location
145 . program - name of program to run
146 - mode - either r or w
147
148 Output Parameter:
149 . fp - the file pointer where program input or output may be read or NULL if don't care
150
151 Level: intermediate
152
153 Notes:
154 Use PetscPClose() to close the file pointer when you are finished with it
155 Does not work under Windows
156
157 If machine is not provided will use the value set with PetsPOpenSetMachine() if that was provided, otherwise
158 will use the machine running node zero of the communicator
159
160 The program string may contain ${DISPLAY}, ${HOMEDIRECTORY} or ${WORKINGDIRECTORY}; these
161 will be replaced with relevent values.
162
163 .seealso: PetscFOpen(), PetscFClose(), PetscPClose(), PetscPOpenSetMachine()
164
165 @*/
PetscPOpen(MPI_Comm comm,const char machine[],const char program[],const char mode[],FILE ** fp)166 PetscErrorCode PetscPOpen(MPI_Comm comm,const char machine[],const char program[],const char mode[],FILE **fp)
167 {
168 PetscErrorCode ierr;
169 PetscMPIInt rank;
170 size_t i,len,cnt;
171 char commandt[PETSC_MAX_PATH_LEN],command[PETSC_MAX_PATH_LEN];
172 FILE *fd;
173
174 PetscFunctionBegin;
175 /* all processors have to do the string manipulation because PetscStrreplace() is a collective operation */
176 if (PetscPOpenMachine[0] || (machine && machine[0])) {
177 ierr = PetscStrcpy(command,"ssh ");CHKERRQ(ierr);
178 if (PetscPOpenMachine[0]) {
179 ierr = PetscStrcat(command,PetscPOpenMachine);CHKERRQ(ierr);
180 } else {
181 ierr = PetscStrcat(command,machine);CHKERRQ(ierr);
182 }
183 ierr = PetscStrcat(command," \" export DISPLAY=${DISPLAY}; ");CHKERRQ(ierr);
184 /*
185 Copy program into command but protect the " with a \ in front of it
186 */
187 ierr = PetscStrlen(command,&cnt);CHKERRQ(ierr);
188 ierr = PetscStrlen(program,&len);CHKERRQ(ierr);
189 for (i=0; i<len; i++) {
190 if (program[i] == '\"') command[cnt++] = '\\';
191 command[cnt++] = program[i];
192 }
193 command[cnt] = 0;
194
195 ierr = PetscStrcat(command,"\"");CHKERRQ(ierr);
196 } else {
197 ierr = PetscStrcpy(command,program);CHKERRQ(ierr);
198 }
199
200 ierr = PetscStrreplace(comm,command,commandt,1024);CHKERRQ(ierr);
201
202 ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
203 if (!rank) {
204 ierr = PetscInfo1(NULL,"Running command :%s\n",commandt);CHKERRQ(ierr);
205 if (!(fd = popen(commandt,mode))) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Cannot run command %s",commandt);
206 if (fp) *fp = fd;
207 }
208 PetscFunctionReturn(0);
209 }
210
211 /*@C
212 PetscPOpenSetMachine - Sets the name of the default machine to run PetscPOpen() calls on
213
214 Logically Collective, but only process 0 runs the command
215
216 Input Parameter:
217 . machine - machine to run command on or NULL to remove previous entry
218
219 Options Database:
220 . -popen_machine <machine>
221
222 Level: intermediate
223
224 .seealso: PetscFOpen(), PetscFClose(), PetscPClose(), PetscPOpen()
225
226 @*/
PetscPOpenSetMachine(const char machine[])227 PetscErrorCode PetscPOpenSetMachine(const char machine[])
228 {
229 PetscErrorCode ierr;
230
231 PetscFunctionBegin;
232 if (machine) {
233 ierr = PetscStrcpy(PetscPOpenMachine,machine);CHKERRQ(ierr);
234 } else {
235 PetscPOpenMachine[0] = 0;
236 }
237 PetscFunctionReturn(0);
238 }
239
240 #endif
241