Actual source code: f90_cwrap.c
1: #include "f90impl.h"
3: /*************************************************************************/
5: #if defined(PETSC_HAVE_FORTRAN_CAPS)
6: #define f90array1dcreatescalar_ F90ARRAY1DCREATESCALAR
7: #define f90array1daccessscalar_ F90ARRAY1DACCESSSCALAR
8: #define f90array1ddestroyscalar_ F90ARRAY1DDESTROYSCALAR
9: #define f90array1dcreatereal_ F90ARRAY1DCREATEREAL
10: #define f90array1daccessreal_ F90ARRAY1DACCESSREAL
11: #define f90array1ddestroyreal_ F90ARRAY1DDESTROYREAL
12: #define f90array1dcreateint_ F90ARRAY1DCREATEINT
13: #define f90array1daccessint_ F90ARRAY1DACCESSINT
14: #define f90array1ddestroyint_ F90ARRAY1DDESTROYINT
15: #define f90array1dcreatefortranaddr_ F90ARRAY1DCREATEFORTRANADDR
16: #define f90array1daccessfortranaddr_ F90ARRAY1DACCESSFORTRANADDR
17: #define f90array1ddestroyfortranaddr_ F90ARRAY1DDESTROYFORTRANADDR
18: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
19: #define f90array1dcreatescalar_ f90array1dcreatescalar
20: #define f90array1daccessscalar_ f90array1daccessscalar
21: #define f90array1ddestroyscalar_ f90array1ddestroyscalar
22: #define f90array1dcreatereal_ f90array1dcreatereal
23: #define f90array1daccessreal_ f90array1daccessreal
24: #define f90array1ddestroyreal_ f90array1ddestroyreal
25: #define f90array1dcreateint_ f90array1dcreateint
26: #define f90array1daccessint_ f90array1daccessint
27: #define f90array1ddestroyint_ f90array1ddestroyint
28: #define f90array1dcreatefortranaddr_ f90array1dcreatefortranaddr
29: #define f90array1daccessfortranaddr_ f90array1daccessfortranaddr
30: #define f90array1ddestroyfortranaddr_ f90array1ddestroyfortranaddr
31: #endif
50: PetscErrorCode F90Array1dCreate(void *array,PetscDataType type,PetscInt start,PetscInt len,F90Array1d *ptr PETSC_F90_2PTR_PROTO(ptrd))
51: {
53: if (type == PETSC_SCALAR) {
54: f90array1dcreatescalar_(array,&start,&len,ptr PETSC_F90_2PTR_PARAM(ptrd));
55: } else if (type == PETSC_REAL) {
56: f90array1dcreatereal_(array,&start,&len,ptr PETSC_F90_2PTR_PARAM(ptrd));
57: } else if (type == PETSC_INT) {
58: f90array1dcreateint_(array,&start,&len,ptr PETSC_F90_2PTR_PARAM(ptrd));
59: } else if (type == PETSC_FORTRANADDR) {
60: f90array1dcreatefortranaddr_(array,&start,&len,ptr PETSC_F90_2PTR_PARAM(ptrd));
61: } else {
62: SETERRQ1(PETSC_ERR_SUP,"unsupported PetscDataType: %d",(PetscInt)type);
63: }
64: return(0);
65: }
69: PetscErrorCode F90Array1dAccess(F90Array1d *ptr,PetscDataType type,void **array PETSC_F90_2PTR_PROTO(ptrd))
70: {
72: if (type == PETSC_SCALAR) {
73: f90array1daccessscalar_(ptr,array PETSC_F90_2PTR_PARAM(ptrd));
74: } else if (type == PETSC_REAL) {
75: f90array1daccessreal_(ptr,array PETSC_F90_2PTR_PARAM(ptrd));
76: } else if (type == PETSC_INT) {
77: f90array1daccessint_(ptr,array PETSC_F90_2PTR_PARAM(ptrd));
78: } else if (type == PETSC_FORTRANADDR) {
79: f90array1daccessfortranaddr_(ptr,array PETSC_F90_2PTR_PARAM(ptrd));
80: } else {
81: SETERRQ1(PETSC_ERR_SUP,"unsupported PetscDataType: %d",(PetscInt)type);
82: }
83: return(0);
84: }
88: PetscErrorCode F90Array1dDestroy(F90Array1d *ptr,PetscDataType type PETSC_F90_2PTR_PROTO(ptrd))
89: {
91: if (type == PETSC_SCALAR) {
92: f90array1ddestroyscalar_(ptr PETSC_F90_2PTR_PARAM(ptrd));
93: } else if (type == PETSC_REAL) {
94: f90array1ddestroyreal_(ptr PETSC_F90_2PTR_PARAM(ptrd));
95: } else if (type == PETSC_INT) {
96: f90array1ddestroyint_(ptr PETSC_F90_2PTR_PARAM(ptrd));
97: } else if (type == PETSC_FORTRANADDR) {
98: f90array1ddestroyfortranaddr_(ptr PETSC_F90_2PTR_PARAM(ptrd));
99: } else {
100: SETERRQ1(PETSC_ERR_SUP,"unsupported PetscDataType: %d",(PetscInt)type);
101: }
102: return(0);
103: }
105: /*************************************************************************/
107: #if defined(PETSC_HAVE_FORTRAN_CAPS)
108: #define f90array2dcreatescalar_ F90ARRAY2DCREATESCALAR
109: #define f90array2daccessscalar_ F90ARRAY2DACCESSSCALAR
110: #define f90array2ddestroyscalar_ F90ARRAY2DDESTROYSCALAR
111: #define f90array2dcreatereal_ F90ARRAY2DCREATEREAL
112: #define f90array2daccessreal_ F90ARRAY2DACCESSREAL
113: #define f90array2ddestroyreal_ F90ARRAY2DDESTROYREAL
114: #define f90array2dcreateint_ F90ARRAY2DCREATEINT
115: #define f90array2daccessint_ F90ARRAY2DACCESSINT
116: #define f90array2ddestroyint_ F90ARRAY2DDESTROYINT
117: #define f90array2dcreatefortranaddr_ F90ARRAY2DCREATEFORTRANADDR
118: #define f90array2daccessfortranaddr_ F90ARRAY2DACCESSFORTRANADDR
119: #define f90array2ddestroyfortranaddr_ F90ARRAY2DDESTROYFORTRANADDR
120: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
121: #define f90array2dcreatescalar_ f90array2dcreatescalar
122: #define f90array2daccessscalar_ f90array2daccessscalar
123: #define f90array2ddestroyscalar_ f90array2ddestroyscalar
124: #define f90array2dcreatereal_ f90array2dcreatereal
125: #define f90array2daccessreal_ f90array2daccessreal
126: #define f90array2ddestroyreal_ f90array2ddestroyreal
127: #define f90array2dcreateint_ f90array2dcreateint
128: #define f90array2daccessint_ f90array2daccessint
129: #define f90array2ddestroyint_ f90array2ddestroyint
130: #define f90array2dcreatefortranaddr_ f90array2dcreatefortranaddr
131: #define f90array2daccessfortranaddr_ f90array2daccessfortranaddr
132: #define f90array2ddestroyfortranaddr_ f90array2ddestroyfortranaddr
133: #endif
152: PetscErrorCode F90Array2dCreate(void *array,PetscDataType type,PetscInt start1,PetscInt len1,PetscInt start2,PetscInt len2,F90Array2d *ptr PETSC_F90_2PTR_PROTO(ptrd))
153: {
155: if (type == PETSC_SCALAR) {
156: f90array2dcreatescalar_(array,&start1,&len1,&start2,&len2,ptr PETSC_F90_2PTR_PARAM(ptrd));
157: } else if (type == PETSC_REAL) {
158: f90array2dcreatereal_(array,&start1,&len1,&start2,&len2,ptr PETSC_F90_2PTR_PARAM(ptrd));
159: } else if (type == PETSC_INT) {
160: f90array2dcreateint_(array,&start1,&len1,&start2,&len2,ptr PETSC_F90_2PTR_PARAM(ptrd));
161: } else if (type == PETSC_FORTRANADDR) {
162: f90array2dcreatefortranaddr_(array,&start1,&len1,&start2,&len2,ptr PETSC_F90_2PTR_PARAM(ptrd));
163: } else {
164: SETERRQ1(PETSC_ERR_SUP,"unsupported PetscDataType: %d",(PetscInt)type);
165: }
166: return(0);
167: }
171: PetscErrorCode F90Array2dAccess(F90Array2d *ptr,PetscDataType type,void **array PETSC_F90_2PTR_PROTO(ptrd))
172: {
174: if (type == PETSC_SCALAR) {
175: f90array2daccessscalar_(ptr,array PETSC_F90_2PTR_PARAM(ptrd));
176: } else if (type == PETSC_REAL) {
177: f90array2daccessreal_(ptr,array PETSC_F90_2PTR_PARAM(ptrd));
178: } else if (type == PETSC_INT) {
179: f90array2daccessint_(ptr,array PETSC_F90_2PTR_PARAM(ptrd));
180: } else if (type == PETSC_FORTRANADDR) {
181: f90array2daccessfortranaddr_(ptr,array PETSC_F90_2PTR_PARAM(ptrd));
182: } else {
183: SETERRQ1(PETSC_ERR_SUP,"unsupported PetscDataType: %d",(PetscInt)type);
184: }
185: return(0);
186: }
190: PetscErrorCode F90Array2dDestroy(F90Array2d *ptr,PetscDataType type PETSC_F90_2PTR_PROTO(ptrd))
191: {
193: if (type == PETSC_SCALAR) {
194: f90array2ddestroyscalar_(ptr PETSC_F90_2PTR_PARAM(ptrd));
195: } else if (type == PETSC_REAL) {
196: f90array2ddestroyreal_(ptr PETSC_F90_2PTR_PARAM(ptrd));
197: } else if (type == PETSC_INT) {
198: f90array2ddestroyint_(ptr PETSC_F90_2PTR_PARAM(ptrd));
199: } else if (type == PETSC_FORTRANADDR) {
200: f90array2ddestroyfortranaddr_(ptr PETSC_F90_2PTR_PARAM(ptrd));
201: } else {
202: SETERRQ1(PETSC_ERR_SUP,"unsupported PetscDataType: %d",(PetscInt)type);
203: }
204: return(0);
205: }
207: /*************************************************************************/
208: #if defined(PETSC_HAVE_FORTRAN_CAPS)
209: #define f90array1dgetaddrscalar_ F90ARRAY1DGETADDRSCALAR
210: #define f90array1dgetaddrreal_ F90ARRAY1DGETADDRREAL
211: #define f90array1dgetaddrint_ F90ARRAY1DGETADDRINT
212: #define f90array1dgetaddrfortranaddr_ F90ARRAY1DGETADDRFORTRANADDR
213: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
214: #define f90array1dgetaddrscalar_ f90array1dgetaddrscalar
215: #define f90array1dgetaddrreal_ f90array1dgetaddrreal
216: #define f90array1dgetaddrint_ f90array1dgetaddrint
217: #define f90array1dgetaddrfortranaddr_ f90array1dgetaddrfortranaddr
218: #endif
221: void PETSC_STDCALL f90array1dgetaddrscalar_(void *array, PetscFortranAddr *address)
222: {
223: *address = (PetscFortranAddr)array;
224: }
225: void PETSC_STDCALL f90array1dgetaddrreal_(void *array, PetscFortranAddr *address)
226: {
227: *address = (PetscFortranAddr)array;
228: }
229: void PETSC_STDCALL f90array1dgetaddrint_(void *array, PetscFortranAddr *address)
230: {
231: *address = (PetscFortranAddr)array;
232: }
233: void PETSC_STDCALL f90array1dgetaddrfortranaddr_(void *array, PetscFortranAddr *address)
234: {
235: *address = (PetscFortranAddr)array;
236: }
239: /*************************************************************************/
240: #if defined(PETSC_HAVE_FORTRAN_CAPS)
241: #define f90array2dgetaddrscalar_ F90ARRAY2DGETADDRSCALAR
242: #define f90array2dgetaddrreal_ F90ARRAY2DGETADDRREAL
243: #define f90array2dgetaddrint_ F90ARRAY2DGETADDRINT
244: #define f90array2dgetaddrfortranaddr_ F90ARRAY2DGETADDRFORTRANADDR
245: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
246: #define f90array2dgetaddrscalar_ f90array2dgetaddrscalar
247: #define f90array2dgetaddrreal_ f90array2dgetaddrreal
248: #define f90array2dgetaddrint_ f90array2dgetaddrint
249: #define f90array2dgetaddrfortranaddr_ f90array2dgetaddrfortranaddr
250: #endif
253: void PETSC_STDCALL f90array2dgetaddrscalar_(void *array, PetscFortranAddr *address)
254: {
255: *address = (PetscFortranAddr)array;
256: }
257: void PETSC_STDCALL f90array2dgetaddrreal_(void *array, PetscFortranAddr *address)
258: {
259: *address = (PetscFortranAddr)array;
260: }
261: void PETSC_STDCALL f90array2dgetaddrint_(void *array, PetscFortranAddr *address)
262: {
263: *address = (PetscFortranAddr)array;
264: }
265: void PETSC_STDCALL f90array2dgetaddrfortranaddr_(void *array, PetscFortranAddr *address)
266: {
267: *address = (PetscFortranAddr)array;
268: }
271: /*************************************************************************/