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: /*************************************************************************/