Actual source code: ex21.c

  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_INTERN void f90array1dcreatemystruct_(void *, PetscInt *, PetscInt *, F90Array1d *PETSC_F90_2PTR_PROTO_NOVAR);
 21: PETSC_INTERN void f90array1daccessmystruct_(F90Array1d *, void **PETSC_F90_2PTR_PROTO_NOVAR);
 22: PETSC_INTERN void f90array1ddestroymystruct_(F90Array1d *ptr PETSC_F90_2PTR_PROTO_NOVAR);

 24: PETSC_INTERN void f90array1dgetaddrmystruct_(void *array, PetscFortranAddr *address)
 25: {
 26:   *address = (PetscFortranAddr)array;
 27: }

 29: PETSC_INTERN void 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:     *__ierr = PetscError(((PetscObject)*x)->comm, __LINE__, PETSC_FUNCTION_NAME, __FILE__, PETSC_ERR_ARG_BADPTR, PETSC_ERROR_INITIAL, "ptr==NULL");
 35:     return;
 36:   }
 37:   *__ierr = VecGetArray(*x, &fa);
 38:   if (*__ierr) return;
 39:   *__ierr = VecGetLocalSize(*x, &len);
 40:   if (*__ierr) return;
 41:   f90array1dcreatemystruct_(fa, &one, &len, ptr PETSC_F90_2PTR_PARAM(ptrd));
 42: }

 44: PETSC_INTERN void vecrestorearraymystruct_(Vec *x, F90Array1d *ptr, int *__ierr PETSC_F90_2PTR_PROTO(ptrd))
 45: {
 46:   PetscScalar *fa;
 47:   f90array1daccessmystruct_(ptr, (void **)&fa PETSC_F90_2PTR_PARAM(ptrd));
 48:   f90array1ddestroymystruct_(ptr PETSC_F90_2PTR_PARAM(ptrd));
 49:   *__ierr = VecRestoreArray(*x, &fa);
 50: }