xref: /petsc/src/sys/fileio/ftn-custom/zsysiof.c (revision 06c8a052225a28c79122baf60b189d710df40010)
1 #include <petsc/private/fortranimpl.h>
2 
3 #if defined(PETSC_HAVE_FORTRAN_CAPS)
4 #define petscbinaryopen_           PETSCBINARYOPEN
5 #define petscbinaryread_           PETSCBINARYREAD
6 #define petsctestfile_             PETSCTESTFILE
7 #define petscbinarywrite_          PETSCBINARYWRITE
8 #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
9 #define petscbinarywrite_          petscbinarywrite
10 #define petscbinaryopen_           petscbinaryopen
11 #define petscbinaryread_           petscbinaryread
12 #define petsctestfile_             petsctestfile
13 #endif
14 
15 /* Definitions of Fortran Wrapper routines */
16 #if defined(__cplusplus)
17 extern "C" {
18 #endif
19 
20 PETSC_EXTERN void PETSC_STDCALL  petscbinarywriteint_(int *fd,void*p,PetscInt *n,PetscDataType *type,PetscBool  *istemp, int *ierr)
21 {
22   *ierr = PetscBinaryWrite(*fd,p,*n,*type,*istemp);
23 }
24 
25 PETSC_EXTERN void PETSC_STDCALL  petscbinarywritereal_(int *fd,void*p,PetscInt *n,PetscDataType *type,PetscBool  *istemp, int *ierr)
26 {
27   *ierr = PetscBinaryWrite(*fd,p,*n,*type,*istemp);
28 }
29 
30 PETSC_EXTERN void PETSC_STDCALL  petscbinarywritecomplex_(int *fd,void*p,PetscInt *n,PetscDataType *type,PetscBool  *istemp, int *ierr)
31 {
32   *ierr = PetscBinaryWrite(*fd,p,*n,*type,*istemp);
33 }
34 
35 PETSC_EXTERN void PETSC_STDCALL  petscbinarywriteint1_(int *fd,void*p,PetscInt *n,PetscDataType *type,PetscBool  *istemp, int *ierr)
36 {
37   *ierr = PetscBinaryWrite(*fd,p,*n,*type,*istemp);
38 }
39 
40 PETSC_EXTERN void PETSC_STDCALL  petscbinarywritereal1_(int *fd,void*p,PetscInt *n,PetscDataType *type,PetscBool  *istemp, int *ierr)
41 {
42   *ierr = PetscBinaryWrite(*fd,p,*n,*type,*istemp);
43 }
44 
45 PETSC_EXTERN void PETSC_STDCALL  petscbinarywritecomplex1_(int *fd,void*p,PetscInt *n,PetscDataType *type,PetscBool  *istemp, int *ierr)
46 {
47   *ierr = PetscBinaryWrite(*fd,p,*n,*type,*istemp);
48 }
49 
50 PETSC_EXTERN void PETSC_STDCALL petscbinaryopen_(char* name PETSC_MIXED_LEN(len),PetscFileMode *type,int *fd,
51                                     PetscErrorCode *ierr PETSC_END_LEN(len))
52 {
53   char *c1;
54 
55   FIXCHAR(name,len,c1);
56   *ierr = PetscBinaryOpen(c1,*type,fd);if (*ierr) return;
57   FREECHAR(name,c1);
58 }
59 
60 PETSC_EXTERN void PETSC_STDCALL  petscbinaryreadint_(int *fd,void *data,PetscInt *num,PetscInt *count,PetscDataType *type,int *ierr)
61 {
62   CHKFORTRANNULLINTEGER(count);
63   *ierr = PetscBinaryRead(*fd,data,*num,count,*type);if (*ierr) return;
64 }
65 
66 PETSC_EXTERN void PETSC_STDCALL  petscbinaryreadreal_(int *fd,void *data,PetscInt *num,PetscInt *count,PetscDataType *type,int *ierr)
67 {
68   CHKFORTRANNULLINTEGER(count);
69   *ierr = PetscBinaryRead(*fd,data,*num,count,*type);if (*ierr) return;
70 }
71 
72 PETSC_EXTERN void PETSC_STDCALL  petscbinaryreadcomplex_(int *fd,void *data,PetscInt *num,PetscInt *count,PetscDataType *type,int *ierr)
73 {
74   CHKFORTRANNULLINTEGER(count);
75   *ierr = PetscBinaryRead(*fd,data,*num,count,*type);if (*ierr) return;
76 }
77 
78 PETSC_EXTERN void PETSC_STDCALL  petscbinaryreadint1_(int *fd,void *data,PetscInt *num,PetscInt *count,PetscDataType *type,int *ierr)
79 {
80   CHKFORTRANNULLINTEGER(count);
81   *ierr = PetscBinaryRead(*fd,data,*num,count,*type);if (*ierr) return;
82 }
83 
84 PETSC_EXTERN void PETSC_STDCALL  petscbinaryreadreal1_(int *fd,void *data,PetscInt *num,PetscInt *count,PetscDataType *type,int *ierr)
85 {
86   CHKFORTRANNULLINTEGER(count);
87   *ierr = PetscBinaryRead(*fd,data,*num,count,*type);if (*ierr) return;
88 }
89 
90 PETSC_EXTERN void PETSC_STDCALL  petscbinaryreadcomplex1_(int *fd,void *data,PetscInt *num,PetscInt *count,PetscDataType *type,int *ierr)
91 {
92   CHKFORTRANNULLINTEGER(count);
93   *ierr = PetscBinaryRead(*fd,data,*num,count,*type);if (*ierr) return;
94 }
95 
96 PETSC_EXTERN void PETSC_STDCALL petsctestfile_(char* name PETSC_MIXED_LEN(len),char* mode PETSC_MIXED_LEN(len1),PetscBool *flg,PetscErrorCode *ierr PETSC_END_LEN(len) PETSC_END_LEN(len1))
97 {
98   char *c1;
99 
100   FIXCHAR(name,len,c1);
101   *ierr = PetscTestFile(c1,*mode,flg);if (*ierr) return;
102   FREECHAR(name,c1);
103 }
104