Date: 2025-03-29T05:58:55+00:00

Actual source code: ex21.c

      1: #include <petscvec.h>
      2: #include <petsc/private/ftnimpl.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: }