Actual source code: zsles.c
2: #include src/fortran/custom/zpetsc.h
3: #include petscksp.h
4: #include petscda.h
5: #include petscdmmg.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 dmmggetrhs_ DMMGGETRHS
20: #define dmmggetksp_ DMMGGETKSP
21: #define dmmggetlevels_ DMMGGETLEVELS
22: #define dmmgsetinitialguess_ DMMGSETINITIALGUESS
23: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
24: #define dmmggetrhs_ dmmggetrhs
25: #define dmmggetx_ dmmggetx
26: #define dmmggetj_ dmmggetj
27: #define dmmggetb_ dmmggetb
28: #define dmmggetksp_ dmmggetksp
29: #define dmmggetda_ dmmggetda
30: #define dmmggetlevels_ dmmggetlevels
31: #define dmmgsetksp_ dmmgsetksp
32: #define dmmgdestroy_ dmmgdestroy
33: #define dmmgcreate_ dmmgcreate
34: #define dmmgsetup_ dmmgsetup
35: #define dmmgsetdm_ dmmgsetdm
36: #define dmmgview_ dmmgview
37: #define dmmgsolve_ dmmgsolve
38: #define dmmgsetinitialguess_ dmmgsetinitialguess
39: #endif
42: static void (PETSC_STDCALL *theirmat)(DMMG*,Mat*,PetscErrorCode*);
45: static PetscErrorCode ourrhs(DMMG dmmg,Vec vec)
46: {
47: PetscErrorCode 0;
48: (*(void (PETSC_STDCALL *)(DMMG*,Vec*,PetscErrorCode*))(((PetscObject)dmmg->dm)->fortran_func_pointers[0]))(&dmmg,&vec,&ierr);
49: return ierr;
50: }
52: static PetscErrorCode ourinitialguess(DMMG dmmg,Vec vec)
53: {
54: PetscErrorCode 0;
55: (*(void (PETSC_STDCALL *)(DMMG*,Vec*,PetscErrorCode*))(((PetscObject)dmmg->dm)->fortran_func_pointers[1]))(&dmmg,&vec,&ierr);
56: return ierr;
57: }
59: /*
60: Since DMMGSetKSP() immediately calls the matrix functions for each level we do not need to store
61: the mat() function inside the DMMG object
62: */
63: static PetscErrorCode ourmat(DMMG dmmg,Mat mat)
64: {
65: PetscErrorCode 0;
66: (*theirmat)(&dmmg,&mat,&ierr);
67: return ierr;
68: }
72: void PETSC_STDCALL dmmggetx_(DMMG **dmmg,Vec *x,PetscErrorCode *ierr)
73: {
74: *0;
75: *x = DMMGGetx(*dmmg);
76: }
78: void PETSC_STDCALL dmmggetj_(DMMG **dmmg,Mat *x,PetscErrorCode *ierr)
79: {
80: *0;
81: *x = DMMGGetJ(*dmmg);
82: }
84: void PETSC_STDCALL dmmggetb_(DMMG **dmmg,Mat *x,PetscErrorCode *ierr)
85: {
86: *0;
87: *x = DMMGGetB(*dmmg);
88: }
90: void PETSC_STDCALL dmmggetrhs_(DMMG **dmmg,Vec *x,PetscErrorCode *ierr)
91: {
92: *0;
93: *x = DMMGGetRHS(*dmmg);
94: }
96: void PETSC_STDCALL dmmggetksp_(DMMG **dmmg,KSP *x,PetscErrorCode *ierr)
97: {
98: *0;
99: *x = DMMGGetKSP(*dmmg);
100: }
102: void PETSC_STDCALL dmmggetlevels_(DMMG **dmmg,PetscInt *x,PetscErrorCode *ierr)
103: {
104: *0;
105: *x = DMMGGetLevels(*dmmg);
106: }
108: /* ----------------------------------------------------------------------------------------------------------*/
109: void PETSC_STDCALL dmmgsetinitialguess_(DMMG **dmmg,void (PETSC_STDCALL *initialguess)(DMMG*,Vec*,PetscErrorCode*),PetscErrorCode *ierr)
110: {
111: PetscInt i;
113: *DMMGSetInitialGuess(*dmmg,ourinitialguess);
114: /*
115: Save the fortran initial guess function in the DM on each level; ourinitialguess() pulls it out when needed
116: */
117: for (i=0; i<(**dmmg)->nlevels; i++) {
118: ((PetscObject)(*dmmg)[i]->dm)->fortran_func_pointers[1] = (FCNVOID)initialguess;
119: }
120: }
122: void PETSC_STDCALL dmmgsetksp_(DMMG **dmmg,void (PETSC_STDCALL *rhs)(DMMG*,Vec*,PetscErrorCode*),void (PETSC_STDCALL *mat)(DMMG*,Mat*,PetscErrorCode*),PetscErrorCode *ierr)
123: {
124: PetscInt i;
125: theirmat = mat;
126: *DMMGSetKSP(*dmmg,ourrhs,ourmat);
127: /*
128: Save the fortran rhs function in the DM on each level; ourrhs() pulls it out when needed
129: */
130: for (i=0; i<(**dmmg)->nlevels; i++) {
131: ((PetscObject)(*dmmg)[i]->dm)->fortran_func_pointers[0] = (FCNVOID)rhs;
132: }
133: }
135: /* ----------------------------------------------------------------------------------------------------------*/
137: void PETSC_STDCALL dmmggetda_(DMMG *dmmg,DA *da,PetscErrorCode *ierr)
138: {
139: *da = (DA)(*dmmg)->dm;
140: *0;
141: }
143: void PETSC_STDCALL dmmgsetdm_(DMMG **dmmg,DM *dm,PetscErrorCode *ierr)
144: {
145: PetscInt i;
146: *DMMGSetDM(*dmmg,*dm);if (*ierr) return;
147: /* loop over the levels added a place to hang the function pointers in the DM for each level*/
148: for (i=0; i<(**dmmg)->nlevels; i++) {
149: *PetscMalloc(4*sizeof(FCNVOID),&((PetscObject)(*dmmg)[i]->dm)->fortran_func_pointers);if (*ierr) return;
150: }
151: }
153: void PETSC_STDCALL dmmgview_(DMMG **dmmg,PetscViewer *viewer,PetscErrorCode *ierr)
154: {
155: *DMMGView(*dmmg,*viewer);
156: }
158: void PETSC_STDCALL dmmgsolve_(DMMG **dmmg,PetscErrorCode *ierr)
159: {
160: *DMMGSolve(*dmmg);
161: }
163: void PETSC_STDCALL dmmgcreate_(MPI_Comm *comm,PetscInt *nlevels,void *user,DMMG **dmmg,PetscErrorCode *ierr)
164: {
165: *DMMGCreate((MPI_Comm)PetscToPointerComm(*comm),*nlevels,user,dmmg);
166: }
168: void PETSC_STDCALL dmmgdestroy_(DMMG **dmmg,PetscErrorCode *ierr)
169: {
170: *DMMGDestroy(*dmmg);
171: }
173: void PETSC_STDCALL dmmgsetup_(DMMG **dmmg,PetscErrorCode *ierr)
174: {
175: *DMMGSetUp(*dmmg);
176: }