Actual source code: zsles.c
1: /*$Id: zsles.c,v 1.37 2001/09/11 16:34:57 bsmith Exp $*/
3: #include src/fortran/custom/zpetsc.h
4: #include petscksp.h
5: #include petscda.h
7: #ifdef PETSC_HAVE_FORTRAN_CAPS
8: #define dmmgcreate_ DMMGCREATE
9: #define dmmgdestroy_ DMMGDESTROY
10: #define dmmgsetup_ DMMGSETUP
11: #define dmmgsetdm_ DMMGSETDM
12: #define dmmgview_ DMMGVIEW
13: #define dmmgsolve_ DMMGSOLVE
14: #define dmmggetda_ DMMGGETDA
15: #define dmmgsetksp_ DMMGSETKSP
16: #define dmmggetx_ DMMGGETX
17: #define dmmggetj_ DMMGGETJ
18: #define dmmggetb_ DMMGGETB
19: #define dmmggetksp_ DMMGGETKSP
20: #define dmmggetlevels_ DMMGGETLEVELS
21: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
22: #define dmmggetx_ dmmggetx
23: #define dmmggetj_ dmmggetj
24: #define dmmggetb_ dmmggetb
25: #define dmmggetksp_ dmmggetksp
26: #define dmmggetda_ dmmggetda
27: #define dmmggetlevels_ dmmggetlevels
28: #define dmmgsetksp_ dmmgsetksp
29: #define dmmgdestroy_ dmmgdestroy
30: #define dmmgcreate_ dmmgcreate
31: #define dmmgsetup_ dmmgsetup
32: #define dmmgsetdm_ dmmgsetdm
33: #define dmmgview_ dmmgview
34: #define dmmgsolve_ dmmgsolve
35: #endif
37: EXTERN_C_BEGIN
38: static int (PETSC_STDCALL *theirmat)(DMMG*,Mat*,int*);
39: EXTERN_C_END
41: static int ourrhs(DMMG dmmg,Vec vec)
42: {
43: int 0;
44: (*(int (PETSC_STDCALL *)(DMMG*,Vec*,int*))(((PetscObject)dmmg->dm)->fortran_func_pointers[0]))(&dmmg,&vec,&ierr);
45: return ierr;
46: }
48: /*
49: Since DMMGSetKSP() immediately calls the matrix functions for each level we do not need to store
50: the mat() function inside the DMMG object
51: */
52: static int ourmat(DMMG dmmg,Mat mat)
53: {
54: int 0;
55: (*theirmat)(&dmmg,&mat,&ierr);
56: return ierr;
57: }
59: EXTERN_C_BEGIN
61: void PETSC_STDCALL dmmggetx_(DMMG **dmmg,Vec *x,int *ierr)
62: {
63: *0;
64: *x = DMMGGetx(*dmmg);
65: }
67: void PETSC_STDCALL dmmggetj_(DMMG **dmmg,Mat *x,int *ierr)
68: {
69: *0;
70: *x = DMMGGetJ(*dmmg);
71: }
73: void PETSC_STDCALL dmmggetB_(DMMG **dmmg,Mat *x,int *ierr)
74: {
75: *0;
76: *x = DMMGGetB(*dmmg);
77: }
79: void PETSC_STDCALL dmmggetksp_(DMMG **dmmg,KSP *x,int *ierr)
80: {
81: *0;
82: *x = DMMGGetKSP(*dmmg);
83: }
85: void PETSC_STDCALL dmmggetlevels_(DMMG **dmmg,int *x,int *ierr)
86: {
87: *0;
88: *x = DMMGGetLevels(*dmmg);
89: }
91: /* ----------------------------------------------------------------------------------------------------------*/
93: void PETSC_STDCALL dmmgsetksp_(DMMG **dmmg,int (PETSC_STDCALL *rhs)(DMMG*,Vec*,int*),int (PETSC_STDCALL *mat)(DMMG*,Mat*,int*),int *ierr)
94: {
95: int i;
96: theirmat = mat;
97: *DMMGSetKSP(*dmmg,ourrhs,ourmat);
98: /*
99: Save the fortran rhs function in the DM on each level; ourrhs() pulls it out when needed
100: */
101: for (i=0; i<(**dmmg)->nlevels; i++) {
102: ((PetscObject)(*dmmg)[i]->dm)->fortran_func_pointers[0] = (FCNVOID)rhs;
103: }
104: }
106: /* ----------------------------------------------------------------------------------------------------------*/
108: void PETSC_STDCALL dmmggetda_(DMMG *dmmg,DA *da,int *ierr)
109: {
110: *da = (DA)(*dmmg)->dm;
111: *0;
112: }
114: void PETSC_STDCALL dmmgsetdm_(DMMG **dmmg,DM *dm,int *ierr)
115: {
116: int i;
117: *DMMGSetDM(*dmmg,*dm);if (*ierr) return;
118: /* loop over the levels added a place to hang the function pointers in the DM for each level*/
119: for (i=0; i<(**dmmg)->nlevels; i++) {
120: *PetscMalloc(3*sizeof(FCNVOID),&((PetscObject)(*dmmg)[i]->dm)->fortran_func_pointers);if (*ierr) return;
121: }
122: }
124: void PETSC_STDCALL dmmgview_(DMMG **dmmg,PetscViewer *viewer,int *ierr)
125: {
126: *DMMGView(*dmmg,*viewer);
127: }
129: void PETSC_STDCALL dmmgsolve_(DMMG **dmmg,int *ierr)
130: {
131: *DMMGSolve(*dmmg);
132: }
134: void PETSC_STDCALL dmmgcreate_(MPI_Comm *comm,int *nlevels,void *user,DMMG **dmmg,int *ierr)
135: {
136: *DMMGCreate((MPI_Comm)PetscToPointerComm(*comm),*nlevels,user,dmmg);
137: }
139: void PETSC_STDCALL dmmgdestroy_(DMMG **dmmg,int *ierr)
140: {
141: *DMMGDestroy(*dmmg);
142: }
144: void PETSC_STDCALL dmmgsetup_(DMMG **dmmg,int *ierr)
145: {
146: *DMMGSetUp(*dmmg);
147: }
149: EXTERN_C_END