Actual source code: zf90vec.c
1: /*$Id: zf90vec.c,v 1.19 2001/08/07 03:05:21 balay Exp $*/
3: #include "petscis.h"
4: #include "petscvec.h"
5: #include "petscf90.h"
7: #ifdef PETSC_HAVE_FORTRAN_CAPS
8: #define isgetindicesf90_ ISGETINDICESF90
9: #define isblockgetindicesf90_ ISBLOCKGETINDICESF90
10: #define isrestoreindicesf90_ ISRESTOREINDICESF90
11: #define isblockrestoreindicesf90_ ISBLOCKRESTOREINDICESF90
12: #define iscoloringgetisf90_ ISCOLORINGGETISF90
13: #define iscoloringrestoreisf90_ ISCOLORINGRESTOREF90
14: #define vecgetarrayf90_ VECGETARRAYF90
15: #define vecrestorearrayf90_ VECRESTOREARRAYF90
16: #define vecduplicatevecsf90_ VECDUPLICATEVECSF90
17: #define vecdestroyvecsf90_ VECDESTROYVECSF90
18: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
19: #define isgetindicesf90_ isgetindicesf90
20: #define isblockgetindicesf90_ isblockgetindicesf90
21: #define isrestoreindicesf90_ isrestoreindicesf90
22: #define isblockrestoreindicesf90_ isblockrestoreindicesf90
23: #define iscoloringgetisf90_ iscoloringgetisf90
24: #define iscoloringrestoreisf90_ iscoloringrestoreisf90
25: #define vecgetarrayf90_ vecgetarrayf90
26: #define vecrestorearrayf90_ vecrestorearrayf90
27: #define vecduplicatevecsf90_ vecduplicatevecsf90
28: #define vecdestroyvecsf90_ vecdestroyvecsf90
29: #endif
31: EXTERN_C_BEGIN
33: /* --------------------------------------------------------------- */
35: void PETSC_STDCALL isgetindicesf90_(IS *x,F90Array1d *ptr,int *__ierr)
36: {
37: int *fa;
38: int len;
40: *__ISGetIndices(*x,&fa); if (*__ierr) return;
41: *__ISGetLocalSize(*x,&len); if (*__ierr) return;
42: *__F90Array1dCreate(fa,PETSC_INT,1,len,ptr);
43: }
44: void PETSC_STDCALL isrestoreindicesf90_(IS *x,F90Array1d *ptr,int *__ierr)
45: {
46: int *fa;
47: *__F90Array1dAccess(ptr,(void**)&fa);if (*__ierr) return;
48: *__F90Array1dDestroy(ptr);if (*__ierr) return;
49: *__ISRestoreIndices(*x,&fa);
50: }
52: void PETSC_STDCALL isblockgetindicesf90_(IS *x,F90Array1d *ptr,int *__ierr)
53: {
54: int *fa;
55: int len;
56: *__ISBlockGetIndices(*x,&fa); if (*__ierr) return;
57: *__ISBlockGetSize(*x,&len); if (*__ierr) return;
58: *__F90Array1dCreate(fa,PETSC_INT,1,len,ptr);
59: }
60: void PETSC_STDCALL isblockrestoreindicesf90_(IS *x,F90Array1d *ptr,int *__ierr)
61: {
62: int *fa;
63: *__F90Array1dAccess(ptr,(void**)&fa);if (*__ierr) return;
64: *__F90Array1dDestroy(ptr);if (*__ierr) return;
65: *__ISBlockRestoreIndices(*x,&fa);
66: }
69: void PETSC_STDCALL iscoloringgetisf90_(ISColoring *iscoloring,int *n,F90Array1d *ptr,int *__ierr)
70: {
71: IS *lis;
72: PetscFortranAddr *newisint;
73: int i;
74: *__ISColoringGetIS(*iscoloring,n,&lis); if (*__ierr) return;
75: *__PetscMalloc((*n)*sizeof(PetscFortranAddr),&newisint); if (*__ierr) return;
76: for (i=0; i<*n; i++) {
77: newisint[i] = (PetscFortranAddr)lis[i];
78: }
79: *__F90Array1dCreate(newisint,PETSC_FORTRANADDR,1,*n,ptr);
80: }
82: void PETSC_STDCALL iscoloringrestoreisf90_(ISColoring *iscoloring,F90Array1d *ptr,int *__ierr)
83: {
84: PetscFortranAddr *is;
86: *__F90Array1dAccess(ptr,(void**)&is);if (*__ierr) return;
87: *__F90Array1dDestroy(ptr);if (*__ierr) return;
88: *__ISColoringRestoreIS(*iscoloring,(IS **)is);if (*__ierr) return;
89: *__PetscFree(is);
90: }
92: /* ---------------------------------------------------------------*/
94: void PETSC_STDCALL vecgetarrayf90_(Vec *x,F90Array1d *ptr,int *__ierr)
95: {
96: PetscScalar *fa;
97: int len;
98: *__VecGetArray(*x,&fa); if (*__ierr) return;
99: *__VecGetLocalSize(*x,&len); if (*__ierr) return;
100: *__F90Array1dCreate(fa,PETSC_SCALAR,1,len,ptr);
101: }
102: void PETSC_STDCALL vecrestorearrayf90_(Vec *x,F90Array1d *ptr,int *__ierr)
103: {
104: PetscScalar *fa;
105: *__F90Array1dAccess(ptr,(void**)&fa);if (*__ierr) return;
106: *__F90Array1dDestroy(ptr);if (*__ierr) return;
107: *__VecRestoreArray(*x,&fa);
108: }
110: void PETSC_STDCALL vecduplicatevecsf90_(Vec *v,int *m,F90Array1d *ptr,int *__ierr)
111: {
112: Vec *lV;
113: PetscFortranAddr *newvint;
114: int i;
115: *__VecDuplicateVecs(*v,*m,&lV); if (*__ierr) return;
116: *__PetscMalloc((*m)*sizeof(PetscFortranAddr),&newvint); if (*__ierr) return;
118: for (i=0; i<*m; i++) {
119: newvint[i] = (PetscFortranAddr)lV[i];
120: }
121: *__PetscFree(lV); if (*__ierr) return;
122: *__F90Array1dCreate(newvint,PETSC_FORTRANADDR,1,*m,ptr);
123: }
125: void PETSC_STDCALL vecdestroyvecsf90_(F90Array1d *ptr,int *m,int *__ierr)
126: {
127: PetscFortranAddr *vecs;
128: int i;
130: *__F90Array1dAccess(ptr,(void**)&vecs);if (*__ierr) return;
131: for (i=0; i<*m; i++) {
132: *__VecDestroy((Vec)vecs[i]);
133: if (*__ierr) return;
134: }
135: *__F90Array1dDestroy(ptr);if (*__ierr) return;
136: *__PetscFree(vecs);
137: }
139: EXTERN_C_END