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 Output Parameters: 117 . rval - return value from pclose() or NULL to raise an error on failure 118 119 Level: intermediate 120 121 Notes: 122 Does not work under Windows 123 124 .seealso: PetscFOpen(), PetscFClose(), PetscPOpen() 125 126 @*/ 127 PetscErrorCode PetscPClose(MPI_Comm comm,FILE *fd,int *rval) 128 { 129 PetscErrorCode ierr; 130 PetscMPIInt rank; 131 int err; 132 133 PetscFunctionBegin; 134 ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr); 135 if (!rank) { 136 char buf[1024]; 137 while (fgets(buf,1024,fd)) ; /* wait till it prints everything */ 138 err = pclose(fd); 139 if (err == ECHILD) err = 0; /* not an error if child status is missing */ 140 if (rval) *rval = err; 141 else if (err) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_SYS,"pclose() failed with error code %d, errno %d",err,errno); 142 } 143 PetscFunctionReturn(0); 144 } 145 146 147 /*@C 148 PetscPOpen - Runs a program on processor zero and sends either its input or output to 149 a file. 150 151 Logically Collective on MPI_Comm, but only process 0 runs the command 152 153 Input Parameters: 154 + comm - MPI communicator, only processor zero runs the program 155 . machine - machine to run command on or NULL, or string with 0 in first location 156 . program - name of program to run 157 - mode - either r or w 158 159 Output Parameter: 160 . fp - the file pointer where program input or output may be read or NULL if don't care 161 162 Level: intermediate 163 164 Notes: 165 Use PetscPClose() to close the file pointer when you are finished with it 166 Does not work under Windows 167 168 If machine is not provided will use the value set with PetsPOpenSetMachine() if that was provided, otherwise 169 will use the machine running node zero of the communicator 170 171 The program string may contain ${DISPLAY}, ${HOMEDIRECTORY} or ${WORKINGDIRECTORY}; these 172 will be replaced with relevent values. 173 174 .seealso: PetscFOpen(), PetscFClose(), PetscPClose(), PetscPOpenSetMachine() 175 176 @*/ 177 PetscErrorCode PetscPOpen(MPI_Comm comm,const char machine[],const char program[],const char mode[],FILE **fp) 178 { 179 PetscErrorCode ierr; 180 PetscMPIInt rank; 181 size_t i,len,cnt; 182 char commandt[PETSC_MAX_PATH_LEN],command[PETSC_MAX_PATH_LEN]; 183 FILE *fd; 184 185 PetscFunctionBegin; 186 /* all processors have to do the string manipulation because PetscStrreplace() is a collective operation */ 187 if (PetscPOpenMachine[0] || (machine && machine[0])) { 188 ierr = PetscStrcpy(command,"ssh ");CHKERRQ(ierr); 189 if (PetscPOpenMachine[0]) { 190 ierr = PetscStrcat(command,PetscPOpenMachine);CHKERRQ(ierr); 191 } else { 192 ierr = PetscStrcat(command,machine);CHKERRQ(ierr); 193 } 194 ierr = PetscStrcat(command," \" export DISPLAY=${DISPLAY}; ");CHKERRQ(ierr); 195 /* 196 Copy program into command but protect the " with a \ in front of it 197 */ 198 ierr = PetscStrlen(command,&cnt);CHKERRQ(ierr); 199 ierr = PetscStrlen(program,&len);CHKERRQ(ierr); 200 for (i=0; i<len; i++) { 201 if (program[i] == '\"') command[cnt++] = '\\'; 202 command[cnt++] = program[i]; 203 } 204 command[cnt] = 0; 205 206 ierr = PetscStrcat(command,"\"");CHKERRQ(ierr); 207 } else { 208 ierr = PetscStrcpy(command,program);CHKERRQ(ierr); 209 } 210 211 ierr = PetscStrreplace(comm,command,commandt,1024);CHKERRQ(ierr); 212 213 ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr); 214 if (!rank) { 215 ierr = PetscInfo1(0,"Running command :%s\n",commandt);CHKERRQ(ierr); 216 if (!(fd = popen(commandt,mode))) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Cannot run command %s",commandt); 217 if (fp) *fp = fd; 218 } 219 PetscFunctionReturn(0); 220 } 221 222 /*@C 223 PetscPOpenSetMachine - Sets the name of the default machine to run PetscPOpen() calls on 224 225 Logically Collective on MPI_Comm, but only process 0 runs the command 226 227 Input Parameter: 228 . machine - machine to run command on or NULL to remove previous entry 229 230 Options Database: 231 . -popen_machine <machine> 232 233 Level: intermediate 234 235 .seealso: PetscFOpen(), PetscFClose(), PetscPClose(), PetscPOpen() 236 237 @*/ 238 PetscErrorCode PetscPOpenSetMachine(const char machine[]) 239 { 240 PetscErrorCode ierr; 241 242 PetscFunctionBegin; 243 if (machine) { 244 ierr = PetscStrcpy(PetscPOpenMachine,machine);CHKERRQ(ierr); 245 } else { 246 PetscPOpenMachine[0] = 0; 247 } 248 PetscFunctionReturn(0); 249 } 250 251 #endif 252