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