xref: /petsc/src/sys/fileio/sysio.c (revision 2da392cc7c10228af19ad9843ce5155178acb644)
1 
2 /*
3    This file contains simple binary read/write routines.
4  */
5 
6 #include <petscsys.h>
7 #include <petscbt.h>
8 #include <errno.h>
9 #include <fcntl.h>
10 #if defined(PETSC_HAVE_UNISTD_H)
11 #include <unistd.h>
12 #endif
13 #if defined(PETSC_HAVE_IO_H)
14 #include <io.h>
15 #endif
16 #if !defined(PETSC_HAVE_O_BINARY)
17 #define O_BINARY 0
18 #endif
19 
20 const char *const PetscFileModes[] = {"READ","WRITE","APPEND","UPDATE","APPEND_UPDATE","PetscFileMode","PETSC_FILE_",NULL};
21 
22 /* --------------------------------------------------------- */
23 /*
24   PetscByteSwapEnum - Swap bytes in a  PETSc Enum
25 
26 */
27 PetscErrorCode  PetscByteSwapEnum(PetscEnum *buff,PetscInt n)
28 {
29   PetscInt  i,j;
30   PetscEnum tmp = ENUM_DUMMY;
31   char      *ptr1,*ptr2 = (char*)&tmp;
32 
33   PetscFunctionBegin;
34   for (j=0; j<n; j++) {
35     ptr1 = (char*)(buff + j);
36     for (i=0; i<(PetscInt)sizeof(PetscEnum); i++) ptr2[i] = ptr1[sizeof(PetscEnum)-1-i];
37     for (i=0; i<(PetscInt)sizeof(PetscEnum); i++) ptr1[i] = ptr2[i];
38   }
39   PetscFunctionReturn(0);
40 }
41 
42 /*
43   PetscByteSwapBool - Swap bytes in a  PETSc Bool
44 
45 */
46 PetscErrorCode  PetscByteSwapBool(PetscBool *buff,PetscInt n)
47 {
48   PetscInt  i,j;
49   PetscBool tmp = PETSC_FALSE;
50   char      *ptr1,*ptr2 = (char*)&tmp;
51 
52   PetscFunctionBegin;
53   for (j=0; j<n; j++) {
54     ptr1 = (char*)(buff + j);
55     for (i=0; i<(PetscInt)sizeof(PetscBool); i++) ptr2[i] = ptr1[sizeof(PetscBool)-1-i];
56     for (i=0; i<(PetscInt)sizeof(PetscBool); i++) ptr1[i] = ptr2[i];
57   }
58   PetscFunctionReturn(0);
59 }
60 
61 /*
62   PetscByteSwapInt - Swap bytes in a  PETSc integer (which may be 32 or 64 bits)
63 
64 */
65 PetscErrorCode  PetscByteSwapInt(PetscInt *buff,PetscInt n)
66 {
67   PetscInt i,j,tmp = 0;
68   char     *ptr1,*ptr2 = (char*)&tmp;
69 
70   PetscFunctionBegin;
71   for (j=0; j<n; j++) {
72     ptr1 = (char*)(buff + j);
73     for (i=0; i<(PetscInt)sizeof(PetscInt); i++) ptr2[i] = ptr1[sizeof(PetscInt)-1-i];
74     for (i=0; i<(PetscInt)sizeof(PetscInt); i++) ptr1[i] = ptr2[i];
75   }
76   PetscFunctionReturn(0);
77 }
78 
79 /*
80   PetscByteSwapInt64 - Swap bytes in a  PETSc integer (64 bits)
81 
82 */
83 PetscErrorCode  PetscByteSwapInt64(PetscInt64 *buff,PetscInt n)
84 {
85   PetscInt   i,j;
86   PetscInt64 tmp = 0;
87   char       *ptr1,*ptr2 = (char*)&tmp;
88 
89   PetscFunctionBegin;
90   for (j=0; j<n; j++) {
91     ptr1 = (char*)(buff + j);
92     for (i=0; i<(PetscInt)sizeof(PetscInt64); i++) ptr2[i] = ptr1[sizeof(PetscInt64)-1-i];
93     for (i=0; i<(PetscInt)sizeof(PetscInt64); i++) ptr1[i] = ptr2[i];
94   }
95   PetscFunctionReturn(0);
96 }
97 
98 /* --------------------------------------------------------- */
99 /*
100   PetscByteSwapShort - Swap bytes in a short
101 */
102 PetscErrorCode  PetscByteSwapShort(short *buff,PetscInt n)
103 {
104   PetscInt i,j;
105   short    tmp;
106   char     *ptr1,*ptr2 = (char*)&tmp;
107 
108   PetscFunctionBegin;
109   for (j=0; j<n; j++) {
110     ptr1 = (char*)(buff + j);
111     for (i=0; i<(PetscInt) sizeof(short); i++) ptr2[i] = ptr1[sizeof(short)-1-i];
112     for (i=0; i<(PetscInt) sizeof(short); i++) ptr1[i] = ptr2[i];
113   }
114   PetscFunctionReturn(0);
115 }
116 /*
117   PetscByteSwapLong - Swap bytes in a long
118 */
119 PetscErrorCode  PetscByteSwapLong(long *buff,PetscInt n)
120 {
121   PetscInt i,j;
122   long     tmp;
123   char     *ptr1,*ptr2 = (char*)&tmp;
124 
125   PetscFunctionBegin;
126   for (j=0; j<n; j++) {
127     ptr1 = (char*)(buff + j);
128     for (i=0; i<(PetscInt) sizeof(long); i++) ptr2[i] = ptr1[sizeof(long)-1-i];
129     for (i=0; i<(PetscInt) sizeof(long); i++) ptr1[i] = ptr2[i];
130   }
131   PetscFunctionReturn(0);
132 }
133 /* --------------------------------------------------------- */
134 /*
135   PetscByteSwapReal - Swap bytes in a PetscReal
136 */
137 PetscErrorCode  PetscByteSwapReal(PetscReal *buff,PetscInt n)
138 {
139   PetscInt  i,j;
140   PetscReal tmp,*buff1 = (PetscReal*)buff;
141   char      *ptr1,*ptr2 = (char*)&tmp;
142 
143   PetscFunctionBegin;
144   for (j=0; j<n; j++) {
145     ptr1 = (char*)(buff1 + j);
146     for (i=0; i<(PetscInt) sizeof(PetscReal); i++) ptr2[i] = ptr1[sizeof(PetscReal)-1-i];
147     for (i=0; i<(PetscInt) sizeof(PetscReal); i++) ptr1[i] = ptr2[i];
148   }
149   PetscFunctionReturn(0);
150 }
151 /* --------------------------------------------------------- */
152 /*
153   PetscByteSwapScalar - Swap bytes in a PetscScalar
154   The complex case is dealt with with an array of PetscReal, twice as long.
155 */
156 PetscErrorCode  PetscByteSwapScalar(PetscScalar *buff,PetscInt n)
157 {
158   PetscInt  i,j;
159   PetscReal tmp,*buff1 = (PetscReal*)buff;
160   char      *ptr1,*ptr2 = (char*)&tmp;
161 
162   PetscFunctionBegin;
163 #if defined(PETSC_USE_COMPLEX)
164   n *= 2;
165 #endif
166   for (j=0; j<n; j++) {
167     ptr1 = (char*)(buff1 + j);
168     for (i=0; i<(PetscInt) sizeof(PetscReal); i++) ptr2[i] = ptr1[sizeof(PetscReal)-1-i];
169     for (i=0; i<(PetscInt) sizeof(PetscReal); i++) ptr1[i] = ptr2[i];
170   }
171   PetscFunctionReturn(0);
172 }
173 /* --------------------------------------------------------- */
174 /*
175   PetscByteSwapDouble - Swap bytes in a double
176 */
177 PetscErrorCode  PetscByteSwapDouble(double *buff,PetscInt n)
178 {
179   PetscInt i,j;
180   double   tmp,*buff1 = (double*)buff;
181   char     *ptr1,*ptr2 = (char*)&tmp;
182 
183   PetscFunctionBegin;
184   for (j=0; j<n; j++) {
185     ptr1 = (char*)(buff1 + j);
186     for (i=0; i<(PetscInt) sizeof(double); i++) ptr2[i] = ptr1[sizeof(double)-1-i];
187     for (i=0; i<(PetscInt) sizeof(double); i++) ptr1[i] = ptr2[i];
188   }
189   PetscFunctionReturn(0);
190 }
191 
192 /*
193   PetscByteSwapFloat - Swap bytes in a float
194 */
195 PetscErrorCode PetscByteSwapFloat(float *buff,PetscInt n)
196 {
197   PetscInt i,j;
198   float    tmp,*buff1 = (float*)buff;
199   char     *ptr1,*ptr2 = (char*)&tmp;
200 
201   PetscFunctionBegin;
202   for (j=0; j<n; j++) {
203     ptr1 = (char*)(buff1 + j);
204     for (i=0; i<(PetscInt) sizeof(float); i++) ptr2[i] = ptr1[sizeof(float)-1-i];
205     for (i=0; i<(PetscInt) sizeof(float); i++) ptr1[i] = ptr2[i];
206   }
207   PetscFunctionReturn(0);
208 }
209 
210 PetscErrorCode PetscByteSwap(void *data,PetscDataType pdtype,PetscInt count)
211 {
212   PetscErrorCode ierr;
213 
214   PetscFunctionBegin;
215   if      (pdtype == PETSC_INT)    {ierr = PetscByteSwapInt((PetscInt*)data,count);CHKERRQ(ierr);}
216   else if (pdtype == PETSC_ENUM)   {ierr = PetscByteSwapEnum((PetscEnum*)data,count);CHKERRQ(ierr);}
217   else if (pdtype == PETSC_BOOL)   {ierr = PetscByteSwapBool((PetscBool*)data,count);CHKERRQ(ierr);}
218   else if (pdtype == PETSC_SCALAR) {ierr = PetscByteSwapScalar((PetscScalar*)data,count);CHKERRQ(ierr);}
219   else if (pdtype == PETSC_REAL)   {ierr = PetscByteSwapReal((PetscReal*)data,count);CHKERRQ(ierr);}
220   else if (pdtype == PETSC_COMPLEX){ierr = PetscByteSwapReal((PetscReal*)data,2*count);CHKERRQ(ierr);}
221   else if (pdtype == PETSC_INT64)  {ierr = PetscByteSwapInt64((PetscInt64*)data,count);CHKERRQ(ierr);}
222   else if (pdtype == PETSC_DOUBLE) {ierr = PetscByteSwapDouble((double*)data,count);CHKERRQ(ierr);}
223   else if (pdtype == PETSC_FLOAT)  {ierr = PetscByteSwapFloat((float*)data,count);CHKERRQ(ierr);}
224   else if (pdtype == PETSC_SHORT)  {ierr = PetscByteSwapShort((short*)data,count);CHKERRQ(ierr);}
225   else if (pdtype == PETSC_LONG)   {ierr = PetscByteSwapLong((long*)data,count);CHKERRQ(ierr);}
226   PetscFunctionReturn(0);
227 }
228 
229 /*@C
230    PetscBinaryRead - Reads from a binary file.
231 
232    Not Collective
233 
234    Input Parameters:
235 +  fd - the file descriptor
236 .  num  - the maximum number of items to read
237 -  type - the type of items to read (PETSC_INT, PETSC_REAL, PETSC_SCALAR, etc.)
238 
239    Output Parameters:
240 +  data - the buffer
241 -  count - the number of items read, optional
242 
243    Level: developer
244 
245    Notes:
246    If count is not provided and the number of items read is less than
247    the maximum number of items to read, then this routine errors.
248 
249    PetscBinaryRead() uses byte swapping to work on all machines; the files
250    are written to file ALWAYS using big-endian ordering. On little-endian machines the numbers
251    are converted to the little-endian format when they are read in from the file.
252    When PETSc is ./configure with --with-64-bit-indices the integers are written to the
253    file as 64 bit integers, this means they can only be read back in when the option --with-64-bit-indices
254    is used.
255 
256 .seealso: PetscBinaryWrite(), PetscBinaryOpen(), PetscBinaryClose(), PetscViewerBinaryGetDescriptor(), PetscBinarySynchronizedWrite(),
257           PetscBinarySynchronizedRead(), PetscBinarySynchronizedSeek()
258 @*/
259 PetscErrorCode  PetscBinaryRead(int fd,void *data,PetscInt num,PetscInt *count,PetscDataType type)
260 {
261   size_t            typesize, m = (size_t) num, n = 0, maxblock = 65536;
262   char              *p = (char*)data;
263 #if defined(PETSC_USE_REAL___FLOAT128)
264   PetscBool         readdouble = PETSC_FALSE;
265   double            *pdouble;
266 #endif
267   void              *ptmp = data;
268   char              *fname = NULL;
269   PetscErrorCode    ierr;
270 
271   PetscFunctionBegin;
272   if (count) *count = 0;
273   if (num < 0) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Trying to read a negative amount of data %D",num);
274   if (!num) PetscFunctionReturn(0);
275 
276   if (type == PETSC_FUNCTION) {
277     m     = 64;
278     type  = PETSC_CHAR;
279     fname = (char*)malloc(m*sizeof(char));
280     p     = (char*)fname;
281     ptmp  = (void*)fname;
282     if (!fname) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM,"Cannot allocate space for function name");
283   }
284   if (type == PETSC_BIT_LOGICAL) m = PetscBTLength(m);
285 
286   ierr = PetscDataTypeGetSize(type,&typesize);CHKERRQ(ierr);
287 
288 #if defined(PETSC_USE_REAL___FLOAT128)
289   ierr = PetscOptionsGetBool(NULL,NULL,"-binary_read_double",&readdouble,NULL);CHKERRQ(ierr);
290   /* If using __float128 precision we still read in doubles from file */
291   if ((type == PETSC_REAL || type == PETSC_COMPLEX) && readdouble) {
292     PetscInt cnt = num * ((type == PETSC_REAL) ? 1 : 2);
293     ierr = PetscMalloc1(cnt,&pdouble);CHKERRQ(ierr);
294     p = (char*)pdouble;
295     typesize /= 2;
296   }
297 #endif
298 
299   m *= typesize;
300 
301   while (m) {
302     size_t len = (m < maxblock) ? m : maxblock;
303     int    ret = (int)read(fd,p,len);
304     if (ret < 0 && errno == EINTR) continue;
305     if (!ret && len > 0) break; /* Proxy for EOF */
306     if (ret < 0) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_FILE_READ,"Error reading from file, errno %d",errno);
307     m -= ret;
308     p += ret;
309     n += ret;
310   }
311   if (m && !count) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_FILE_READ,"Read past end of file");
312 
313   num = (PetscInt)(n/typesize); /* Should we require `n % typesize == 0` ? */
314   if (count) *count = num;      /* TODO: This is most likely wrong for PETSC_BIT_LOGICAL */
315 
316 #if defined(PETSC_USE_REAL___FLOAT128)
317   if ((type == PETSC_REAL || type == PETSC_COMPLEX) && readdouble) {
318     PetscInt  i, cnt = num * ((type == PETSC_REAL) ? 1 : 2);
319     PetscReal *preal = (PetscReal*)data;
320     if (!PetscBinaryBigEndian()) {ierr = PetscByteSwapDouble(pdouble,cnt);CHKERRQ(ierr);}
321     for (i=0; i<cnt; i++) preal[i] = pdouble[i];
322     ierr = PetscFree(pdouble);CHKERRQ(ierr);
323     PetscFunctionReturn(0);
324   }
325 #endif
326 
327   if (!PetscBinaryBigEndian()) {ierr = PetscByteSwap(ptmp,type,num);CHKERRQ(ierr);}
328 
329   if (type == PETSC_FUNCTION) {
330 #if defined(PETSC_SERIALIZE_FUNCTIONS)
331     ierr = PetscDLSym(NULL,fname,(void**)data);CHKERRQ(ierr);
332 #else
333     *(void**)data = NULL;
334 #endif
335     free(fname);
336   }
337   PetscFunctionReturn(0);
338 }
339 
340 /*@C
341    PetscBinaryWrite - Writes to a binary file.
342 
343    Not Collective
344 
345    Input Parameters:
346 +  fd     - the file
347 .  p      - the buffer
348 .  n      - the number of items to write
349 -  type   - the type of items to read (PETSC_INT, PETSC_DOUBLE or PETSC_SCALAR)
350 
351    Level: advanced
352 
353    Notes:
354    PetscBinaryWrite() uses byte swapping to work on all machines; the files
355    are written using big-endian ordering to the file. On little-endian machines the numbers
356    are converted to the big-endian format when they are written to disk.
357    When PETSc is ./configure with --with-64-bit-indices the integers are written to the
358    file as 64 bit integers, this means they can only be read back in when the option --with-64-bit-indices
359    is used.
360 
361    If running with __float128 precision the output is in __float128 unless one uses the -binary_write_double option
362 
363    The Buffer p should be read-write buffer, and not static data.
364    This way, byte-swapping is done in-place, and then the buffer is
365    written to the file.
366 
367    This routine restores the original contents of the buffer, after
368    it is written to the file. This is done by byte-swapping in-place
369    the second time.
370 
371    Because byte-swapping may be done on the values in data it cannot be declared const
372 
373 
374 .seealso: PetscBinaryRead(), PetscBinaryOpen(), PetscBinaryClose(), PetscViewerBinaryGetDescriptor(), PetscBinarySynchronizedWrite(),
375           PetscBinarySynchronizedRead(), PetscBinarySynchronizedSeek()
376 @*/
377 PetscErrorCode  PetscBinaryWrite(int fd,const void *p,PetscInt n,PetscDataType type)
378 {
379   const char     *pp = (char*)p;
380   int            err,wsize;
381   size_t         m = (size_t)n,maxblock=65536;
382   PetscErrorCode ierr;
383   const void     *ptmp = p;
384   char           *fname = NULL;
385 #if defined(PETSC_USE_REAL___FLOAT128)
386   PetscBool      writedouble = PETSC_FALSE;
387   double         *ppp;
388   PetscReal      *pv;
389   PetscInt       i;
390 #endif
391   PetscDataType  wtype = type;
392 
393   PetscFunctionBegin;
394   if (n < 0) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Trying to write a negative amount of data %D",n);
395   if (!n) PetscFunctionReturn(0);
396 
397   if (type == PETSC_FUNCTION) {
398 #if defined(PETSC_SERIALIZE_FUNCTIONS)
399     const char *fnametmp;
400 #endif
401     m     = 64;
402     fname = (char*)malloc(m*sizeof(char));
403     if (!fname) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM,"Cannot allocate space for function name");
404 #if defined(PETSC_SERIALIZE_FUNCTIONS)
405     if (n > 1) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Can only binary view a single function at a time");
406     ierr = PetscFPTFind(*(void**)p,&fnametmp);CHKERRQ(ierr);
407     ierr = PetscStrncpy(fname,fnametmp,m);CHKERRQ(ierr);
408 #else
409     ierr = PetscStrncpy(fname,"",m);CHKERRQ(ierr);
410 #endif
411     wtype = PETSC_CHAR;
412     pp    = (char*)fname;
413     ptmp  = (void*)fname;
414   }
415 
416 #if defined(PETSC_USE_REAL___FLOAT128)
417   ierr = PetscOptionsGetBool(NULL,NULL,"-binary_write_double",&writedouble,NULL);CHKERRQ(ierr);
418   /* If using __float128 precision we still write in doubles to file */
419   if ((type == PETSC_SCALAR || type == PETSC_REAL) && writedouble) {
420     wtype = PETSC_DOUBLE;
421     ierr = PetscMalloc1(n,&ppp);CHKERRQ(ierr);
422     pv = (PetscReal*)pp;
423     for (i=0; i<n; i++) {
424       ppp[i] = (double) pv[i];
425     }
426     pp   = (char*)ppp;
427     ptmp = (char*)ppp;
428   }
429 #endif
430 
431   if (wtype == PETSC_INT)          m *= sizeof(PetscInt);
432   else if (wtype == PETSC_SCALAR)  m *= sizeof(PetscScalar);
433   else if (wtype == PETSC_REAL)    m *= sizeof(PetscReal);
434   else if (wtype == PETSC_DOUBLE)  m *= sizeof(double);
435   else if (wtype == PETSC_FLOAT)   m *= sizeof(float);
436   else if (wtype == PETSC_SHORT)   m *= sizeof(short);
437   else if (wtype == PETSC_LONG)    m *= sizeof(long);
438   else if (wtype == PETSC_CHAR)    m *= sizeof(char);
439   else if (wtype == PETSC_ENUM)    m *= sizeof(PetscEnum);
440   else if (wtype == PETSC_BOOL)    m *= sizeof(PetscBool);
441   else if (wtype == PETSC_INT64)   m *= sizeof(PetscInt64);
442   else if (wtype == PETSC_BIT_LOGICAL) m = PetscBTLength(m)*sizeof(char);
443   else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Unknown type");
444 
445   if (!PetscBinaryBigEndian()) {ierr = PetscByteSwap((void*)ptmp,wtype,n);CHKERRQ(ierr);}
446 
447   while (m) {
448     wsize = (m < maxblock) ? m : maxblock;
449     err   = write(fd,pp,wsize);
450     if (err < 0 && errno == EINTR) continue;
451     if (err != wsize) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_FILE_WRITE,"Error writing to file total size %d err %d wsize %d",(int)n,(int)err,(int)wsize);
452     m  -= wsize;
453     pp += wsize;
454   }
455 
456   if (!PetscBinaryBigEndian()) {ierr = PetscByteSwap((void*)ptmp,wtype,n);CHKERRQ(ierr);}
457 
458   if (type == PETSC_FUNCTION) {
459     free(fname);
460   }
461 #if defined(PETSC_USE_REAL___FLOAT128)
462   if ((type == PETSC_SCALAR || type == PETSC_REAL) && writedouble) {
463     ierr = PetscFree(ppp);CHKERRQ(ierr);
464   }
465 #endif
466   PetscFunctionReturn(0);
467 }
468 
469 /*@C
470    PetscBinaryOpen - Opens a PETSc binary file.
471 
472    Not Collective
473 
474    Input Parameters:
475 +  name - filename
476 -  mode - open mode of binary file, one of FILE_MODE_READ, FILE_MODE_WRITE, FILE_MODE_APPEND
477 
478    Output Parameter:
479 .  fd - the file
480 
481    Level: advanced
482 
483 
484    Notes:
485     Files access with PetscBinaryRead() and PetscBinaryWrite() are ALWAYS written in
486    big-endian format. This means the file can be accessed using PetscBinaryOpen() and
487    PetscBinaryRead() and PetscBinaryWrite() on any machine.
488 
489 .seealso: PetscBinaryRead(), PetscBinaryWrite(), PetscFileMode, PetscViewerFileSetMode(), PetscViewerBinaryGetDescriptor(),
490           PetscBinarySynchronizedWrite(), PetscBinarySynchronizedRead(), PetscBinarySynchronizedSeek()
491 
492 @*/
493 PetscErrorCode  PetscBinaryOpen(const char name[],PetscFileMode mode,int *fd)
494 {
495   PetscFunctionBegin;
496   switch (mode) {
497   case FILE_MODE_READ:   *fd = open(name,O_BINARY|O_RDONLY,0); break;
498   case FILE_MODE_WRITE:  *fd = open(name,O_BINARY|O_WRONLY|O_CREAT|O_TRUNC,0666); break;
499   case FILE_MODE_APPEND: *fd = open(name,O_BINARY|O_WRONLY|O_APPEND,0); break;
500   default: SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Unsupported file mode %s",PetscFileModes[mode]);
501   }
502   if (*fd == -1) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Cannot open file %s for %s: %s",name,PetscFileModes[mode]);
503   PetscFunctionReturn(0);
504 }
505 
506 /*@
507    PetscBinaryClose - Closes a PETSc binary file.
508 
509    Not Collective
510 
511    Output Parameter:
512 .  fd - the file
513 
514    Level: advanced
515 
516 .seealso: PetscBinaryRead(), PetscBinaryWrite(), PetscBinaryOpen(), PetscBinarySynchronizedWrite(), PetscBinarySynchronizedRead(),
517           PetscBinarySynchronizedSeek()
518 @*/
519 PetscErrorCode  PetscBinaryClose(int fd)
520 {
521   PetscFunctionBegin;
522   if (close(fd)) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"close() failed on file descriptor");
523   PetscFunctionReturn(0);
524 }
525 
526 
527 /*@C
528    PetscBinarySeek - Moves the file pointer on a PETSc binary file.
529 
530    Not Collective
531 
532    Input Parameters:
533 +  fd - the file
534 .  off - number of bytes to move. Use PETSC_BINARY_INT_SIZE, PETSC_BINARY_SCALAR_SIZE,
535             etc. in your calculation rather than sizeof() to compute byte lengths.
536 -  whence - if PETSC_BINARY_SEEK_SET then off is an absolute location in the file
537             if PETSC_BINARY_SEEK_CUR then off is an offset from the current location
538             if PETSC_BINARY_SEEK_END then off is an offset from the end of file
539 
540    Output Parameter:
541 .   offset - new offset in file
542 
543    Level: developer
544 
545    Notes:
546    Integers are stored on the file as 32 long, regardless of whether
547    they are stored in the machine as 32 or 64, this means the same
548    binary file may be read on any machine. Hence you CANNOT use sizeof()
549    to determine the offset or location.
550 
551 
552 .seealso: PetscBinaryRead(), PetscBinaryWrite(), PetscBinaryOpen(), PetscBinarySynchronizedWrite(), PetscBinarySynchronizedRead(),
553           PetscBinarySynchronizedSeek()
554 @*/
555 PetscErrorCode  PetscBinarySeek(int fd,off_t off,PetscBinarySeekType whence,off_t *offset)
556 {
557   int iwhence = 0;
558 
559   PetscFunctionBegin;
560   if (whence == PETSC_BINARY_SEEK_SET) iwhence = SEEK_SET;
561   else if (whence == PETSC_BINARY_SEEK_CUR) iwhence = SEEK_CUR;
562   else if (whence == PETSC_BINARY_SEEK_END) iwhence = SEEK_END;
563   else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Unknown seek location");
564 #if defined(PETSC_HAVE_LSEEK)
565   *offset = lseek(fd,off,iwhence);
566 #elif defined(PETSC_HAVE__LSEEK)
567   *offset = _lseek(fd,(long)off,iwhence);
568 #else
569   SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP_SYS,"System does not have a way of seeking on a file");
570 #endif
571   PetscFunctionReturn(0);
572 }
573 
574 /*@C
575    PetscBinarySynchronizedRead - Reads from a binary file.
576 
577    Collective
578 
579    Input Parameters:
580 +  comm - the MPI communicator
581 .  fd - the file descriptor
582 .  num  - the maximum number of items to read
583 -  type - the type of items to read (PETSC_INT, PETSC_REAL, PETSC_SCALAR, etc.)
584 
585    Output Parameters:
586 +  data - the buffer
587 -  count - the number of items read, optional
588 
589    Level: developer
590 
591    Notes:
592    Does a PetscBinaryRead() followed by an MPI_Bcast()
593 
594    If count is not provided and the number of items read is less than
595    the maximum number of items to read, then this routine errors.
596 
597    PetscBinarySynchronizedRead() uses byte swapping to work on all machines.
598    Integers are stored on the file as 32 long, regardless of whether
599    they are stored in the machine as 32 or 64, this means the same
600    binary file may be read on any machine.
601 
602 
603 .seealso: PetscBinaryWrite(), PetscBinaryOpen(), PetscBinaryClose(), PetscBinaryRead(), PetscBinarySynchronizedWrite(),
604           PetscBinarySynchronizedSeek()
605 @*/
606 PetscErrorCode  PetscBinarySynchronizedRead(MPI_Comm comm,int fd,void *data,PetscInt num,PetscInt *count,PetscDataType type)
607 {
608   PetscErrorCode ierr;
609   PetscMPIInt    rank;
610   MPI_Datatype   mtype;
611   PetscInt       ibuf[2] = {0, 0};
612   char           *fname = NULL;
613   void           *fptr = NULL;
614 
615   PetscFunctionBegin;
616   if (type == PETSC_FUNCTION) {
617     num   = 64;
618     type  = PETSC_CHAR;
619     fname = (char*)malloc(num*sizeof(char));
620     fptr  = data;
621     data  = (void*)fname;
622     if (!fname) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM,"Cannot allocate space for function name");
623   }
624 
625   ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
626   if (!rank) {
627     ibuf[0] = PetscBinaryRead(fd,data,num,count?&ibuf[1]:NULL,type);
628   }
629   ierr = MPI_Bcast(ibuf,2,MPIU_INT,0,comm);CHKERRQ(ierr);
630   ierr = (PetscErrorCode)ibuf[0];CHKERRQ(ierr);
631   ierr = PetscDataTypeToMPIDataType(type,&mtype);CHKERRQ(ierr);
632   ierr = MPI_Bcast(data,count?ibuf[1]:num,mtype,0,comm);CHKERRQ(ierr);
633   if (count) *count = ibuf[1];
634 
635   if (type == PETSC_FUNCTION) {
636 #if defined(PETSC_SERIALIZE_FUNCTIONS)
637     ierr = PetscDLLibrarySym(PETSC_COMM_SELF,&PetscDLLibrariesLoaded,NULL,fname,(void**)fptr);CHKERRQ(ierr);
638 #else
639     *(void**)fptr = NULL;
640 #endif
641     free(fname);
642   }
643   PetscFunctionReturn(0);
644 }
645 
646 /*@C
647    PetscBinarySynchronizedWrite - writes to a binary file.
648 
649    Collective
650 
651    Input Parameters:
652 +  comm - the MPI communicator
653 .  fd - the file
654 .  n  - the number of items to write
655 .  p - the buffer
656 -  type - the type of items to write (PETSC_INT, PETSC_DOUBLE or PETSC_SCALAR)
657 
658    Level: developer
659 
660    Notes:
661    Process 0 does a PetscBinaryWrite()
662 
663    PetscBinarySynchronizedWrite() uses byte swapping to work on all machines.
664    Integers are stored on the file as 32 long, regardless of whether
665    they are stored in the machine as 32 or 64, this means the same
666    binary file may be read on any machine.
667 
668    Notes:
669     because byte-swapping may be done on the values in data it cannot be declared const
670 
671    WARNING: This is NOT like PetscSynchronizedFPrintf()! This routine ignores calls on all but process 0,
672    while PetscSynchronizedFPrintf() has all processes print their strings in order.
673 
674 
675 .seealso: PetscBinaryWrite(), PetscBinaryOpen(), PetscBinaryClose(), PetscBinaryRead(), PetscBinarySynchronizedRead(),
676           PetscBinarySynchronizedSeek()
677 @*/
678 PetscErrorCode  PetscBinarySynchronizedWrite(MPI_Comm comm,int fd,const void *p,PetscInt n,PetscDataType type)
679 {
680   PetscErrorCode ierr;
681   PetscMPIInt    rank;
682 
683   PetscFunctionBegin;
684   ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
685   if (!rank) {
686     ierr = PetscBinaryWrite(fd,p,n,type);CHKERRQ(ierr);
687   }
688   PetscFunctionReturn(0);
689 }
690 
691 /*@C
692    PetscBinarySynchronizedSeek - Moves the file pointer on a PETSc binary file.
693 
694 
695    Input Parameters:
696 +  fd - the file
697 .  whence - if PETSC_BINARY_SEEK_SET then size is an absolute location in the file
698             if PETSC_BINARY_SEEK_CUR then size is offset from current location
699             if PETSC_BINARY_SEEK_END then size is offset from end of file
700 -  off    - number of bytes to move. Use PETSC_BINARY_INT_SIZE, PETSC_BINARY_SCALAR_SIZE,
701             etc. in your calculation rather than sizeof() to compute byte lengths.
702 
703    Output Parameter:
704 .   offset - new offset in file
705 
706    Level: developer
707 
708    Notes:
709    Integers are stored on the file as 32 long, regardless of whether
710    they are stored in the machine as 32 or 64, this means the same
711    binary file may be read on any machine. Hence you CANNOT use sizeof()
712    to determine the offset or location.
713 
714 
715 .seealso: PetscBinaryRead(), PetscBinaryWrite(), PetscBinaryOpen(), PetscBinarySynchronizedWrite(), PetscBinarySynchronizedRead(),
716           PetscBinarySynchronizedSeek()
717 @*/
718 PetscErrorCode  PetscBinarySynchronizedSeek(MPI_Comm comm,int fd,off_t off,PetscBinarySeekType whence,off_t *offset)
719 {
720   PetscErrorCode ierr;
721   PetscMPIInt    rank;
722 
723   PetscFunctionBegin;
724   ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
725   if (!rank) {
726     ierr = PetscBinarySeek(fd,off,whence,offset);CHKERRQ(ierr);
727   }
728   PetscFunctionReturn(0);
729 }
730 
731 #if defined(PETSC_HAVE_MPIIO)
732 
733 #if defined(PETSC_USE_PETSC_MPI_EXTERNAL32)
734 /*
735       MPICH does not provide the external32 representation for MPI_File_set_view() so we need to provide the functions.
736     These are set into MPI in PetscInitialize() via MPI_Register_datarep()
737 
738     Note I use PetscMPIInt for the MPI error codes since that is what MPI uses (instead of the standard PetscErrorCode)
739 
740     The next three routines are not used because MPICH does not support their use
741 
742 */
743 PETSC_EXTERN PetscMPIInt PetscDataRep_extent_fn(MPI_Datatype datatype,MPI_Aint *file_extent,void *extra_state)
744 {
745   MPI_Aint    ub;
746   PetscMPIInt ierr;
747 
748   ierr = MPI_Type_get_extent(datatype,&ub,file_extent);
749   return ierr;
750 }
751 
752 PETSC_EXTERN PetscMPIInt PetscDataRep_read_conv_fn(void *userbuf, MPI_Datatype datatype,PetscMPIInt count,void *filebuf, MPI_Offset position,void *extra_state)
753 {
754   PetscDataType pdtype;
755   PetscMPIInt   ierr;
756   size_t        dsize;
757 
758   ierr = PetscMPIDataTypeToPetscDataType(datatype,&pdtype);CHKERRQ(ierr);
759   ierr = PetscDataTypeGetSize(pdtype,&dsize);CHKERRQ(ierr);
760 
761   /* offset is given in units of MPI_Datatype */
762   userbuf = ((char*)userbuf) + dsize*position;
763 
764   ierr = PetscMemcpy(userbuf,filebuf,count*dsize);CHKERRQ(ierr);
765   if (!PetscBinaryBigEndian()) {ierr = PetscByteSwap(userbuf,pdtype,count);CHKERRQ(ierr);}
766   return ierr;
767 }
768 
769 PetscMPIInt PetscDataRep_write_conv_fn(void *userbuf, MPI_Datatype datatype,PetscMPIInt count,void *filebuf, MPI_Offset position,void *extra_state)
770 {
771   PetscDataType pdtype;
772   PetscMPIInt   ierr;
773   size_t        dsize;
774 
775   ierr = PetscMPIDataTypeToPetscDataType(datatype,&pdtype);CHKERRQ(ierr);
776   ierr = PetscDataTypeGetSize(pdtype,&dsize);CHKERRQ(ierr);
777 
778   /* offset is given in units of MPI_Datatype */
779   userbuf = ((char*)userbuf) + dsize*position;
780 
781   ierr = PetscMemcpy(filebuf,userbuf,count*dsize);CHKERRQ(ierr);
782   if (!PetscBinaryBigEndian()) {ierr = PetscByteSwap(filebuf,pdtype,count);CHKERRQ(ierr);}
783   return ierr;
784 }
785 #endif
786 
787 PetscErrorCode MPIU_File_write_all(MPI_File fd,void *data,PetscMPIInt cnt,MPI_Datatype dtype,MPI_Status *status)
788 {
789   PetscDataType  pdtype;
790   PetscErrorCode ierr;
791 
792 
793   PetscFunctionBegin;
794   ierr = PetscMPIDataTypeToPetscDataType(dtype,&pdtype);CHKERRQ(ierr);
795   if (!PetscBinaryBigEndian()) {ierr = PetscByteSwap(data,pdtype,cnt);CHKERRQ(ierr);}
796   ierr = MPI_File_write_all(fd,data,cnt,dtype,status);CHKERRQ(ierr);
797   if (!PetscBinaryBigEndian()) {ierr = PetscByteSwap(data,pdtype,cnt);CHKERRQ(ierr);}
798   PetscFunctionReturn(0);
799 }
800 
801 PetscErrorCode MPIU_File_read_all(MPI_File fd,void *data,PetscMPIInt cnt,MPI_Datatype dtype,MPI_Status *status)
802 {
803   PetscDataType  pdtype;
804   PetscErrorCode ierr;
805 
806   PetscFunctionBegin;
807   ierr = PetscMPIDataTypeToPetscDataType(dtype,&pdtype);CHKERRQ(ierr);
808   ierr = MPI_File_read_all(fd,data,cnt,dtype,status);CHKERRQ(ierr);
809   if (!PetscBinaryBigEndian()) {ierr = PetscByteSwap(data,pdtype,cnt);CHKERRQ(ierr);}
810   PetscFunctionReturn(0);
811 }
812 
813 PetscErrorCode MPIU_File_write_at(MPI_File fd,MPI_Offset off,void *data,PetscMPIInt cnt,MPI_Datatype dtype,MPI_Status *status)
814 {
815   PetscDataType  pdtype;
816   PetscErrorCode ierr;
817 
818 
819   PetscFunctionBegin;
820   ierr = PetscMPIDataTypeToPetscDataType(dtype,&pdtype);CHKERRQ(ierr);
821   if (!PetscBinaryBigEndian()) {ierr = PetscByteSwap(data,pdtype,cnt);CHKERRQ(ierr);}
822   ierr = MPI_File_write_at(fd,off,data,cnt,dtype,status);CHKERRQ(ierr);
823   if (!PetscBinaryBigEndian()) {ierr = PetscByteSwap(data,pdtype,cnt);CHKERRQ(ierr);}
824   PetscFunctionReturn(0);
825 }
826 
827 PetscErrorCode MPIU_File_read_at(MPI_File fd,MPI_Offset off,void *data,PetscMPIInt cnt,MPI_Datatype dtype,MPI_Status *status)
828 {
829   PetscDataType  pdtype;
830   PetscErrorCode ierr;
831 
832   PetscFunctionBegin;
833   ierr = PetscMPIDataTypeToPetscDataType(dtype,&pdtype);CHKERRQ(ierr);
834   ierr = MPI_File_read_at(fd,off,data,cnt,dtype,status);CHKERRQ(ierr);
835   if (!PetscBinaryBigEndian()) {ierr = PetscByteSwap(data,pdtype,cnt);CHKERRQ(ierr);}
836   PetscFunctionReturn(0);
837 }
838 
839 PetscErrorCode MPIU_File_write_at_all(MPI_File fd,MPI_Offset off,void *data,PetscMPIInt cnt,MPI_Datatype dtype,MPI_Status *status)
840 {
841   PetscDataType  pdtype;
842   PetscErrorCode ierr;
843 
844 
845   PetscFunctionBegin;
846   ierr = PetscMPIDataTypeToPetscDataType(dtype,&pdtype);CHKERRQ(ierr);
847   if (!PetscBinaryBigEndian()) {ierr = PetscByteSwap(data,pdtype,cnt);CHKERRQ(ierr);}
848   ierr = MPI_File_write_at_all(fd,off,data,cnt,dtype,status);CHKERRQ(ierr);
849   if (!PetscBinaryBigEndian()) {ierr = PetscByteSwap(data,pdtype,cnt);CHKERRQ(ierr);}
850   PetscFunctionReturn(0);
851 }
852 
853 PetscErrorCode MPIU_File_read_at_all(MPI_File fd,MPI_Offset off,void *data,PetscMPIInt cnt,MPI_Datatype dtype,MPI_Status *status)
854 {
855   PetscDataType  pdtype;
856   PetscErrorCode ierr;
857 
858   PetscFunctionBegin;
859   ierr = PetscMPIDataTypeToPetscDataType(dtype,&pdtype);CHKERRQ(ierr);
860   ierr = MPI_File_read_at_all(fd,off,data,cnt,dtype,status);CHKERRQ(ierr);
861   if (!PetscBinaryBigEndian()) {ierr = PetscByteSwap(data,pdtype,cnt);CHKERRQ(ierr);}
862   PetscFunctionReturn(0);
863 }
864 
865 #endif
866