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 petscsles.h
5: #include petscda.h
7: #ifdef PETSC_HAVE_FORTRAN_CAPS
8: #define slesdestroy_ SLESDESTROY
9: #define slescreate_ SLESCREATE
10: #define slesgetpc_ SLESGETPC
11: #define slessetoptionsprefix_ SLESSETOPTIONSPREFIX
12: #define slesappendoptionsprefix_ SLESAPPENDOPTIONSPREFIX
13: #define slesgetksp_ SLESGETKSP
14: #define slesgetoptionsprefix_ SLESGETOPTIONSPREFIX
15: #define slesview_ SLESVIEW
16: #define dmmgcreate_ DMMGCREATE
17: #define dmmgdestroy_ DMMGDESTROY
18: #define dmmgsetup_ DMMGSETUP
19: #define dmmgsetdm_ DMMGSETDM
20: #define dmmgview_ DMMGVIEW
21: #define dmmgsolve_ DMMGSOLVE
22: #define dmmggetda_ DMMGGETDA
23: #define dmmgsetsles_ DMMGSETSLES
24: #define dmmggetx_ DMMGGETX
25: #define dmmggetj_ DMMGGETJ
26: #define dmmggetb_ DMMGGETB
27: #define dmmggetsles_ DMMGGETSLES
28: #define dmmggetlevels_ DMMGGETLEVELS
29: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
30: #define dmmggetx_ dmmggetx
31: #define dmmggetj_ dmmggetj
32: #define dmmggetb_ dmmggetb
33: #define dmmggetsles_ dmmggetsles
34: #define dmmggetda_ dmmggetda
35: #define dmmggetlevels_ dmmggetlevels
36: #define dmmgsetsles_ dmmgsetsles
37: #define dmmgdestroy_ dmmgdestroy
38: #define dmmgcreate_ dmmgcreate
39: #define dmmgsetup_ dmmgsetup
40: #define slessetoptionsprefix_ slessetoptionsprefix
41: #define slesappendoptionsprefix_ slesappendoptionsprefix
42: #define slesdestroy_ slesdestroy
43: #define slescreate_ slescreate
44: #define slesgetpc_ slesgetpc
45: #define slesgetksp_ slesgetksp
46: #define slesgetoptionsprefix_ slesgetoptionsprefix
47: #define slesview_ slesview
48: #define dmmgsetdm_ dmmgsetdm
49: #define dmmgview_ dmmgview
50: #define dmmgsolve_ dmmgsolve
51: #endif
53: EXTERN_C_BEGIN
55: void PETSC_STDCALL dmmggetx_(DMMG **dmmg,Vec *x,int *ierr)
56: {
57: *0;
58: *x = DMMGGetx(*dmmg);
59: }
61: void PETSC_STDCALL dmmggetj_(DMMG **dmmg,Mat *x,int *ierr)
62: {
63: *0;
64: *x = DMMGGetJ(*dmmg);
65: }
67: void PETSC_STDCALL dmmggetB_(DMMG **dmmg,Mat *x,int *ierr)
68: {
69: *0;
70: *x = DMMGGetB(*dmmg);
71: }
73: void PETSC_STDCALL dmmggetsles_(DMMG **dmmg,SLES *x,int *ierr)
74: {
75: *0;
76: *x = DMMGGetSLES(*dmmg);
77: }
79: void PETSC_STDCALL dmmggetlevels_(DMMG **dmmg,int *x,int *ierr)
80: {
81: *0;
82: *x = DMMGGetLevels(*dmmg);
83: }
85: /* ----------------------------------------------------------------------------------------------------------*/
86: static int ourrhs(DMMG dmmg,Vec vec)
87: {
88: int 0;
89: (*(int (PETSC_STDCALL *)(DMMG*,Vec*,int*))(((PetscObject)dmmg->dm)->fortran_func_pointers[0]))(&dmmg,&vec,&ierr);
90: return ierr;
91: }
93: /*
94: Since DMMGSetSLES() immediately calls the matrix functions for each level we do not need to store
95: the mat() function inside the DMMG object
96: */
97: static int (PETSC_STDCALL *theirmat)(DMMG*,Mat*,int*);
98: static int ourmat(DMMG dmmg,Mat mat)
99: {
100: int 0;
101: (*theirmat)(&dmmg,&mat,&ierr);
102: return ierr;
103: }
105: void PETSC_STDCALL dmmgsetsles_(DMMG **dmmg,int (PETSC_STDCALL *rhs)(DMMG*,Vec*,int*),int (PETSC_STDCALL *mat)(DMMG*,Mat*,int*),int *ierr)
106: {
107: int i;
108: theirmat = mat;
109: *DMMGSetSLES(*dmmg,ourrhs,ourmat);
110: /*
111: Save the fortran rhs function in the DM on each level; ourrhs() pulls it out when needed
112: */
113: for (i=0; i<(**dmmg)->nlevels; i++) {
114: ((PetscObject)(*dmmg)[i]->dm)->fortran_func_pointers[0] = (void (*)(void))rhs;
115: }
116: }
118: /* ----------------------------------------------------------------------------------------------------------*/
120: void PETSC_STDCALL dmmggetda_(DMMG *dmmg,DA *da,int *ierr)
121: {
122: *da = (DA)(*dmmg)->dm;
123: *0;
124: }
126: void PETSC_STDCALL dmmgsetdm_(DMMG **dmmg,DM *dm,int *ierr)
127: {
128: int i;
129: *DMMGSetDM(*dmmg,*dm);if (*ierr) return;
130: /* loop over the levels added a place to hang the function pointers in the DM for each level*/
131: for (i=0; i<(**dmmg)->nlevels; i++) {
132: *PetscMalloc(3*sizeof(void (*)(void)),&((PetscObject)(*dmmg)[i]->dm)->fortran_func_pointers);if (*ierr) return;
133: }
134: }
136: void PETSC_STDCALL dmmgview_(DMMG **dmmg,PetscViewer *viewer,int *ierr)
137: {
138: *DMMGView(*dmmg,*viewer);
139: }
141: void PETSC_STDCALL dmmgsolve_(DMMG **dmmg,int *ierr)
142: {
143: *DMMGSolve(*dmmg);
144: }
146: void PETSC_STDCALL dmmgcreate_(MPI_Comm *comm,int *nlevels,void *user,DMMG **dmmg,int *ierr)
147: {
148: *DMMGCreate((MPI_Comm)PetscToPointerComm(*comm),*nlevels,user,dmmg);
149: }
151: void PETSC_STDCALL dmmgdestroy_(DMMG **dmmg,int *ierr)
152: {
153: *DMMGDestroy(*dmmg);
154: }
156: void PETSC_STDCALL dmmgsetup_(DMMG **dmmg,int *ierr)
157: {
158: *DMMGSetUp(*dmmg);
159: }
161: void PETSC_STDCALL slesview_(SLES *sles,PetscViewer *viewer, int *ierr)
162: {
163: PetscViewer v;
164: PetscPatchDefaultViewers_Fortran(viewer,v);
165: *SLESView(*sles,v);
166: }
168: void PETSC_STDCALL slessetoptionsprefix_(SLES *sles,CHAR prefix PETSC_MIXED_LEN(len),
169: int *ierr PETSC_END_LEN(len))
170: {
171: char *t;
173: FIXCHAR(prefix,len,t);
174: *SLESSetOptionsPrefix(*sles,t);
175: FREECHAR(prefix,t);
176: }
178: void PETSC_STDCALL slesappendoptionsprefix_(SLES *sles,CHAR prefix PETSC_MIXED_LEN(len),
179: int *ierr PETSC_END_LEN(len))
180: {
181: char *t;
183: FIXCHAR(prefix,len,t);
184: *SLESAppendOptionsPrefix(*sles,t);
185: FREECHAR(prefix,t);
186: }
188: void PETSC_STDCALL slesgetksp_(SLES *sles,KSP *ksp,int *ierr)
189: {
190: *SLESGetKSP(*sles,ksp);
191: }
193: void PETSC_STDCALL slesgetpc_(SLES *sles,PC *pc,int *ierr)
194: {
195: *SLESGetPC(*sles,pc);
196: }
198: void PETSC_STDCALL slesdestroy_(SLES *sles,int *ierr)
199: {
200: *SLESDestroy(*sles);
201: }
203: void PETSC_STDCALL slescreate_(MPI_Comm *comm,SLES *outsles,int *ierr)
204: {
205: *SLESCreate((MPI_Comm)PetscToPointerComm(*comm),outsles);
207: }
209: void PETSC_STDCALL slesgetoptionsprefix_(SLES *sles,CHAR prefix PETSC_MIXED_LEN(len),
210: int *ierr PETSC_END_LEN(len))
211: {
212: char *tname;
214: *SLESGetOptionsPrefix(*sles,&tname);
215: #if defined(PETSC_USES_CPTOFCD)
216: {
217: char *t = _fcdtocp(prefix); int len1 = _fcdlen(prefix);
218: *PetscStrncpy(t,tname,len1);
219: }
220: #else
221: *PetscStrncpy(prefix,tname,len);
222: #endif
223: }
225: EXTERN_C_END