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