Actual source code: ex21.c
petsc-3.9.4 2018-09-11
1: #include <petscvec.h>
2: #include <petsc/private/f90impl.h>
4: #if defined(PETSC_HAVE_FORTRAN_CAPS)
5: #define vecgetarraymystruct_ VECGETARRAYMYSTRUCT
6: #define vecrestorearraymystruct_ VECRESTOREARRAYMYSTRUCT
7: #define f90array1dcreatemystruct_ F90ARRAY1DCREATEMYSTRUCT
8: #define f90array1daccessmystruct_ F90ARRAY1DACCESSMYSTRUCT
9: #define f90array1ddestroymystruct_ F90ARRAY1DDESTROYMYSTRUCT
10: #define f90array1dgetaddrmystruct_ F90ARRAY1DGETADDRMYSTRUCT
11: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
12: #define vecgetarraymystruct_ vecgetarraymystruct
13: #define vecrestorearraymystruct_ vecrestorearraymystruct
14: #define f90array1dcreatemystruct_ f90array1dcreatemystruct
15: #define f90array1daccessmystruct_ f90array1daccessmystruct
16: #define f90array1ddestroymystruct_ f90array1ddestroymystruct
17: #define f90array1dgetaddrmystruct_ f90array1dgetaddrmystruct
18: #endif
20: PETSC_EXTERN void PETSC_STDCALL f90array1dcreatemystruct_(void *,PetscInt *,PetscInt *,F90Array1d * PETSC_F90_2PTR_PROTO_NOVAR);
21: PETSC_EXTERN void PETSC_STDCALL f90array1daccessmystruct_(F90Array1d*,void** PETSC_F90_2PTR_PROTO_NOVAR);
22: PETSC_EXTERN void PETSC_STDCALL f90array1ddestroymystruct_(F90Array1d *ptr PETSC_F90_2PTR_PROTO_NOVAR);
24: PETSC_EXTERN void PETSC_STDCALL f90array1dgetaddrmystruct_(void *array, PetscFortranAddr *address)
25: {
26: *address = (PetscFortranAddr)array;
27: }
29: PETSC_EXTERN void PETSC_STDCALL vecgetarraymystruct_(Vec *x,F90Array1d *ptr,int *__ierr PETSC_F90_2PTR_PROTO(ptrd))
30: {
31: PetscScalar *fa;
32: PetscInt len,one = 1;
33: if (!ptr) {
34: *__PetscError(((PetscObject)*x)->comm,__LINE__,PETSC_FUNCTION_NAME,__FILE__,PETSC_ERR_ARG_BADPTR,PETSC_ERROR_INITIAL,"ptr==NULL");
35: return;
36: }
37: *__VecGetArray(*x,&fa); if (*__ierr) return;
38: *__VecGetLocalSize(*x,&len); if (*__ierr) return;
39: f90array1dcreatemystruct_(fa,&one,&len,ptr PETSC_F90_2PTR_PARAM(ptrd));
40: }
42: PETSC_EXTERN void PETSC_STDCALL vecrestorearraymystruct_(Vec *x,F90Array1d *ptr,int *__ierr PETSC_F90_2PTR_PROTO(ptrd))
43: {
44: PetscScalar *fa;
45: f90array1daccessmystruct_(ptr,(void**)&fa PETSC_F90_2PTR_PARAM(ptrd));
46: f90array1ddestroymystruct_(ptr PETSC_F90_2PTR_PARAM(ptrd));
47: *__VecRestoreArray(*x,&fa);
48: }