Actual source code: f90_cwrap.c
1: #include <../src/sys/f90-src/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: if (!len) array = PETSC_NULL_SCALAR_Fortran;
55: f90array1dcreatescalar_(array,&start,&len,ptr PETSC_F90_2PTR_PARAM(ptrd));
56: } else if (type == PETSC_REAL) {
57: if (!len) array = PETSC_NULL_REAL_Fortran;
58: f90array1dcreatereal_(array,&start,&len,ptr PETSC_F90_2PTR_PARAM(ptrd));
59: } else if (type == PETSC_INT) {
60: if (!len) array = PETSC_NULL_INTEGER_Fortran;
61: f90array1dcreateint_(array,&start,&len,ptr PETSC_F90_2PTR_PARAM(ptrd));
62: } else if (type == PETSC_FORTRANADDR) {
63: f90array1dcreatefortranaddr_(array,&start,&len,ptr PETSC_F90_2PTR_PARAM(ptrd));
64: } else {
65: SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"unsupported PetscDataType: %d",(PetscInt)type);
66: }
67: return(0);
68: }
72: PetscErrorCode F90Array1dAccess(F90Array1d *ptr,PetscDataType type,void **array PETSC_F90_2PTR_PROTO(ptrd))
73: {
75: if (type == PETSC_SCALAR) {
76: f90array1daccessscalar_(ptr,array PETSC_F90_2PTR_PARAM(ptrd));
77: } else if (type == PETSC_REAL) {
78: f90array1daccessreal_(ptr,array PETSC_F90_2PTR_PARAM(ptrd));
79: } else if (type == PETSC_INT) {
80: f90array1daccessint_(ptr,array PETSC_F90_2PTR_PARAM(ptrd));
81: } else if (type == PETSC_FORTRANADDR) {
82: f90array1daccessfortranaddr_(ptr,array PETSC_F90_2PTR_PARAM(ptrd));
83: } else {
84: SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"unsupported PetscDataType: %d",(PetscInt)type);
85: }
86: return(0);
87: }
91: PetscErrorCode F90Array1dDestroy(F90Array1d *ptr,PetscDataType type PETSC_F90_2PTR_PROTO(ptrd))
92: {
94: if (type == PETSC_SCALAR) {
95: f90array1ddestroyscalar_(ptr PETSC_F90_2PTR_PARAM(ptrd));
96: } else if (type == PETSC_REAL) {
97: f90array1ddestroyreal_(ptr PETSC_F90_2PTR_PARAM(ptrd));
98: } else if (type == PETSC_INT) {
99: f90array1ddestroyint_(ptr PETSC_F90_2PTR_PARAM(ptrd));
100: } else if (type == PETSC_FORTRANADDR) {
101: f90array1ddestroyfortranaddr_(ptr PETSC_F90_2PTR_PARAM(ptrd));
102: } else {
103: SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"unsupported PetscDataType: %d",(PetscInt)type);
104: }
105: return(0);
106: }
108: /*************************************************************************/
110: #if defined(PETSC_HAVE_FORTRAN_CAPS)
111: #define f90array2dcreatescalar_ F90ARRAY2DCREATESCALAR
112: #define f90array2daccessscalar_ F90ARRAY2DACCESSSCALAR
113: #define f90array2ddestroyscalar_ F90ARRAY2DDESTROYSCALAR
114: #define f90array2dcreatereal_ F90ARRAY2DCREATEREAL
115: #define f90array2daccessreal_ F90ARRAY2DACCESSREAL
116: #define f90array2ddestroyreal_ F90ARRAY2DDESTROYREAL
117: #define f90array2dcreateint_ F90ARRAY2DCREATEINT
118: #define f90array2daccessint_ F90ARRAY2DACCESSINT
119: #define f90array2ddestroyint_ F90ARRAY2DDESTROYINT
120: #define f90array2dcreatefortranaddr_ F90ARRAY2DCREATEFORTRANADDR
121: #define f90array2daccessfortranaddr_ F90ARRAY2DACCESSFORTRANADDR
122: #define f90array2ddestroyfortranaddr_ F90ARRAY2DDESTROYFORTRANADDR
123: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
124: #define f90array2dcreatescalar_ f90array2dcreatescalar
125: #define f90array2daccessscalar_ f90array2daccessscalar
126: #define f90array2ddestroyscalar_ f90array2ddestroyscalar
127: #define f90array2dcreatereal_ f90array2dcreatereal
128: #define f90array2daccessreal_ f90array2daccessreal
129: #define f90array2ddestroyreal_ f90array2ddestroyreal
130: #define f90array2dcreateint_ f90array2dcreateint
131: #define f90array2daccessint_ f90array2daccessint
132: #define f90array2ddestroyint_ f90array2ddestroyint
133: #define f90array2dcreatefortranaddr_ f90array2dcreatefortranaddr
134: #define f90array2daccessfortranaddr_ f90array2daccessfortranaddr
135: #define f90array2ddestroyfortranaddr_ f90array2ddestroyfortranaddr
136: #endif
155: PetscErrorCode F90Array2dCreate(void *array,PetscDataType type,PetscInt start1,PetscInt len1,PetscInt start2,PetscInt len2,F90Array2d *ptr PETSC_F90_2PTR_PROTO(ptrd))
156: {
158: if (type == PETSC_SCALAR) {
159: f90array2dcreatescalar_(array,&start1,&len1,&start2,&len2,ptr PETSC_F90_2PTR_PARAM(ptrd));
160: } else if (type == PETSC_REAL) {
161: f90array2dcreatereal_(array,&start1,&len1,&start2,&len2,ptr PETSC_F90_2PTR_PARAM(ptrd));
162: } else if (type == PETSC_INT) {
163: f90array2dcreateint_(array,&start1,&len1,&start2,&len2,ptr PETSC_F90_2PTR_PARAM(ptrd));
164: } else if (type == PETSC_FORTRANADDR) {
165: f90array2dcreatefortranaddr_(array,&start1,&len1,&start2,&len2,ptr PETSC_F90_2PTR_PARAM(ptrd));
166: } else {
167: SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"unsupported PetscDataType: %d",(PetscInt)type);
168: }
169: return(0);
170: }
174: PetscErrorCode F90Array2dAccess(F90Array2d *ptr,PetscDataType type,void **array PETSC_F90_2PTR_PROTO(ptrd))
175: {
177: if (type == PETSC_SCALAR) {
178: f90array2daccessscalar_(ptr,array PETSC_F90_2PTR_PARAM(ptrd));
179: } else if (type == PETSC_REAL) {
180: f90array2daccessreal_(ptr,array PETSC_F90_2PTR_PARAM(ptrd));
181: } else if (type == PETSC_INT) {
182: f90array2daccessint_(ptr,array PETSC_F90_2PTR_PARAM(ptrd));
183: } else if (type == PETSC_FORTRANADDR) {
184: f90array2daccessfortranaddr_(ptr,array PETSC_F90_2PTR_PARAM(ptrd));
185: } else {
186: SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"unsupported PetscDataType: %d",(PetscInt)type);
187: }
188: return(0);
189: }
193: PetscErrorCode F90Array2dDestroy(F90Array2d *ptr,PetscDataType type PETSC_F90_2PTR_PROTO(ptrd))
194: {
196: if (type == PETSC_SCALAR) {
197: f90array2ddestroyscalar_(ptr PETSC_F90_2PTR_PARAM(ptrd));
198: } else if (type == PETSC_REAL) {
199: f90array2ddestroyreal_(ptr PETSC_F90_2PTR_PARAM(ptrd));
200: } else if (type == PETSC_INT) {
201: f90array2ddestroyint_(ptr PETSC_F90_2PTR_PARAM(ptrd));
202: } else if (type == PETSC_FORTRANADDR) {
203: f90array2ddestroyfortranaddr_(ptr PETSC_F90_2PTR_PARAM(ptrd));
204: } else {
205: SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"unsupported PetscDataType: %d",(PetscInt)type);
206: }
207: return(0);
208: }
210: /*************************************************************************/
212: #if defined(PETSC_HAVE_FORTRAN_CAPS)
213: #define f90array3dcreatescalar_ F90ARRAY3DCREATESCALAR
214: #define f90array3daccessscalar_ F90ARRAY3DACCESSSCALAR
215: #define f90array3ddestroyscalar_ F90ARRAY3DDESTROYSCALAR
216: #define f90array3dcreatereal_ F90ARRAY3DCREATEREAL
217: #define f90array3daccessreal_ F90ARRAY3DACCESSREAL
218: #define f90array3ddestroyreal_ F90ARRAY3DDESTROYREAL
219: #define f90array3dcreateint_ F90ARRAY3DCREATEINT
220: #define f90array3daccessint_ F90ARRAY3DACCESSINT
221: #define f90array3ddestroyint_ F90ARRAY3DDESTROYINT
222: #define f90array3dcreatefortranaddr_ F90ARRAY3DCREATEFORTRANADDR
223: #define f90array3daccessfortranaddr_ F90ARRAY3DACCESSFORTRANADDR
224: #define f90array3ddestroyfortranaddr_ F90ARRAY3DDESTROYFORTRANADDR
225: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
226: #define f90array3dcreatescalar_ f90array3dcreatescalar
227: #define f90array3daccessscalar_ f90array3daccessscalar
228: #define f90array3ddestroyscalar_ f90array3ddestroyscalar
229: #define f90array3dcreatereal_ f90array3dcreatereal
230: #define f90array3daccessreal_ f90array3daccessreal
231: #define f90array3ddestroyreal_ f90array3ddestroyreal
232: #define f90array3dcreateint_ f90array3dcreateint
233: #define f90array3daccessint_ f90array3daccessint
234: #define f90array3ddestroyint_ f90array3ddestroyint
235: #define f90array3dcreatefortranaddr_ f90array3dcreatefortranaddr
236: #define f90array3daccessfortranaddr_ f90array3daccessfortranaddr
237: #define f90array3ddestroyfortranaddr_ f90array3ddestroyfortranaddr
238: #endif
257: PetscErrorCode F90Array3dCreate(void *array,PetscDataType type,PetscInt start1,PetscInt len1,PetscInt start2,PetscInt len2,PetscInt start3,PetscInt len3,F90Array3d *ptr PETSC_F90_2PTR_PROTO(ptrd))
258: {
260: if (type == PETSC_SCALAR) {
261: f90array3dcreatescalar_(array,&start1,&len1,&start2,&len2,&start3,&len3,ptr PETSC_F90_2PTR_PARAM(ptrd));
262: } else if (type == PETSC_REAL) {
263: f90array3dcreatereal_(array,&start1,&len1,&start2,&len2,&start3,&len3,ptr PETSC_F90_2PTR_PARAM(ptrd));
264: } else if (type == PETSC_INT) {
265: f90array3dcreateint_(array,&start1,&len1,&start2,&len2,&start3,&len3,ptr PETSC_F90_2PTR_PARAM(ptrd));
266: } else if (type == PETSC_FORTRANADDR) {
267: f90array3dcreatefortranaddr_(array,&start1,&len1,&start2,&len2,&start3,&len3,ptr PETSC_F90_2PTR_PARAM(ptrd));
268: } else {
269: SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"unsupported PetscDataType: %d",(PetscInt)type);
270: }
271: return(0);
272: }
276: PetscErrorCode F90Array3dAccess(F90Array3d *ptr,PetscDataType type,void **array PETSC_F90_2PTR_PROTO(ptrd))
277: {
279: if (type == PETSC_SCALAR) {
280: f90array3daccessscalar_(ptr,array PETSC_F90_2PTR_PARAM(ptrd));
281: } else if (type == PETSC_REAL) {
282: f90array3daccessreal_(ptr,array PETSC_F90_2PTR_PARAM(ptrd));
283: } else if (type == PETSC_INT) {
284: f90array3daccessint_(ptr,array PETSC_F90_2PTR_PARAM(ptrd));
285: } else if (type == PETSC_FORTRANADDR) {
286: f90array3daccessfortranaddr_(ptr,array PETSC_F90_2PTR_PARAM(ptrd));
287: } else {
288: SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"unsupported PetscDataType: %d",(PetscInt)type);
289: }
290: return(0);
291: }
295: PetscErrorCode F90Array3dDestroy(F90Array3d *ptr,PetscDataType type PETSC_F90_2PTR_PROTO(ptrd))
296: {
298: if (type == PETSC_SCALAR) {
299: f90array3ddestroyscalar_(ptr PETSC_F90_2PTR_PARAM(ptrd));
300: } else if (type == PETSC_REAL) {
301: f90array3ddestroyreal_(ptr PETSC_F90_2PTR_PARAM(ptrd));
302: } else if (type == PETSC_INT) {
303: f90array3ddestroyint_(ptr PETSC_F90_2PTR_PARAM(ptrd));
304: } else if (type == PETSC_FORTRANADDR) {
305: f90array3ddestroyfortranaddr_(ptr PETSC_F90_2PTR_PARAM(ptrd));
306: } else {
307: SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"unsupported PetscDataType: %d",(PetscInt)type);
308: }
309: return(0);
310: }
312: /*************************************************************************/
314: #if defined(PETSC_HAVE_FORTRAN_CAPS)
315: #define f90array4dcreatescalar_ F90ARRAY4DCREATESCALAR
316: #define f90array4ddestroyscalar_ F90ARRAY4DDESTROYSCALAR
317: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
318: #define f90array4dcreatescalar_ f90array4dcreatescalar
319: #define f90array4ddestroyscalar_ f90array4ddestroyscalar
320: #endif
329: PetscErrorCode F90Array4dCreate(void *array,PetscDataType type,PetscInt start1,PetscInt len1,PetscInt start2,PetscInt len2,PetscInt start3,PetscInt len3,PetscInt start4,PetscInt len4,F90Array4d *ptr PETSC_F90_2PTR_PROTO(ptrd))
330: {
332: if (type == PETSC_SCALAR) {
333: f90array4dcreatescalar_(array,&start1,&len1,&start2,&len2,&start3,&len3,&start4,&len4,ptr PETSC_F90_2PTR_PARAM(ptrd));
334: } else {
335: SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"unsupported PetscDataType: %d",(PetscInt)type);
336: }
337: return(0);
338: }
342: PetscErrorCode F90Array4dDestroy(F90Array4d *ptr,PetscDataType type PETSC_F90_2PTR_PROTO(ptrd))
343: {
345: if (type == PETSC_SCALAR) {
346: f90array4ddestroyscalar_(ptr PETSC_F90_2PTR_PARAM(ptrd));
347: } else {
348: SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"unsupported PetscDataType: %d",(PetscInt)type);
349: }
350: return(0);
351: }
353: /*************************************************************************/
354: #if defined(PETSC_HAVE_FORTRAN_CAPS)
355: #define f90array1dgetaddrscalar_ F90ARRAY1DGETADDRSCALAR
356: #define f90array1dgetaddrreal_ F90ARRAY1DGETADDRREAL
357: #define f90array1dgetaddrint_ F90ARRAY1DGETADDRINT
358: #define f90array1dgetaddrfortranaddr_ F90ARRAY1DGETADDRFORTRANADDR
359: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
360: #define f90array1dgetaddrscalar_ f90array1dgetaddrscalar
361: #define f90array1dgetaddrreal_ f90array1dgetaddrreal
362: #define f90array1dgetaddrint_ f90array1dgetaddrint
363: #define f90array1dgetaddrfortranaddr_ f90array1dgetaddrfortranaddr
364: #endif
367: void PETSC_STDCALL f90array1dgetaddrscalar_(void *array, PetscFortranAddr *address)
368: {
369: *address = (PetscFortranAddr)array;
370: }
371: void PETSC_STDCALL f90array1dgetaddrreal_(void *array, PetscFortranAddr *address)
372: {
373: *address = (PetscFortranAddr)array;
374: }
375: void PETSC_STDCALL f90array1dgetaddrint_(void *array, PetscFortranAddr *address)
376: {
377: *address = (PetscFortranAddr)array;
378: }
379: void PETSC_STDCALL f90array1dgetaddrfortranaddr_(void *array, PetscFortranAddr *address)
380: {
381: *address = (PetscFortranAddr)array;
382: }
385: /*************************************************************************/
386: #if defined(PETSC_HAVE_FORTRAN_CAPS)
387: #define f90array2dgetaddrscalar_ F90ARRAY2DGETADDRSCALAR
388: #define f90array2dgetaddrreal_ F90ARRAY2DGETADDRREAL
389: #define f90array2dgetaddrint_ F90ARRAY2DGETADDRINT
390: #define f90array2dgetaddrfortranaddr_ F90ARRAY2DGETADDRFORTRANADDR
391: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
392: #define f90array2dgetaddrscalar_ f90array2dgetaddrscalar
393: #define f90array2dgetaddrreal_ f90array2dgetaddrreal
394: #define f90array2dgetaddrint_ f90array2dgetaddrint
395: #define f90array2dgetaddrfortranaddr_ f90array2dgetaddrfortranaddr
396: #endif
399: void PETSC_STDCALL f90array2dgetaddrscalar_(void *array, PetscFortranAddr *address)
400: {
401: *address = (PetscFortranAddr)array;
402: }
403: void PETSC_STDCALL f90array2dgetaddrreal_(void *array, PetscFortranAddr *address)
404: {
405: *address = (PetscFortranAddr)array;
406: }
407: void PETSC_STDCALL f90array2dgetaddrint_(void *array, PetscFortranAddr *address)
408: {
409: *address = (PetscFortranAddr)array;
410: }
411: void PETSC_STDCALL f90array2dgetaddrfortranaddr_(void *array, PetscFortranAddr *address)
412: {
413: *address = (PetscFortranAddr)array;
414: }
417: /*************************************************************************/
418: #if defined(PETSC_HAVE_FORTRAN_CAPS)
419: #define f90array3dgetaddrscalar_ F90ARRAY3DGETADDRSCALAR
420: #define f90array3dgetaddrreal_ F90ARRAY3DGETADDRREAL
421: #define f90array3dgetaddrint_ F90ARRAY3DGETADDRINT
422: #define f90array3dgetaddrfortranaddr_ F90ARRAY3DGETADDRFORTRANADDR
423: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
424: #define f90array3dgetaddrscalar_ f90array3dgetaddrscalar
425: #define f90array3dgetaddrreal_ f90array3dgetaddrreal
426: #define f90array3dgetaddrint_ f90array3dgetaddrint
427: #define f90array3dgetaddrfortranaddr_ f90array3dgetaddrfortranaddr
428: #endif
431: void PETSC_STDCALL f90array3dgetaddrscalar_(void *array, PetscFortranAddr *address)
432: {
433: *address = (PetscFortranAddr)array;
434: }
435: void PETSC_STDCALL f90array3dgetaddrreal_(void *array, PetscFortranAddr *address)
436: {
437: *address = (PetscFortranAddr)array;
438: }
439: void PETSC_STDCALL f90array3dgetaddrint_(void *array, PetscFortranAddr *address)
440: {
441: *address = (PetscFortranAddr)array;
442: }
443: void PETSC_STDCALL f90array3dgetaddrfortranaddr_(void *array, PetscFortranAddr *address)
444: {
445: *address = (PetscFortranAddr)array;
446: }
449: /*************************************************************************/