Actual source code: f90_cwrap.c

  1: #include "src/sys/f90/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: /*************************************************************************/