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