Actual source code: zbagf90.c
1: #include <petsc/private/f90impl.h>
2: #include <petsc/private/fortranimpl.h>
3: #include <petscbag.h>
4: #include <petsc/private/bagimpl.h>
5: #include <petscviewer.h>
7: #if defined(PETSC_HAVE_FORTRAN_CAPS)
8: #define petscbaggetdata_ PETSCBAGGETDATA
9: #define petscbagregisterint_ PETSCBAGREGISTERINT
10: #define petscbagregisterint64_ PETSCBAGREGISTERINT64
11: #define petscbagregisterintarray_ PETSCBAGREGISTERINTARRAY
12: #define petscbagregisterscalar_ PETSCBAGREGISTERSCALAR
13: #define petscbagregisterstring_ PETSCBAGREGISTERSTRING
14: #define petscbagregisterreal_ PETSCBAGREGISTERREAL
15: #define petscbagregisterrealarray_ PETSCBAGREGISTERREALARRAY
16: #define petscbagregisterbool_ PETSCBAGREGISTERBOOL
17: #define petscbagregisterboolarray_ PETSCBAGREGISTERBOOLARRAY
18: #define petscbagcreate_ PETSCBAGCREATE
19: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
20: #define petscbaggetdata_ petscbaggetdata
21: #define petscbagregisterint_ petscbagregisterint
22: #define petscbagregisterint64_ petscbagregisterint64
23: #define petscbagregisterintarray_ petscbagregisterintarray
24: #define petscbagregisterscalar_ petscbagregisterscalar
25: #define petscbagregisterstring_ petscbagregisterstring
26: #define petscbagregisterreal_ petscbagregisterreal
27: #define petscbagregisterrealarray_ petscbagregisterrealarray
28: #define petscbagregisterbool_ petscbagregisterbool
29: #define petscbagregisterboolarray_ petscbagregisterboolarray
30: #define petscbagcreate_ petscbagcreate
31: #endif
33: PETSC_EXTERN void petscbagcreate_(MPI_Fint *comm, size_t *bagsize, PetscBag *bag, PetscErrorCode *ierr)
34: {
35: *ierr = PetscBagCreate(MPI_Comm_f2c(*(comm)), *bagsize, bag);
36: }
38: PETSC_EXTERN void petscbagregisterint_(PetscBag *bag, void *ptr, PetscInt *def, char *s1, char *s2, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T l1, PETSC_FORTRAN_CHARLEN_T l2)
39: {
40: char *t1, *t2;
41: FIXCHAR(s1, l1, t1);
42: FIXCHAR(s2, l2, t2);
43: *ierr = PetscBagRegisterInt(*bag, ptr, *def, t1, t2);
44: if (*ierr) return;
45: FREECHAR(s1, t1);
46: FREECHAR(s2, t2);
47: }
49: PETSC_EXTERN void petscbagregisterint64_(PetscBag *bag, void *ptr, PetscInt64 *def, char *s1, char *s2, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T l1, PETSC_FORTRAN_CHARLEN_T l2)
50: {
51: char *t1, *t2;
52: FIXCHAR(s1, l1, t1);
53: FIXCHAR(s2, l2, t2);
54: *ierr = PetscBagRegisterInt64(*bag, ptr, *def, t1, t2);
55: if (*ierr) return;
56: FREECHAR(s1, t1);
57: FREECHAR(s2, t2);
58: }
60: PETSC_EXTERN void petscbagregisterintarray_(PetscBag *bag, void *ptr, PetscInt *msize, char *s1, char *s2, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T l1, PETSC_FORTRAN_CHARLEN_T l2)
61: {
62: char *t1, *t2;
63: FIXCHAR(s1, l1, t1);
64: FIXCHAR(s2, l2, t2);
65: *ierr = PetscBagRegisterIntArray(*bag, ptr, *msize, t1, t2);
66: if (*ierr) return;
67: FREECHAR(s1, t1);
68: FREECHAR(s2, t2);
69: }
71: PETSC_EXTERN void petscbagregisterscalar_(PetscBag *bag, void *ptr, PetscScalar *def, char *s1, char *s2, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T l1, PETSC_FORTRAN_CHARLEN_T l2)
72: {
73: char *t1, *t2;
74: FIXCHAR(s1, l1, t1);
75: FIXCHAR(s2, l2, t2);
76: *ierr = PetscBagRegisterScalar(*bag, ptr, *def, t1, t2);
77: if (*ierr) return;
78: FREECHAR(s1, t1);
79: FREECHAR(s2, t2);
80: }
82: PETSC_EXTERN void petscbagregisterreal_(PetscBag *bag, void *ptr, PetscReal *def, char *s1, char *s2, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T l1, PETSC_FORTRAN_CHARLEN_T l2)
83: {
84: char *t1, *t2;
85: FIXCHAR(s1, l1, t1);
86: FIXCHAR(s2, l2, t2);
87: *ierr = PetscBagRegisterReal(*bag, ptr, *def, t1, t2);
88: if (*ierr) return;
89: FREECHAR(s1, t1);
90: FREECHAR(s2, t2);
91: }
93: PETSC_EXTERN void petscbagregisterrealarray_(PetscBag *bag, void *ptr, PetscInt *msize, char *s1, char *s2, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T l1, PETSC_FORTRAN_CHARLEN_T l2)
94: {
95: char *t1, *t2;
96: FIXCHAR(s1, l1, t1);
97: FIXCHAR(s2, l2, t2);
98: *ierr = PetscBagRegisterRealArray(*bag, ptr, *msize, t1, t2);
99: if (*ierr) return;
100: FREECHAR(s1, t1);
101: FREECHAR(s2, t2);
102: }
104: PETSC_EXTERN void petscbagregisterbool_(PetscBag *bag, void *ptr, PetscBool *def, char *s1, char *s2, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T l1, PETSC_FORTRAN_CHARLEN_T l2)
105: {
106: char *t1, *t2;
107: PetscBool flg = PETSC_FALSE;
109: /* some Fortran compilers use -1 as boolean */
110: if (*def) flg = PETSC_TRUE;
111: FIXCHAR(s1, l1, t1);
112: FIXCHAR(s2, l2, t2);
113: *ierr = PetscBagRegisterBool(*bag, ptr, flg, t1, t2);
114: if (*ierr) return;
115: FREECHAR(s1, t1);
116: FREECHAR(s2, t2);
117: }
119: PETSC_EXTERN void petscbagregisterboolarray_(PetscBag *bag, void *ptr, PetscInt *msize, char *s1, char *s2, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T l1, PETSC_FORTRAN_CHARLEN_T l2)
120: {
121: char *t1, *t2;
123: /* some Fortran compilers use -1 as boolean */
124: FIXCHAR(s1, l1, t1);
125: FIXCHAR(s2, l2, t2);
126: *ierr = PetscBagRegisterBoolArray(*bag, ptr, *msize, t1, t2);
127: if (*ierr) return;
128: FREECHAR(s1, t1);
129: FREECHAR(s2, t2);
130: }
132: PETSC_EXTERN void petscbagregisterstring_(PetscBag *bag, char *p, char *cs1, char *s1, char *s2, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T pl, PETSC_FORTRAN_CHARLEN_T cl1, PETSC_FORTRAN_CHARLEN_T l1, PETSC_FORTRAN_CHARLEN_T l2)
133: {
134: char *t1, *t2, *ct1;
135: FIXCHAR(s1, l1, t1);
136: FIXCHAR(cs1, cl1, ct1);
137: FIXCHAR(s2, l2, t2);
138: *ierr = PetscBagRegisterString(*bag, (void *)p, (PetscInt)pl, ct1, t1, t2);
139: if (*ierr) return;
140: FREECHAR(cs1, ct1);
141: FREECHAR(s1, t1);
142: FREECHAR(s2, t2);
143: }
145: PETSC_EXTERN void petscbaggetdata_(PetscBag *bag, void **data, PetscErrorCode *ierr)
146: {
147: *ierr = PetscBagGetData(*bag, data);
148: }