Actual source code: zksp.c
1: /*$Id: zksp.c,v 1.51 2001/03/28 19:43:08 balay Exp $*/
3: #include src/fortran/custom/zpetsc.h
4: #include petscksp.h
6: #ifdef PETSC_HAVE_FORTRAN_CAPS
7: #define kspgetresidualnorm_ KSPGETRESIDUALNORM
8: #define kspgetconvergedreason_ KSPGETCONVERGEDREASON
9: #define kspfgmressetmodifypc_ KSPFGMRESSETMODIFYPC
10: #define kspfgmresmodifypcsles_ KSPFGMRESMODIFYPCSLES
11: #define kspfgmresmodifypcnochange_ KSPFGMRESMODIFYPCNOCHANGE
12: #define kspdefaultconverged_ KSPDEFAULTCONVERGED
13: #define kspskipconverged_ KSPSKIPCONVERGED
14: #define kspdefaultmonitor_ KSPDEFAULTMONITOR
15: #define ksptruemonitor_ KSPTRUEMONITOR
16: #define kspvecviewmonitor_ KSPVECVIEWMONITOR
17: #define ksplgmonitor_ KSPLGMONITOR
18: #define ksplgtruemonitor_ KSPLGTRUEMONITOR
19: #define kspsingularvaluemonitor_ KSPSINGULARVALUEMONITOR
20: #define kspregisterdestroy_ KSPREGISTERDESTROY
21: #define kspdestroy_ KSPDESTROY
22: #define ksplgmonitordestroy_ KSPLGMONITORDESTROY
23: #define ksplgmonitorcreate_ KSPLGMONITORCREATE
24: #define kspgetrhs_ KSPGETRHS
25: #define kspgetsolution_ KSPGETSOLUTION
26: #define kspgetpc_ KSPGETPC
27: #define kspsetmonitor_ KSPSETMONITOR
28: #define kspsetconvergencetest_ KSPSETCONVERGENCETEST
29: #define kspcreate_ KSPCREATE
30: #define kspsetoptionsprefix_ KSPSETOPTIONSPREFIX
31: #define kspappendoptionsprefix_ KSPAPPENDOPTIONSPREFIX
32: #define kspgettype_ KSPGETTYPE
33: #define kspgetpreconditionerside_ KSPGETPRECONDITIONERSIDE
34: #define kspbuildsolution_ KSPBUILDSOLUTION
35: #define kspsettype_ KSPSETTYPE
36: #define kspgetresidualhistory_ KSPGETRESIDUALHISTORY
37: #define kspgetoptionsprefix_ KSPGETOPTIONSPREFIX
38: #define kspview_ KSPVIEW
39: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
40: #define kspgetconvergedreason_ kspgetconvergedreason
41: #define kspfgmressetmodifypc_ kspfgmressetmodifypc
42: #define kspfgmresmodifypcsles_ kspfgmresmodifypcsles
43: #define kspfgmresmodifypcnochange_ kspfgmresmodifypcnochange
44: #define kspdefaultconverged_ kspdefaultconverged
45: #define kspskipconverged_ kspskipconverged
46: #define kspsingularvaluemonitor_ kspsingularvaluemonitor
47: #define kspdefaultmonitor_ kspdefaultmonitor
48: #define ksptruemonitor_ ksptruemonitor
49: #define kspvecviewmonitor_ kspvecviewmonitor
50: #define ksplgmonitor_ ksplgmonitor
51: #define ksplgtruemonitor_ ksplgtruemonitor
52: #define kspgetresidualhistory_ kspgetresidualhistory
53: #define kspsettype_ kspsettype
54: #define kspregisterdestroy_ kspregisterdestroy
55: #define kspdestroy_ kspdestroy
56: #define ksplgmonitordestroy_ ksplgmonitordestroy
57: #define ksplgmonitorcreate_ ksplgmonitorcreate
58: #define kspgetrhs_ kspgetrhs
59: #define kspgetsolution_ kspgetsolution
60: #define kspgetpc_ kspgetpc
61: #define kspsetmonitor_ kspsetmonitor
62: #define kspsetconvergencetest_ kspsetconvergencetest
63: #define kspcreate_ kspcreate
64: #define kspsetoptionsprefix_ kspsetoptionsprefix
65: #define kspappendoptionsprefix_ kspappendoptionsprefix
66: #define kspgettype_ kspgettype
67: #define kspgetpreconditionerside_ kspgetpreconditionerside
68: #define kspbuildsolution_ kspbuildsolution
69: #define kspgetoptionsprefix_ kspgetoptionsprefix
70: #define kspview_ kspview
71: #define kspgetresidualnorm_ kspgetresidualnorm
72: #endif
74: EXTERN_C_BEGIN
76: void PETSC_STDCALL kspgetresidualnorm_(KSP *ksp,PetscReal *rnorm,int *ierr)
77: {
78: *KSPGetResidualNorm(*ksp,rnorm);
79: }
81: void PETSC_STDCALL kspgetconvergedreason_(KSP *ksp,KSPConvergedReason *reason,int *ierr)
82: {
83: *KSPGetConvergedReason(*ksp,reason);
84: }
86: /* function */
87: void PETSC_STDCALL kspview_(KSP *ksp,PetscViewer *viewer, int *ierr)
88: {
89: PetscViewer v;
90: PetscPatchDefaultViewers_Fortran(viewer,v);
91: *KSPView(*ksp,v);
92: }
94: void kspdefaultconverged_(KSP *ksp,int *n,double *rnorm,KSPConvergedReason *flag,void *dummy,int *ierr)
95: {
96: if (FORTRANNULLOBJECT(dummy)) dummy = PETSC_NULL;
97: *KSPDefaultConverged(*ksp,*n,*rnorm,flag,dummy);
98: }
100: void kspskipconverged_(KSP *ksp,int *n,double *rnorm,KSPConvergedReason *flag,void *dummy,int *ierr)
101: {
102: if (FORTRANNULLOBJECT(dummy)) dummy = PETSC_NULL;
103: *KSPSkipConverged(*ksp,*n,*rnorm,flag,dummy);
104: }
106: void PETSC_STDCALL kspgetresidualhistory_(KSP *ksp,int *na,int *ierr)
107: {
108: *KSPGetResidualHistory(*ksp,PETSC_NULL,na);
109: }
111: void PETSC_STDCALL kspsettype_(KSP *ksp,CHAR type PETSC_MIXED_LEN(len),int *ierr PETSC_END_LEN(len))
112: {
113: char *t;
115: FIXCHAR(type,len,t);
116: *KSPSetType(*ksp,t);
117: FREECHAR(type,t);
118: }
120: void PETSC_STDCALL kspgettype_(KSP *ksp,CHAR name PETSC_MIXED_LEN(len),int *ierr PETSC_END_LEN(len))
121: {
122: char *tname;
124: *KSPGetType(*ksp,&tname);if (*ierr) return;
125: #if defined(PETSC_USES_CPTOFCD)
126: {
127: char *t = _fcdtocp(name); int len1 = _fcdlen(name);
128: *PetscStrncpy(t,tname,len1);
129: }
130: #else
131: *PetscStrncpy(name,tname,len);
132: #endif
133: }
135: void PETSC_STDCALL kspgetpreconditionerside_(KSP *ksp,PCSide *side,int *ierr){
136: *KSPGetPreconditionerSide(*ksp,side);
137: }
139: void PETSC_STDCALL kspsetoptionsprefix_(KSP *ksp,CHAR prefix PETSC_MIXED_LEN(len),
140: int *ierr PETSC_END_LEN(len))
141: {
142: char *t;
144: FIXCHAR(prefix,len,t);
145: *KSPSetOptionsPrefix(*ksp,t);
146: FREECHAR(prefix,t);
147: }
149: void PETSC_STDCALL kspappendoptionsprefix_(KSP *ksp,CHAR prefix PETSC_MIXED_LEN(len),
150: int *ierr PETSC_END_LEN(len))
151: {
152: char *t;
154: FIXCHAR(prefix,len,t);
155: *KSPAppendOptionsPrefix(*ksp,t);
156: FREECHAR(prefix,t);
157: }
159: void PETSC_STDCALL kspcreate_(MPI_Comm *comm,KSP *ksp,int *ierr){
160: *KSPCreate((MPI_Comm)PetscToPointerComm(*comm),ksp);
161: }
163: static void (PETSC_STDCALL *f2)(KSP*,int*,double*,KSPConvergedReason*,void*,int*);
164: static int ourtest(KSP ksp,int i,double d,KSPConvergedReason *reason,void* ctx)
165: {
167: (*f2)(&ksp,&i,&d,reason,ctx,&ierr);
168: return 0;
169: }
170: void PETSC_STDCALL kspsetconvergencetest_(KSP *ksp,
171: void (PETSC_STDCALL *converge)(KSP*,int*,double*,KSPConvergedReason*,void*,int*),void *cctx,int *ierr)
172: {
173: if ((void(*)())converge == (void(*)())kspdefaultconverged_) {
174: *KSPSetConvergenceTest(*ksp,KSPDefaultConverged,0);
175: } else if ((void(*)())converge == (void(*)())kspskipconverged_) {
176: *KSPSetConvergenceTest(*ksp,KSPSkipConverged,0);
177: } else {
178: f2 = converge;
179: *KSPSetConvergenceTest(*ksp,ourtest,cctx);
180: }
181: }
183: /*
184: These are not usually called from Fortran but allow Fortran users
185: to transparently set these monitors from .F code
186:
187: functions, hence no STDCALL
188: */
189: void kspdefaultmonitor_(KSP *ksp,int *it,double *norm,void *ctx,int *ierr)
190: {
191: *KSPDefaultMonitor(*ksp,*it,*norm,ctx);
192: }
193:
194: void kspsingularvaluemonitor_(KSP *ksp,int *it,double *norm,void *ctx,int *ierr)
195: {
196: *KSPSingularValueMonitor(*ksp,*it,*norm,ctx);
197: }
199: void ksplgmonitor_(KSP *ksp,int *it,double *norm,void *ctx,int *ierr)
200: {
201: *KSPLGMonitor(*ksp,*it,*norm,ctx);
202: }
204: void ksplgtruemonitor_(KSP *ksp,int *it,double *norm,void *ctx,int *ierr)
205: {
206: *KSPLGTrueMonitor(*ksp,*it,*norm,ctx);
207: }
209: void ksptruemonitor_(KSP *ksp,int *it,double *norm,void *ctx,int *ierr)
210: {
211: *KSPTrueMonitor(*ksp,*it,*norm,ctx);
212: }
214: void kspvecviewmonitor_(KSP *ksp,int *it,double *norm,void *ctx,int *ierr)
215: {
216: *KSPVecViewMonitor(*ksp,*it,*norm,ctx);
217: }
219: static void (PETSC_STDCALL *f1)(KSP*,int*,double*,void*,int*);
220: static int ourmonitor(KSP ksp,int i,double d,void* ctx)
221: {
222: int 0;
223: (*f1)(&ksp,&i,&d,ctx,&ierr);
224: return 0;
225: }
226: static void (PETSC_STDCALL *f21)(void*,int*);
227: static int ourdestroy(void* ctx)
228: {
229: int 0;
230: (*f21)(ctx,&ierr);
231: return 0;
232: }
234: void PETSC_STDCALL kspsetmonitor_(KSP *ksp,void (PETSC_STDCALL *monitor)(KSP*,int*,double*,void*,int*),
235: void *mctx,void (PETSC_STDCALL *monitordestroy)(void *,int *),int *ierr)
236: {
237: if ((void(*)())monitor == (void(*)())kspdefaultmonitor_) {
238: *KSPSetMonitor(*ksp,KSPDefaultMonitor,0,0);
239: } else if ((void(*)())monitor == (void(*)())ksplgmonitor_) {
240: *KSPSetMonitor(*ksp,KSPLGMonitor,0,0);
241: } else if ((void(*)())monitor == (void(*)())ksplgtruemonitor_) {
242: *KSPSetMonitor(*ksp,KSPLGTrueMonitor,0,0);
243: } else if ((void(*)())monitor == (void(*)())kspvecviewmonitor_) {
244: *KSPSetMonitor(*ksp,KSPVecViewMonitor,0,0);
245: } else if ((void(*)())monitor == (void(*)())ksptruemonitor_) {
246: *KSPSetMonitor(*ksp,KSPTrueMonitor,0,0);
247: } else if ((void(*)())monitor == (void(*)())kspsingularvaluemonitor_) {
248: *KSPSetMonitor(*ksp,KSPSingularValueMonitor,0,0);
249: } else {
250: f1 = monitor;
251: if (FORTRANNULLFUNCTION(monitordestroy)) {
252: *KSPSetMonitor(*ksp,ourmonitor,mctx,0);
253: } else {
254: f21 = monitordestroy;
255: *KSPSetMonitor(*ksp,ourmonitor,mctx,ourdestroy);
256: }
257: }
258: }
260: void PETSC_STDCALL kspgetpc_(KSP *ksp,PC *B,int *ierr)
261: {
262: *KSPGetPC(*ksp,B);
263: }
265: void PETSC_STDCALL kspgetsolution_(KSP *ksp,Vec *v,int *ierr)
266: {
267: *KSPGetSolution(*ksp,v);
268: }
270: void PETSC_STDCALL kspgetrhs_(KSP *ksp,Vec *r,int *ierr)
271: {
272: *KSPGetRhs(*ksp,r);
273: }
275: /*
276: Possible bleeds memory but cannot be helped.
277: */
278: void PETSC_STDCALL ksplgmonitorcreate_(CHAR host PETSC_MIXED_LEN(len1),
279: CHAR label PETSC_MIXED_LEN(len2),int *x,int *y,int *m,int *n,PetscDrawLG *ctx,
280: int *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2))
281: {
282: char *t1,*t2;
284: FIXCHAR(host,len1,t1);
285: FIXCHAR(label,len2,t2);
286: *KSPLGMonitorCreate(t1,t2,*x,*y,*m,*n,ctx);
287: }
289: void PETSC_STDCALL ksplgmonitordestroy_(PetscDrawLG *ctx,int *ierr)
290: {
291: *KSPLGMonitorDestroy(*ctx);
292: }
294: void PETSC_STDCALL kspdestroy_(KSP *ksp,int *ierr)
295: {
296: *KSPDestroy(*ksp);
297: }
299: void PETSC_STDCALL kspregisterdestroy_(int* ierr)
300: {
301: *KSPRegisterDestroy();
302: }
304: void PETSC_STDCALL kspbuildsolution_(KSP *ctx,Vec *v,Vec *V,int *ierr)
305: {
306: *KSPBuildSolution(*ctx,*v,V);
307: }
309: void PETSC_STDCALL kspbuildresidual_(KSP *ctx,Vec *t,Vec *v,Vec *V,int *ierr)
310: {
311: *KSPBuildResidual(*ctx,*t,*v,V);
312: }
314: void PETSC_STDCALL kspgetoptionsprefix_(KSP *ksp,CHAR prefix PETSC_MIXED_LEN(len),int *ierr PETSC_END_LEN(len))
315: {
316: char *tname;
318: *KSPGetOptionsPrefix(*ksp,&tname);
319: #if defined(PETSC_USES_CPTOFCD)
320: {
321: char *t = _fcdtocp(prefix); int len1 = _fcdlen(prefix);
322: *PetscStrncpy(t,tname,len1); if (*ierr) return;
323: }
324: #else
325: *PetscStrncpy(prefix,tname,len); if (*ierr) return;
326: #endif
327: }
329: static void (PETSC_STDCALL *f109)(KSP*,int*,int*,double*,void*,int*);
330: static int ourmodify(KSP ksp,int i,int i2,double d,void* ctx)
331: {
332: int 0;
333: (*f109)(&ksp,&i,&i2,&d,ctx,&ierr);
334: return 0;
335: }
337: static void (PETSC_STDCALL *f210)(void*,int*);
338: static int ourmoddestroy(void* ctx)
339: {
340: int 0;
341: (*f210)(ctx,&ierr);
342: return 0;
343: }
345: void PETSC_STDCALL kspfgmresmodifypcnochange_(KSP *ksp,int *total_its,int *loc_its,double *res_norm,void* dummy,int *ierr)
346: {
347: *KSPFGMRESModifyPCNoChange(*ksp,*total_its,*loc_its,*res_norm,dummy);
348: }
350: void PETSC_STDCALL kspfgmresmodifypcsles_(KSP *ksp,int *total_its,int *loc_its,double *res_norm,void*dummy,int *ierr)
351: {
352: *KSPFGMRESModifyPCSLES(*ksp,*total_its,*loc_its,*res_norm,dummy);
353: }
355: void PETSC_STDCALL kspfgmressetmodifypc_(KSP *ksp,void (PETSC_STDCALL *fcn)(KSP*,int*,int*,double*,void*,int*),void* ctx,void (PETSC_STDCALL *d)(void*,int*),int *ierr)
356: {
357: if ((void(*)())fcn == (void(*)())kspfgmresmodifypcsles_) {
358: *KSPFGMRESSetModifyPC(*ksp,KSPFGMRESModifyPCSLES,0,0);
359: } else if ((void(*)())fcn == (void(*)())kspfgmresmodifypcnochange_) {
360: *KSPFGMRESSetModifyPC(*ksp,KSPFGMRESModifyPCNoChange,0,0);
361: } else {
362: f109 = fcn;
363: if (FORTRANNULLFUNCTION(d)) {
364: *KSPFGMRESSetModifyPC(*ksp,ourmodify,ctx,0);
365: } else {
366: f210 = d;
367: *KSPFGMRESSetModifyPC(*ksp,ourmodify,ctx,ourmoddestroy);
368: }
369: }
370: }
372: EXTERN_C_END