Actual source code: zvectorf90.c
1: #include <petscvec.h>
2: #include <petsc/private/ftnimpl.h>
4: #if defined(PETSC_HAVE_FORTRAN_CAPS)
5: #define vecgetarraywrite_ VECGETARRAYWRITE
6: #define vecrestorearraywrite_ VECRESTOREARRAYWRITE
7: #define vecgetarray_ VECGETARRAY
8: #define vecrestorearray_ VECRESTOREARRAY
9: #define vecgetarrayread_ VECGETARRAYREAD
10: #define vecrestorearrayread_ VECRESTOREARRAYREAD
11: #define vecduplicatevecs_ VECDUPLICATEVECS
12: #define vecdestroyvecs_ VECDESTROYVECS
13: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
14: #define vecgetarraywrite_ vecgetarraywrite
15: #define vecrestorearraywrite_ vecrestorearraywrite
16: #define vecgetarray_ vecgetarray
17: #define vecrestorearray_ vecrestorearray
18: #define vecgetarrayread_ vecgetarrayread
19: #define vecrestorearrayread_ vecrestorearrayread
20: #define vecduplicatevecs_ vecduplicatevecs
21: #define vecdestroyvecs_ vecdestroyvecs
22: #endif
24: PETSC_EXTERN void vecgetarraywrite_(Vec *x, F90Array1d *ptr, int *ierr PETSC_F90_2PTR_PROTO(ptrd))
25: {
26: PetscScalar *fa;
27: PetscInt len;
28: if (!ptr) {
29: *ierr = PetscError(((PetscObject)*x)->comm, __LINE__, PETSC_FUNCTION_NAME, __FILE__, PETSC_ERR_ARG_BADPTR, PETSC_ERROR_INITIAL, "ptr==NULL, maybe #include <petsc/finclude/petscvec.h> is missing?");
30: return;
31: }
32: *ierr = VecGetArrayWrite(*x, &fa);
33: if (*ierr) return;
34: *ierr = VecGetLocalSize(*x, &len);
35: if (*ierr) return;
36: *ierr = F90Array1dCreate(fa, MPIU_SCALAR, 1, len, ptr PETSC_F90_2PTR_PARAM(ptrd));
37: }
39: PETSC_EXTERN void vecrestorearraywrite_(Vec *x, F90Array1d *ptr, int *ierr PETSC_F90_2PTR_PROTO(ptrd))
40: {
41: PetscScalar *fa;
42: *ierr = F90Array1dAccess(ptr, MPIU_SCALAR, (void **)&fa PETSC_F90_2PTR_PARAM(ptrd));
43: if (*ierr) return;
44: *ierr = F90Array1dDestroy(ptr, MPIU_SCALAR PETSC_F90_2PTR_PARAM(ptrd));
45: if (*ierr) return;
46: *ierr = VecRestoreArrayWrite(*x, &fa);
47: }
49: PETSC_EXTERN void vecgetarray_(Vec *x, F90Array1d *ptr, int *ierr PETSC_F90_2PTR_PROTO(ptrd))
50: {
51: PetscScalar *fa;
52: PetscInt len;
53: if (!ptr) {
54: *ierr = PetscError(((PetscObject)*x)->comm, __LINE__, PETSC_FUNCTION_NAME, __FILE__, PETSC_ERR_ARG_BADPTR, PETSC_ERROR_INITIAL, "ptr==NULL, maybe #include <petsc/finclude/petscvec.h> is missing?");
55: return;
56: }
57: *ierr = VecGetArray(*x, &fa);
58: if (*ierr) return;
59: *ierr = VecGetLocalSize(*x, &len);
60: if (*ierr) return;
61: *ierr = F90Array1dCreate(fa, MPIU_SCALAR, 1, len, ptr PETSC_F90_2PTR_PARAM(ptrd));
62: }
64: PETSC_EXTERN void vecrestorearray_(Vec *x, F90Array1d *ptr, int *ierr PETSC_F90_2PTR_PROTO(ptrd))
65: {
66: PetscScalar *fa;
67: *ierr = F90Array1dAccess(ptr, MPIU_SCALAR, (void **)&fa PETSC_F90_2PTR_PARAM(ptrd));
68: if (*ierr) return;
69: *ierr = F90Array1dDestroy(ptr, MPIU_SCALAR PETSC_F90_2PTR_PARAM(ptrd));
70: if (*ierr) return;
71: *ierr = VecRestoreArray(*x, &fa);
72: }
74: PETSC_EXTERN void vecgetarrayread_(Vec *x, F90Array1d *ptr, int *ierr PETSC_F90_2PTR_PROTO(ptrd))
75: {
76: const PetscScalar *fa;
77: PetscInt len;
78: if (!ptr) {
79: *ierr = PetscError(((PetscObject)*x)->comm, __LINE__, PETSC_FUNCTION_NAME, __FILE__, PETSC_ERR_ARG_BADPTR, PETSC_ERROR_INITIAL, "ptr==NULL, maybe #include <petsc/finclude/petscvec.h> is missing?");
80: return;
81: }
82: *ierr = VecGetArrayRead(*x, &fa);
83: if (*ierr) return;
84: *ierr = VecGetLocalSize(*x, &len);
85: if (*ierr) return;
86: *ierr = F90Array1dCreate((PetscScalar *)fa, MPIU_SCALAR, 1, len, ptr PETSC_F90_2PTR_PARAM(ptrd));
87: }
89: PETSC_EXTERN void vecrestorearrayread_(Vec *x, F90Array1d *ptr, int *ierr PETSC_F90_2PTR_PROTO(ptrd))
90: {
91: const PetscScalar *fa;
92: *ierr = F90Array1dAccess(ptr, MPIU_SCALAR, (void **)&fa PETSC_F90_2PTR_PARAM(ptrd));
93: if (*ierr) return;
94: *ierr = F90Array1dDestroy(ptr, MPIU_SCALAR PETSC_F90_2PTR_PARAM(ptrd));
95: if (*ierr) return;
96: *ierr = VecRestoreArrayRead(*x, &fa);
97: }
99: PETSC_EXTERN void vecduplicatevecs_(Vec *v, int *m, F90Array1d *ptr, int *ierr PETSC_F90_2PTR_PROTO(ptrd))
100: {
101: Vec *lV;
102: PetscFortranAddr *newvint;
103: int i;
104: *ierr = VecDuplicateVecs(*v, *m, &lV);
105: if (*ierr) return;
106: *ierr = PetscMalloc1(*m, &newvint);
107: if (*ierr) return;
109: for (i = 0; i < *m; i++) newvint[i] = (PetscFortranAddr)lV[i];
110: *ierr = PetscFree(lV);
111: if (*ierr) return;
112: *ierr = F90Array1dCreate(newvint, MPIU_FORTRANADDR, 1, *m, ptr PETSC_F90_2PTR_PARAM(ptrd));
113: }
115: PETSC_EXTERN void vecdestroyvecs_(int *m, F90Array1d *ptr, int *ierr PETSC_F90_2PTR_PROTO(ptrd))
116: {
117: Vec *vecs;
118: int i;
120: *ierr = F90Array1dAccess(ptr, MPIU_FORTRANADDR, (void **)&vecs PETSC_F90_2PTR_PARAM(ptrd));
121: if (*ierr) return;
122: for (i = 0; i < *m; i++) {
123: PETSC_FORTRAN_OBJECT_F_DESTROYED_TO_C_NULL(&vecs[i]);
124: *ierr = VecDestroy(&vecs[i]);
125: if (*ierr) return;
126: PETSC_FORTRAN_OBJECT_C_NULL_TO_F_DESTROYED(&vecs[i]);
127: }
128: *ierr = F90Array1dDestroy(ptr, MPIU_FORTRANADDR PETSC_F90_2PTR_PARAM(ptrd));
129: if (*ierr) return;
130: *ierr = PetscFree(vecs);
131: }