Date: 2026-07-30T21:14:24+00:00

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