Actual source code: sysio.c

  1: #include <petscsys.h>
  2: #include <petscbt.h>
  3: #include <errno.h>
  4: #include <fcntl.h>
  5: #if defined(PETSC_HAVE_UNISTD_H)
  6:   #include <unistd.h>
  7: #endif
  8: #if defined(PETSC_HAVE_IO_H)
  9:   #include <io.h>
 10: #endif
 11: #if !defined(PETSC_HAVE_O_BINARY)
 12:   #define O_BINARY 0
 13: #endif

 15: const char *const PetscFileModes[] = {"READ", "WRITE", "APPEND", "UPDATE", "APPEND_UPDATE", "PetscFileMode", "PETSC_FILE_", NULL};

 17: /*
 18:   PetscByteSwapEnum - Swap bytes in a  PETSc Enum

 20: */
 21: static PetscErrorCode PetscByteSwapEnum(PetscEnum *buff, PetscCount n)
 22: {
 23:   PetscCount i, j;
 24:   PetscEnum  tmp = ENUM_DUMMY;
 25:   char      *ptr1, *ptr2 = (char *)&tmp;

 27:   PetscFunctionBegin;
 28:   for (j = 0; j < n; j++) {
 29:     ptr1 = (char *)(buff + j);
 30:     for (i = 0; i < (PetscCount)sizeof(PetscEnum); i++) ptr2[i] = ptr1[sizeof(PetscEnum) - 1 - i];
 31:     for (i = 0; i < (PetscCount)sizeof(PetscEnum); i++) ptr1[i] = ptr2[i];
 32:   }
 33:   PetscFunctionReturn(PETSC_SUCCESS);
 34: }

 36: /*
 37:   PetscByteSwapBool - Swap bytes in a  PETSc Bool

 39: */
 40: static PetscErrorCode PetscByteSwapBool(PetscBool *buff, PetscCount n)
 41: {
 42:   PetscCount i, j;
 43:   PetscBool  tmp = PETSC_FALSE;
 44:   char      *ptr1, *ptr2 = (char *)&tmp;

 46:   PetscFunctionBegin;
 47:   for (j = 0; j < n; j++) {
 48:     ptr1 = (char *)(buff + j);
 49:     for (i = 0; i < (PetscCount)sizeof(PetscBool); i++) ptr2[i] = ptr1[sizeof(PetscBool) - 1 - i];
 50:     for (i = 0; i < (PetscCount)sizeof(PetscBool); i++) ptr1[i] = ptr2[i];
 51:   }
 52:   PetscFunctionReturn(PETSC_SUCCESS);
 53: }

 55: /*
 56:   PetscByteSwapInt - Swap bytes in a  PETSc integer (which may be 32 or 64-bits)

 58: */
 59: static PetscErrorCode PetscByteSwapInt(PetscInt *buff, PetscCount n)
 60: {
 61:   PetscCount i, j;
 62:   PetscInt   tmp = 0;
 63:   char      *ptr1, *ptr2 = (char *)&tmp;

 65:   PetscFunctionBegin;
 66:   for (j = 0; j < n; j++) {
 67:     ptr1 = (char *)(buff + j);
 68:     for (i = 0; i < (PetscCount)sizeof(PetscInt); i++) ptr2[i] = ptr1[sizeof(PetscInt) - 1 - i];
 69:     for (i = 0; i < (PetscCount)sizeof(PetscInt); i++) ptr1[i] = ptr2[i];
 70:   }
 71:   PetscFunctionReturn(PETSC_SUCCESS);
 72: }

 74: /*
 75:   PetscByteSwapInt64 - Swap bytes in a  PETSc integer (64-bits)

 77: */
 78: static PetscErrorCode PetscByteSwapInt64(PetscInt64 *buff, PetscCount n)
 79: {
 80:   PetscCount i, j;
 81:   PetscInt64 tmp = 0;
 82:   char      *ptr1, *ptr2 = (char *)&tmp;

 84:   PetscFunctionBegin;
 85:   for (j = 0; j < n; j++) {
 86:     ptr1 = (char *)(buff + j);
 87:     for (i = 0; i < (PetscCount)sizeof(PetscInt64); i++) ptr2[i] = ptr1[sizeof(PetscInt64) - 1 - i];
 88:     for (i = 0; i < (PetscCount)sizeof(PetscInt64); i++) ptr1[i] = ptr2[i];
 89:   }
 90:   PetscFunctionReturn(PETSC_SUCCESS);
 91: }

 93: /*
 94:   PetscByteSwapInt32 - Swap bytes in a  PETSc integer (32-bits)

 96: */
 97: static PetscErrorCode PetscByteSwapInt32(PetscInt32 *buff, PetscCount n)
 98: {
 99:   PetscCount i, j;
100:   PetscInt32 tmp = 0;
101:   char      *ptr1, *ptr2 = (char *)&tmp;

103:   PetscFunctionBegin;
104:   for (j = 0; j < n; j++) {
105:     ptr1 = (char *)(buff + j);
106:     for (i = 0; i < (PetscCount)sizeof(PetscInt32); i++) ptr2[i] = ptr1[sizeof(PetscInt32) - 1 - i];
107:     for (i = 0; i < (PetscCount)sizeof(PetscInt32); i++) ptr1[i] = ptr2[i];
108:   }
109:   PetscFunctionReturn(PETSC_SUCCESS);
110: }

112: /*
113:   PetscByteSwapShort - Swap bytes in a short
114: */
115: static PetscErrorCode PetscByteSwapShort(short *buff, PetscCount n)
116: {
117:   PetscCount i, j;
118:   short      tmp;
119:   char      *ptr1, *ptr2 = (char *)&tmp;

121:   PetscFunctionBegin;
122:   for (j = 0; j < n; j++) {
123:     ptr1 = (char *)(buff + j);
124:     for (i = 0; i < (PetscCount)sizeof(short); i++) ptr2[i] = ptr1[sizeof(short) - 1 - i];
125:     for (i = 0; i < (PetscCount)sizeof(short); i++) ptr1[i] = ptr2[i];
126:   }
127:   PetscFunctionReturn(PETSC_SUCCESS);
128: }
129: /*
130:   PetscByteSwapLong - Swap bytes in a long
131: */
132: static PetscErrorCode PetscByteSwapLong(long *buff, PetscCount n)
133: {
134:   PetscCount i, j;
135:   long       tmp;
136:   char      *ptr1, *ptr2 = (char *)&tmp;

138:   PetscFunctionBegin;
139:   for (j = 0; j < n; j++) {
140:     ptr1 = (char *)(buff + j);
141:     for (i = 0; i < (PetscCount)sizeof(long); i++) ptr2[i] = ptr1[sizeof(long) - 1 - i];
142:     for (i = 0; i < (PetscCount)sizeof(long); i++) ptr1[i] = ptr2[i];
143:   }
144:   PetscFunctionReturn(PETSC_SUCCESS);
145: }

147: /*
148:   PetscByteSwapReal - Swap bytes in a PetscReal
149: */
150: static PetscErrorCode PetscByteSwapReal(PetscReal *buff, PetscCount n)
151: {
152:   PetscCount i, j;
153:   PetscReal  tmp, *buff1 = buff;
154:   char      *ptr1, *ptr2 = (char *)&tmp;

156:   PetscFunctionBegin;
157:   for (j = 0; j < n; j++) {
158:     ptr1 = (char *)(buff1 + j);
159:     for (i = 0; i < (PetscCount)sizeof(PetscReal); i++) ptr2[i] = ptr1[sizeof(PetscReal) - 1 - i];
160:     for (i = 0; i < (PetscCount)sizeof(PetscReal); i++) ptr1[i] = ptr2[i];
161:   }
162:   PetscFunctionReturn(PETSC_SUCCESS);
163: }

165: /*
166:   PetscByteSwapScalar - Swap bytes in a PetscScalar
167:   The complex case is dealt with an array of PetscReal, twice as long.
168: */
169: static PetscErrorCode PetscByteSwapScalar(PetscScalar *buff, PetscCount n)
170: {
171:   PetscCount i, j;
172: #if defined(PETSC_USE_COMPLEX)
173:   PetscReal tmp, *buff1 = (PetscReal *)buff;
174: #else
175:   PetscReal tmp, *buff1 = buff;
176: #endif
177:   char *ptr1, *ptr2 = (char *)&tmp;

179:   PetscFunctionBegin;
180: #if defined(PETSC_USE_COMPLEX)
181:   n *= 2;
182: #endif
183:   for (j = 0; j < n; j++) {
184:     ptr1 = (char *)(buff1 + j);
185:     for (i = 0; i < (PetscCount)sizeof(PetscReal); i++) ptr2[i] = ptr1[sizeof(PetscReal) - 1 - i];
186:     for (i = 0; i < (PetscCount)sizeof(PetscReal); i++) ptr1[i] = ptr2[i];
187:   }
188:   PetscFunctionReturn(PETSC_SUCCESS);
189: }

191: /*
192:   PetscByteSwapDouble - Swap bytes in a double
193: */
194: static PetscErrorCode PetscByteSwapDouble(double *buff, PetscCount n)
195: {
196:   PetscCount i, j;
197:   double     tmp, *buff1 = buff;
198:   char      *ptr1, *ptr2 = (char *)&tmp;

200:   PetscFunctionBegin;
201:   for (j = 0; j < n; j++) {
202:     ptr1 = (char *)(buff1 + j);
203:     for (i = 0; i < (PetscCount)sizeof(double); i++) ptr2[i] = ptr1[sizeof(double) - 1 - i];
204:     for (i = 0; i < (PetscCount)sizeof(double); i++) ptr1[i] = ptr2[i];
205:   }
206:   PetscFunctionReturn(PETSC_SUCCESS);
207: }

209: /*
210:   PetscByteSwapFloat - Swap bytes in a float
211: */
212: static PetscErrorCode PetscByteSwapFloat(float *buff, PetscCount n)
213: {
214:   PetscCount i, j;
215:   float      tmp, *buff1 = buff;
216:   char      *ptr1, *ptr2 = (char *)&tmp;

218:   PetscFunctionBegin;
219:   for (j = 0; j < n; j++) {
220:     ptr1 = (char *)(buff1 + j);
221:     for (i = 0; i < (PetscCount)sizeof(float); i++) ptr2[i] = ptr1[sizeof(float) - 1 - i];
222:     for (i = 0; i < (PetscCount)sizeof(float); i++) ptr1[i] = ptr2[i];
223:   }
224:   PetscFunctionReturn(PETSC_SUCCESS);
225: }

227: /*@C
228:   PetscByteSwap - Reverse the byte order of an array of values of a given `PetscDataType`, in place

230:   Not Collective; No Fortran Support

232:   Input Parameters:
233: + data   - the array of values to byte-swap in place
234: . pdtype - the `PetscDataType` of the values (e.g. `PETSC_INT`, `PETSC_REAL`, `PETSC_SCALAR`)
235: - count  - number of values in `data`

237:   Level: developer

239:   Note:
240:   Used by binary I/O routines to convert between little-endian and big-endian representations.

242: .seealso: `PetscDataType`, `PetscViewerBinaryRead()`, `PetscViewerBinaryWrite()`
243: @*/
244: PetscErrorCode PetscByteSwap(void *data, PetscDataType pdtype, PetscCount count)
245: {
246:   PetscFunctionBegin;
247:   if (pdtype == PETSC_INT) PetscCall(PetscByteSwapInt((PetscInt *)data, count));
248:   else if (pdtype == PETSC_ENUM) PetscCall(PetscByteSwapEnum((PetscEnum *)data, count));
249:   else if (pdtype == PETSC_BOOL) PetscCall(PetscByteSwapBool((PetscBool *)data, count));
250:   else if (pdtype == PETSC_SCALAR) PetscCall(PetscByteSwapScalar((PetscScalar *)data, count));
251:   else if (pdtype == PETSC_REAL) PetscCall(PetscByteSwapReal((PetscReal *)data, count));
252:   else if (pdtype == PETSC_COMPLEX) PetscCall(PetscByteSwapReal((PetscReal *)data, 2 * count));
253:   else if (pdtype == PETSC_INT64) PetscCall(PetscByteSwapInt64((PetscInt64 *)data, count));
254:   else if (pdtype == PETSC_COUNT) PetscCall(PetscByteSwapInt64((PetscInt64 *)data, count));
255:   else if (pdtype == PETSC_INT32) PetscCall(PetscByteSwapInt32((PetscInt32 *)data, count));
256:   else if (pdtype == PETSC_DOUBLE) PetscCall(PetscByteSwapDouble((double *)data, count));
257:   else if (pdtype == PETSC_FLOAT) PetscCall(PetscByteSwapFloat((float *)data, count));
258:   else if (pdtype == PETSC_SHORT) PetscCall(PetscByteSwapShort((short *)data, count));
259:   else if (pdtype == PETSC_LONG) PetscCall(PetscByteSwapLong((long *)data, count));
260:   else if (pdtype == PETSC_CHAR) PetscFunctionReturn(PETSC_SUCCESS);
261:   else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Unknown type: %d", pdtype);
262:   PetscFunctionReturn(PETSC_SUCCESS);
263: }

265: /*@C
266:   PetscBinaryRead - Reads from a binary file.

268:   Not Collective

270:   Input Parameters:
271: + fd   - the file descriptor
272: . num  - the maximum number of items to read
273: - type - the type of items to read (`PETSC_INT`, `PETSC_REAL`, `PETSC_SCALAR`, etc.)

275:   Output Parameters:
276: + data  - the buffer, this is an array of the type that matches the value in `type`
277: - count - the number of items read, optional

279:   Level: developer

281:   Notes:
282:   If `count` is not provided and the number of items read is less than
283:   the maximum number of items to read, then this routine errors.

285:   `PetscBinaryRead()` uses byte swapping to work on all machines; the files
286:   are written ALWAYS using big-endian ordering. On little-endian machines the numbers
287:   are converted to the little-endian format when they are read in from the file.
288:   When PETSc is ./configure with `--with-64-bit-indices` the integers are written to the
289:   file as 64-bit integers, this means they can only be read back in when the option `--with-64-bit-indices`
290:   is used.

292:   Fortran Note:
293:   There are different functions for each datatype, for example `PetscBinaryReadInt()`

295: .seealso: `PetscBinaryWrite()`, `PetscBinaryOpen()`, `PetscBinaryClose()`, `PetscViewerBinaryGetDescriptor()`, `PetscBinarySynchronizedWrite()`,
296:           `PetscBinarySynchronizedRead()`, `PetscBinarySynchronizedSeek()`
297: @*/
298: PetscErrorCode PetscBinaryRead(int fd, void *data, PetscCount num, PetscInt *count, PetscDataType type)
299: {
300:   size_t typesize, m = (size_t)num, n = 0, maxblock = 65536;
301:   char  *p = (char *)data;
302: #if defined(PETSC_USE_REAL___FLOAT128)
303:   PetscBool readdouble = PETSC_FALSE;
304:   double   *pdouble;
305: #endif
306:   void *ptmp  = data;
307:   char *fname = NULL;

309:   PetscFunctionBegin;
310:   if (count) *count = 0;
311:   PetscCheck(num >= 0, PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Trying to read a negative amount of data %" PetscCount_FMT, num);
312:   if (!num) PetscFunctionReturn(PETSC_SUCCESS);

314:   if (type == PETSC_FUNCTION) {
315:     m     = 64;
316:     type  = PETSC_CHAR;
317:     fname = (char *)malloc(m * sizeof(char));
318:     p     = fname;
319:     ptmp  = (void *)fname;
320:     PetscCheck(fname, PETSC_COMM_SELF, PETSC_ERR_MEM, "Cannot allocate space for function name");
321:   }
322:   if (type == PETSC_BIT_LOGICAL) m = PetscBTLength(num);

324:   PetscCall(PetscDataTypeGetSize(type, &typesize));

326: #if defined(PETSC_USE_REAL___FLOAT128)
327:   PetscCall(PetscOptionsGetBool(NULL, NULL, "-binary_read_double", &readdouble, NULL));
328:   /* If using __float128 precision we still read in doubles from file */
329:   if ((type == PETSC_REAL || type == PETSC_COMPLEX) && readdouble) {
330:     PetscInt cnt = num * ((type == PETSC_REAL) ? 1 : 2);
331:     PetscCall(PetscMalloc1(cnt, &pdouble));
332:     p = (char *)pdouble;
333:     typesize /= 2;
334:   }
335: #endif

337:   m *= typesize;

339:   while (m) {
340:     size_t len = (m < maxblock) ? m : maxblock;
341:     int    ret = (int)read(fd, p, len);
342:     if (ret < 0 && errno == EINTR) continue;
343:     if (!ret && len > 0) break; /* Proxy for EOF */
344:     PetscCheck(ret >= 0, PETSC_COMM_SELF, PETSC_ERR_FILE_READ, "Error reading from file due to \"%s\"", strerror(errno));
345:     m -= (size_t)ret;
346:     p += ret;
347:     n += (size_t)ret;
348:   }
349:   PetscCheck(!m || count, PETSC_COMM_SELF, PETSC_ERR_FILE_READ, "Read past end of file");

351:   num = n / typesize;                             /* Should we require `n % typesize == 0` ? */
352:   if (count) PetscCall(PetscIntCast(num, count)); /* TODO: This is most likely wrong for PETSC_BIT_LOGICAL */

354: #if defined(PETSC_USE_REAL___FLOAT128)
355:   if ((type == PETSC_REAL || type == PETSC_COMPLEX) && readdouble) {
356:     PetscInt   i, cnt = num * ((type == PETSC_REAL) ? 1 : 2);
357:     PetscReal *preal = (PetscReal *)data;
358:     if (!PetscBinaryBigEndian()) PetscCall(PetscByteSwapDouble(pdouble, cnt));
359:     for (i = 0; i < cnt; i++) preal[i] = pdouble[i];
360:     PetscCall(PetscFree(pdouble));
361:     PetscFunctionReturn(PETSC_SUCCESS);
362:   }
363: #endif

365:   if (!PetscBinaryBigEndian()) PetscCall(PetscByteSwap(ptmp, type, num));

367:   if (type == PETSC_FUNCTION) {
368: #if defined(PETSC_SERIALIZE_FUNCTIONS)
369:     PetscCall(PetscDLSym(NULL, fname, (void **)data));
370: #else
371:     *(void **)data = NULL;
372: #endif
373:     free(fname);
374:   }
375:   PetscFunctionReturn(PETSC_SUCCESS);
376: }

378: /*@C
379:   PetscBinaryWrite - Writes to a binary file.

381:   Not Collective

383:   Input Parameters:
384: + fd   - the file
385: . p    - the buffer, an array of the type that matches the value in `type`
386: . n    - the number of items to write
387: - type - the type of items to read (`PETSC_INT`, `PETSC_REAL` or `PETSC_SCALAR`)

389:   Level: advanced

391:   Notes:
392:   `PetscBinaryWrite()` uses byte swapping to work on all machines; the files
393:   are written using big-endian ordering to the file. On little-endian machines the numbers
394:   are converted to the big-endian format when they are written to disk.
395:   When PETSc is configured using `./configure with --with-64-bit-indices` the integers are written to the
396:   file as 64-bit integers, this means they can only be read back in when the option `--with-64-bit-indices`
397:   is used.

399:   If running with `__float128` precision the output of `PETSC_REAL` is in `__float128` unless one uses the `-binary_write_double` option

401:   The buffer `p` should be read-write buffer, and not static data.
402:   This way, byte-swapping is done in-place, and then the buffer is
403:   written to the file.

405:   This routine restores the original contents of the buffer, after
406:   it is written to the file. This is done by byte-swapping in-place
407:   the second time.

409:   Because byte-swapping may be done on the values in data it cannot be declared const

411:   Fortran Note:
412:   There are different functions for each datatype, for example `PetscBinaryWriteInt()`

414: .seealso: `PetscBinaryRead()`, `PetscBinaryOpen()`, `PetscBinaryClose()`, `PetscViewerBinaryGetDescriptor()`, `PetscBinarySynchronizedWrite()`,
415:           `PetscBinarySynchronizedRead()`, `PetscBinarySynchronizedSeek()`
416: @*/
417: PetscErrorCode PetscBinaryWrite(int fd, const void *p, PetscCount n, PetscDataType type)
418: {
419:   const char  *pp = (char *)p;
420:   size_t       err, m = (size_t)n, wsize;
421:   const size_t maxblock = 65536;
422:   const void  *ptmp     = p;
423:   char        *fname    = NULL;
424: #if defined(PETSC_USE_REAL___FLOAT128)
425:   PetscBool  writedouble = PETSC_FALSE;
426:   double    *ppp;
427:   PetscReal *pv;
428: #endif
429:   PetscDataType wtype = type;

431:   PetscFunctionBegin;
432:   PetscCheck(n >= 0, PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Trying to write a negative amount of data %" PetscCount_FMT, n);
433:   if (!n) PetscFunctionReturn(PETSC_SUCCESS);

435:   if (type == PETSC_FUNCTION) {
436: #if defined(PETSC_SERIALIZE_FUNCTIONS)
437:     const char *fnametmp;
438: #endif
439:     m     = 64;
440:     fname = (char *)malloc(m * sizeof(char));
441:     PetscCheck(fname, PETSC_COMM_SELF, PETSC_ERR_MEM, "Cannot allocate space for function name");
442: #if defined(PETSC_SERIALIZE_FUNCTIONS)
443:     PetscCheck(n <= 1, PETSC_COMM_SELF, PETSC_ERR_SUP, "Can only binary view a single function at a time");
444:     PetscCall(PetscFPTFind(*(void **)p, &fnametmp));
445:     PetscCall(PetscStrncpy(fname, fnametmp, m));
446: #else
447:     PetscCall(PetscStrncpy(fname, "", m));
448: #endif
449:     wtype = PETSC_CHAR;
450:     pp    = fname;
451:     ptmp  = (void *)fname;
452:   }

454: #if defined(PETSC_USE_REAL___FLOAT128)
455:   PetscCall(PetscOptionsGetBool(NULL, NULL, "-binary_write_double", &writedouble, NULL));
456:   /* If using __float128 precision we still write in doubles to file */
457:   if ((type == PETSC_SCALAR || type == PETSC_REAL || type == PETSC_COMPLEX) && writedouble) {
458:     wtype = PETSC_DOUBLE;
459:     PetscCall(PetscMalloc1(n, &ppp));
460:     pv = (PetscReal *)pp;
461:     for (PetscCount i = 0; i < n; i++) ppp[i] = (double)pv[i];
462:     pp   = (char *)ppp;
463:     ptmp = (char *)ppp;
464:   }
465: #endif

467:   if (wtype == PETSC_INT) m *= sizeof(PetscInt);
468:   else if (wtype == PETSC_SCALAR) m *= sizeof(PetscScalar);
469: #if defined(PETSC_HAVE_COMPLEX)
470:   else if (wtype == PETSC_COMPLEX) m *= sizeof(PetscComplex);
471: #endif
472:   else if (wtype == PETSC_REAL) m *= sizeof(PetscReal);
473:   else if (wtype == PETSC_DOUBLE) m *= sizeof(double);
474:   else if (wtype == PETSC_FLOAT) m *= sizeof(float);
475:   else if (wtype == PETSC_SHORT) m *= sizeof(short);
476:   else if (wtype == PETSC_LONG) m *= sizeof(long);
477:   else if (wtype == PETSC_CHAR) m *= sizeof(char);
478:   else if (wtype == PETSC_ENUM) m *= sizeof(PetscEnum);
479:   else if (wtype == PETSC_BOOL) m *= sizeof(PetscBool);
480:   else if (wtype == PETSC_INT64) m *= sizeof(PetscInt64);
481:   else if (wtype == PETSC_INT32) m *= sizeof(PetscInt32);
482:   else if (wtype == PETSC_BIT_LOGICAL) m = PetscBTLength(m) * sizeof(char);
483:   else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Unknown type: %d", wtype);

485:   if (!PetscBinaryBigEndian()) PetscCall(PetscByteSwap((void *)ptmp, wtype, n));

487:   while (m) {
488:     wsize = (m < maxblock) ? m : maxblock;
489:     err   = (size_t)write(fd, pp, wsize);
490:     if (errno == EINTR) continue;
491:     PetscCheck(err == wsize, PETSC_COMM_SELF, PETSC_ERR_FILE_WRITE, "Error writing to file total size %d err %d wsize %d due to \"%s\"", (int)n, (int)err, (int)wsize, strerror(errno));
492:     m -= wsize;
493:     pp += wsize;
494:   }

496:   if (!PetscBinaryBigEndian()) PetscCall(PetscByteSwap((void *)ptmp, wtype, n));

498:   if (type == PETSC_FUNCTION) free(fname);
499: #if defined(PETSC_USE_REAL___FLOAT128)
500:   if ((type == PETSC_SCALAR || type == PETSC_REAL || type == PETSC_COMPLEX) && writedouble) PetscCall(PetscFree(ppp));
501: #endif
502:   PetscFunctionReturn(PETSC_SUCCESS);
503: }

505: /*@
506:   PetscBinaryOpen - Opens a PETSc binary file.

508:   Not Collective

510:   Input Parameters:
511: + name - filename
512: - mode - open mode of binary file, one of `FILE_MODE_READ`, `FILE_MODE_WRITE`, `FILE_MODE_APPEND`

514:   Output Parameter:
515: . fd - the file

517:   Level: advanced

519: .seealso: `PetscBinaryRead()`, `PetscBinaryWrite()`, `PetscFileMode`, `PetscViewerFileSetMode()`, `PetscViewerBinaryGetDescriptor()`,
520:           `PetscBinarySynchronizedWrite()`, `PetscBinarySynchronizedRead()`, `PetscBinarySynchronizedSeek()`
521: @*/
522: PetscErrorCode PetscBinaryOpen(const char name[], PetscFileMode mode, int *fd)
523: {
524:   PetscFunctionBegin;
525:   switch (mode) {
526:   case FILE_MODE_READ:
527:     *fd = open(name, O_BINARY | O_RDONLY, 0);
528:     break;
529:   case FILE_MODE_WRITE:
530:     *fd = open(name, O_BINARY | O_WRONLY | O_CREAT | O_TRUNC, 0666);
531:     break;
532:   case FILE_MODE_APPEND:
533:     *fd = open(name, O_BINARY | O_WRONLY | O_APPEND, 0);
534:     break;
535:   default:
536:     SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "Unsupported file mode %s", PetscFileModes[mode]);
537:   }
538:   PetscCheck(*fd != -1, PETSC_COMM_SELF, PETSC_ERR_FILE_OPEN, "Cannot open file %s for %s due to \"%s\"", name, PetscFileModes[mode], strerror(errno));
539:   PetscFunctionReturn(PETSC_SUCCESS);
540: }

542: /*@
543:   PetscBinaryClose - Closes a PETSc binary file.

545:   Not Collective

547:   Output Parameter:
548: . fd - the file

550:   Level: advanced

552: .seealso: `PetscBinaryRead()`, `PetscBinaryWrite()`, `PetscBinaryOpen()`, `PetscBinarySynchronizedWrite()`, `PetscBinarySynchronizedRead()`,
553:           `PetscBinarySynchronizedSeek()`
554: @*/
555: PetscErrorCode PetscBinaryClose(int fd)
556: {
557:   PetscFunctionBegin;
558:   PetscCheck(!close(fd), PETSC_COMM_SELF, PETSC_ERR_SYS, "close() failed on file descriptor");
559:   PetscFunctionReturn(PETSC_SUCCESS);
560: }

562: /*@C
563:   PetscBinarySeek - Moves the file pointer on a PETSc binary file.

565:   Not Collective, No Fortran Support

567:   Input Parameters:
568: + fd     - the file
569: . off    - number of bytes to move. Use `PETSC_BINARY_INT_SIZE`, `PETSC_BINARY_SCALAR_SIZE`,
570:            etc. in your calculation rather than `sizeof()` to compute byte lengths.
571: - whence - see `PetscBinarySeekType` for possible values

573:   Output Parameter:
574: . offset - new offset in file

576:   Level: developer

578: .seealso: `PetscBinaryRead()`, `PetscBinarySeekType`, `PetscBinaryWrite()`, `PetscBinaryOpen()`, `PetscBinarySynchronizedWrite()`, `PetscBinarySynchronizedRead()`,
579:           `PetscBinarySynchronizedSeek()`
580: @*/
581: PetscErrorCode PetscBinarySeek(int fd, off_t off, PetscBinarySeekType whence, off_t *offset)
582: {
583:   int iwhence = 0;

585:   PetscFunctionBegin;
586:   if (whence == PETSC_BINARY_SEEK_SET) iwhence = SEEK_SET;
587:   else if (whence == PETSC_BINARY_SEEK_CUR) iwhence = SEEK_CUR;
588:   else if (whence == PETSC_BINARY_SEEK_END) iwhence = SEEK_END;
589:   else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Unknown seek location");
590: #if defined(PETSC_HAVE_LSEEK)
591:   *offset = lseek(fd, off, iwhence);
592: #elif defined(PETSC_HAVE__LSEEK)
593:   *offset = _lseek(fd, (long)off, iwhence);
594: #else
595:   SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP_SYS, "System does not have a way of seeking on a file");
596: #endif
597:   PetscFunctionReturn(PETSC_SUCCESS);
598: }

600: /*@C
601:   PetscBinarySynchronizedRead - Reads from a binary file, all MPI processes get the same values

603:   Collective, No Fortran Support

605:   Input Parameters:
606: + comm - the MPI communicator
607: . fd   - the file descriptor
608: . num  - the maximum number of items to read
609: - type - the type of items to read (`PETSC_INT`, `PETSC_REAL`, `PETSC_SCALAR`, etc.)

611:   Output Parameters:
612: + data  - the buffer, an array of the type that matches the value in `type`
613: - count - the number of items read, optional

615:   Level: developer

617:   Notes:
618:   Does a `PetscBinaryRead()` followed by an `MPI_Bcast()`

620:   If `count` is not provided and the number of items read is less than
621:   the maximum number of items to read, then this routine errors.

623:   `PetscBinarySynchronizedRead()` uses byte swapping to work on all machines.
624:   The files  are written using big-endian ordering to the file. On little-endian machines the numbers
625:   are converted to the big-endian format when they are written to disk.
626:   When PETSc is configured using `./configure with --with-64-bit-indices` the integers are written to the
627:   file as 64-bit integers, this means they can only be read back in when the option `--with-64-bit-indices`
628:   is used.

630: .seealso: `PetscBinaryWrite()`, `PetscBinaryOpen()`, `PetscBinaryClose()`, `PetscBinaryRead()`, `PetscBinarySynchronizedWrite()`,
631:           `PetscBinarySynchronizedSeek()`
632: @*/
633: PetscErrorCode PetscBinarySynchronizedRead(MPI_Comm comm, int fd, void *data, PetscInt num, PetscInt *count, PetscDataType type)
634: {
635:   PetscMPIInt  rank, size;
636:   MPI_Datatype mtype;
637:   PetscInt     ibuf[2] = {0, 0};
638:   char        *fname   = NULL;
639:   void        *fptr    = NULL;

641:   PetscFunctionBegin;
642:   if (type == PETSC_FUNCTION) {
643:     num   = 64;
644:     type  = PETSC_CHAR;
645:     fname = (char *)malloc(num * sizeof(char));
646:     fptr  = data;
647:     data  = (void *)fname;
648:     PetscCheck(fname, PETSC_COMM_SELF, PETSC_ERR_MEM, "Cannot allocate space for function name");
649:   }

651:   PetscCallMPI(MPI_Comm_rank(comm, &rank));
652:   PetscCallMPI(MPI_Comm_size(comm, &size));
653:   if (rank == 0) ibuf[0] = (PetscInt)PetscBinaryRead(fd, data, num, count ? &ibuf[1] : NULL, type);
654:   PetscCallMPI(MPI_Bcast(ibuf, 2, MPIU_INT, 0, comm));
655:   PetscCall((PetscErrorCode)ibuf[0]);

657:   /* skip MPI call on potentially huge amounts of data when running with one process; this allows the amount of data to basically unlimited in that case */
658:   if (size > 1) {
659:     PetscMPIInt cnt;

661:     PetscCall(PetscMPIIntCast(count ? ibuf[1] : num, &cnt));
662:     PetscCall(PetscDataTypeToMPIDataType(type, &mtype));
663:     PetscCallMPI(MPI_Bcast(data, cnt, mtype, 0, comm));
664:   }
665:   if (count) *count = ibuf[1];

667:   if (type == PETSC_FUNCTION) {
668: #if defined(PETSC_SERIALIZE_FUNCTIONS)
669:     PetscCall(PetscDLLibrarySym(PETSC_COMM_SELF, &PetscDLLibrariesLoaded, NULL, fname, (void **)fptr));
670: #else
671:     *(void **)fptr = NULL;
672: #endif
673:     free(fname);
674:   }
675:   PetscFunctionReturn(PETSC_SUCCESS);
676: }

678: /*@C
679:   PetscBinarySynchronizedWrite - writes to a binary file.

681:   Collective, No Fortran Support

683:   Input Parameters:
684: + comm - the MPI communicator
685: . fd   - the file
686: . n    - the number of items to write
687: . p    - the buffer, an array of the type that matches the value in `type`
688: - type - the type of items to write (`PETSC_INT`, `PETSC_REAL` or `PETSC_SCALAR`)

690:   Level: developer

692:   Notes:
693:   MPI rank 0 does a `PetscBinaryWrite()` the values on other MPI processes are not used

695:   The files  are written using big-endian ordering to the file. On little-endian machines the numbers
696:   are converted to the big-endian format when they are written to disk.
697:   When PETSc is configured using `./configure with --with-64-bit-indices` the integers are written to the
698:   file as 64-bit integers, this means they can only be read back in when the option `--with-64-bit-indices`
699:   is used.

701:   Because byte-swapping may be done on the values in data it cannot be declared const

703:   This is NOT like `PetscSynchronizedFPrintf()`! This routine ignores calls on all but MPI rank 0,
704:   while `PetscSynchronizedFPrintf()` has all MPI processes print their strings in order.

706: .seealso: `PetscBinaryWrite()`, `PetscBinaryOpen()`, `PetscBinaryClose()`, `PetscBinaryRead()`, `PetscBinarySynchronizedRead()`,
707:           `PetscBinarySynchronizedSeek()`
708: @*/
709: PetscErrorCode PetscBinarySynchronizedWrite(MPI_Comm comm, int fd, const void *p, PetscInt n, PetscDataType type)
710: {
711:   PetscMPIInt rank;

713:   PetscFunctionBegin;
714:   PetscCallMPI(MPI_Comm_rank(comm, &rank));
715:   if (rank == 0) PetscCall(PetscBinaryWrite(fd, p, n, type));
716:   PetscFunctionReturn(PETSC_SUCCESS);
717: }

719: /*@C
720:   PetscBinarySynchronizedSeek - Moves the file pointer on a PETSc binary file.

722:   No Fortran Support

724:   Input Parameters:
725: + comm   - the communicator to read with
726: . fd     - the file
727: . whence - see `PetscBinarySeekType` for possible values
728: - off    - number of bytes to move. Use `PETSC_BINARY_INT_SIZE`, `PETSC_BINARY_SCALAR_SIZE`,
729:             etc. in your calculation rather than `sizeof()` to compute byte lengths.

731:   Output Parameter:
732: . offset - new offset in file

734:   Level: developer

736: .seealso: `PetscBinaryRead()`, `PetscBinarySeekType`, `PetscBinaryWrite()`, `PetscBinaryOpen()`, `PetscBinarySynchronizedWrite()`, `PetscBinarySynchronizedRead()`,

738: @*/
739: PetscErrorCode PetscBinarySynchronizedSeek(MPI_Comm comm, int fd, off_t off, PetscBinarySeekType whence, off_t *offset)
740: {
741:   PetscMPIInt rank;

743:   PetscFunctionBegin;
744:   PetscCallMPI(MPI_Comm_rank(comm, &rank));
745:   if (rank == 0) PetscCall(PetscBinarySeek(fd, off, whence, offset));
746:   PetscFunctionReturn(PETSC_SUCCESS);
747: }

749: #if defined(PETSC_HAVE_MPIIO)

751:   #if defined(PETSC_USE_PETSC_MPI_EXTERNAL32)
752: /*
753:       MPICH does not provide the external32 representation for MPI_File_set_view() so we need to provide the functions.
754:     These are set into MPI in PetscInitialize() via MPI_Register_datarep()

756:     Note I use PetscMPIInt for the MPI error codes since that is what MPI uses (instead of the standard PetscErrorCode)

758:     The next three routines are not used because MPICH does not support their use

760: */
761: PETSC_EXTERN PetscMPIInt PetscDataRep_extent_fn(MPI_Datatype datatype, MPI_Aint *file_extent, void *extra_state)
762: {
763:   MPI_Aint    ub;
764:   PetscMPIInt ierr;

766:   ierr = MPI_Type_get_extent(datatype, &ub, file_extent);
767:   return ierr;
768: }

770: PETSC_EXTERN PetscMPIInt PetscDataRep_read_conv_fn(void *userbuf, MPI_Datatype datatype, PetscMPIInt count, void *filebuf, MPI_Offset position, void *extra_state)
771: {
772:   PetscDataType pdtype;
773:   PetscMPIInt   ierr;
774:   size_t        dsize;

776:   PetscCall(PetscMPIDataTypeToPetscDataType(datatype, &pdtype));
777:   PetscCall(PetscDataTypeGetSize(pdtype, &dsize));

779:   /* offset is given in units of MPI_Datatype */
780:   userbuf = ((char *)userbuf) + dsize * position;

782:   PetscCall(PetscMemcpy(userbuf, filebuf, count * dsize));
783:   if (!PetscBinaryBigEndian()) PetscCall(PetscByteSwap(userbuf, pdtype, count));
784:   return ierr;
785: }

787: PetscMPIInt PetscDataRep_write_conv_fn(void *userbuf, MPI_Datatype datatype, PetscMPIInt count, void *filebuf, MPI_Offset position, void *extra_state)
788: {
789:   PetscDataType pdtype;
790:   PetscMPIInt   ierr;
791:   size_t        dsize;

793:   PetscCall(PetscMPIDataTypeToPetscDataType(datatype, &pdtype));
794:   PetscCall(PetscDataTypeGetSize(pdtype, &dsize));

796:   /* offset is given in units of MPI_Datatype */
797:   userbuf = ((char *)userbuf) + dsize * position;

799:   PetscCall(PetscMemcpy(filebuf, userbuf, count * dsize));
800:   if (!PetscBinaryBigEndian()) PetscCall(PetscByteSwap(filebuf, pdtype, count));
801:   return ierr;
802: }
803:   #endif

805: PetscErrorCode MPIU_File_write_all(MPI_File fd, void *data, PetscMPIInt cnt, MPI_Datatype dtype, MPI_Status *status)
806: {
807:   PetscDataType pdtype;

809:   PetscFunctionBegin;
810:   PetscCall(PetscMPIDataTypeToPetscDataType(dtype, &pdtype));
811:   if (!PetscBinaryBigEndian()) PetscCall(PetscByteSwap(data, pdtype, cnt));
812:   PetscCallMPI(MPI_File_write_all(fd, data, cnt, dtype, status));
813:   if (!PetscBinaryBigEndian()) PetscCall(PetscByteSwap(data, pdtype, cnt));
814:   PetscFunctionReturn(PETSC_SUCCESS);
815: }

817: PetscErrorCode MPIU_File_read_all(MPI_File fd, void *data, PetscMPIInt cnt, MPI_Datatype dtype, MPI_Status *status)
818: {
819:   PetscDataType pdtype;

821:   PetscFunctionBegin;
822:   PetscCall(PetscMPIDataTypeToPetscDataType(dtype, &pdtype));
823:   PetscCallMPI(MPI_File_read_all(fd, data, cnt, dtype, status));
824:   if (!PetscBinaryBigEndian()) PetscCall(PetscByteSwap(data, pdtype, cnt));
825:   PetscFunctionReturn(PETSC_SUCCESS);
826: }

828: PetscErrorCode MPIU_File_write_at(MPI_File fd, MPI_Offset off, void *data, PetscMPIInt cnt, MPI_Datatype dtype, MPI_Status *status)
829: {
830:   PetscDataType pdtype;

832:   PetscFunctionBegin;
833:   PetscCall(PetscMPIDataTypeToPetscDataType(dtype, &pdtype));
834:   if (!PetscBinaryBigEndian()) PetscCall(PetscByteSwap(data, pdtype, cnt));
835:   PetscCallMPI(MPI_File_write_at(fd, off, data, cnt, dtype, status));
836:   if (!PetscBinaryBigEndian()) PetscCall(PetscByteSwap(data, pdtype, cnt));
837:   PetscFunctionReturn(PETSC_SUCCESS);
838: }

840: PetscErrorCode MPIU_File_read_at(MPI_File fd, MPI_Offset off, void *data, PetscMPIInt cnt, MPI_Datatype dtype, MPI_Status *status)
841: {
842:   PetscDataType pdtype;

844:   PetscFunctionBegin;
845:   PetscCall(PetscMPIDataTypeToPetscDataType(dtype, &pdtype));
846:   PetscCallMPI(MPI_File_read_at(fd, off, data, cnt, dtype, status));
847:   if (!PetscBinaryBigEndian()) PetscCall(PetscByteSwap(data, pdtype, cnt));
848:   PetscFunctionReturn(PETSC_SUCCESS);
849: }

851: PetscErrorCode MPIU_File_write_at_all(MPI_File fd, MPI_Offset off, void *data, PetscMPIInt cnt, MPI_Datatype dtype, MPI_Status *status)
852: {
853:   PetscDataType pdtype;

855:   PetscFunctionBegin;
856:   PetscCall(PetscMPIDataTypeToPetscDataType(dtype, &pdtype));
857:   if (!PetscBinaryBigEndian()) PetscCall(PetscByteSwap(data, pdtype, cnt));
858:   PetscCallMPI(MPI_File_write_at_all(fd, off, data, cnt, dtype, status));
859:   if (!PetscBinaryBigEndian()) PetscCall(PetscByteSwap(data, pdtype, cnt));
860:   PetscFunctionReturn(PETSC_SUCCESS);
861: }

863: PetscErrorCode MPIU_File_read_at_all(MPI_File fd, MPI_Offset off, void *data, PetscMPIInt cnt, MPI_Datatype dtype, MPI_Status *status)
864: {
865:   PetscDataType pdtype;

867:   PetscFunctionBegin;
868:   PetscCall(PetscMPIDataTypeToPetscDataType(dtype, &pdtype));
869:   PetscCallMPI(MPI_File_read_at_all(fd, off, data, cnt, dtype, status));
870:   if (!PetscBinaryBigEndian()) PetscCall(PetscByteSwap(data, pdtype, cnt));
871:   PetscFunctionReturn(PETSC_SUCCESS);
872: }

874: #endif