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