Actual source code: zksp.c
1: /*$Id: zksp.c,v 1.52 2001/08/07 21:32:16 bsmith 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 kspfgmresmodifypcksp_ KSPFGMRESMODIFYPCKSP
11: #define kspfgmresmodifypcnochange_ KSPFGMRESMODIFYPCNOCHANGE
12: #define kspdefaultconverged_ KSPDEFAULTCONVERGED
13: #define kspskipconverged_ KSPSKIPCONVERGED
14: #define kspgmreskrylovmonitor_ KSPGMRESKRYLOVMONITOR
15: #define kspdefaultmonitor_ KSPDEFAULTMONITOR
16: #define ksptruemonitor_ KSPTRUEMONITOR
17: #define kspvecviewmonitor_ KSPVECVIEWMONITOR
18: #define ksplgmonitor_ KSPLGMONITOR
19: #define ksplgtruemonitor_ KSPLGTRUEMONITOR
20: #define kspsingularvaluemonitor_ KSPSINGULARVALUEMONITOR
21: #define kspregisterdestroy_ KSPREGISTERDESTROY
22: #define kspdestroy_ KSPDESTROY
23: #define ksplgmonitordestroy_ KSPLGMONITORDESTROY
24: #define ksplgmonitorcreate_ KSPLGMONITORCREATE
25: #define kspgetrhs_ KSPGETRHS
26: #define kspgetsolution_ KSPGETSOLUTION
27: #define kspgetpc_ KSPGETPC
28: #define kspsetmonitor_ KSPSETMONITOR
29: #define kspsetconvergencetest_ KSPSETCONVERGENCETEST
30: #define kspcreate_ KSPCREATE
31: #define kspsetoptionsprefix_ KSPSETOPTIONSPREFIX
32: #define kspappendoptionsprefix_ KSPAPPENDOPTIONSPREFIX
33: #define kspgettype_ KSPGETTYPE
34: #define kspgetpreconditionerside_ KSPGETPRECONDITIONERSIDE
35: #define kspbuildsolution_ KSPBUILDSOLUTION
36: #define kspbuildresidual_ KSPBUILDRESIDUAL
37: #define kspsettype_ KSPSETTYPE
38: #define kspgetresidualhistory_ KSPGETRESIDUALHISTORY
39: #define kspgetoptionsprefix_ KSPGETOPTIONSPREFIX
40: #define kspview_ KSPVIEW
41: #define kspgmressetrestart_ KSPGMRESSETRESTART
42: #define kspsetnormtype_ KSPSETNORMTYPE
43: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
44: #define kspgetconvergedreason_ kspgetconvergedreason
45: #define kspfgmressetmodifypc_ kspfgmressetmodifypc
46: #define kspfgmresmodifypcksp_ kspfgmresmodifypcksp
47: #define kspfgmresmodifypcnochange_ kspfgmresmodifypcnochange
48: #define kspdefaultconverged_ kspdefaultconverged
49: #define kspskipconverged_ kspskipconverged
50: #define kspsingularvaluemonitor_ kspsingularvaluemonitor
51: #define kspgmreskrylovmonitor_ kspgmreskrylovmonitor
52: #define kspdefaultmonitor_ kspdefaultmonitor
53: #define ksptruemonitor_ ksptruemonitor
54: #define kspvecviewmonitor_ kspvecviewmonitor
55: #define ksplgmonitor_ ksplgmonitor
56: #define ksplgtruemonitor_ ksplgtruemonitor
57: #define kspgetresidualhistory_ kspgetresidualhistory
58: #define kspsettype_ kspsettype
59: #define kspregisterdestroy_ kspregisterdestroy
60: #define kspdestroy_ kspdestroy
61: #define ksplgmonitordestroy_ ksplgmonitordestroy
62: #define ksplgmonitorcreate_ ksplgmonitorcreate
63: #define kspgetrhs_ kspgetrhs
64: #define kspgetsolution_ kspgetsolution
65: #define kspgetpc_ kspgetpc
66: #define kspsetmonitor_ kspsetmonitor
67: #define kspsetconvergencetest_ kspsetconvergencetest
68: #define kspcreate_ kspcreate
69: #define kspsetoptionsprefix_ kspsetoptionsprefix
70: #define kspappendoptionsprefix_ kspappendoptionsprefix
71: #define kspgettype_ kspgettype
72: #define kspgetpreconditionerside_ kspgetpreconditionerside
73: #define kspbuildsolution_ kspbuildsolution
74: #define kspbuildresidual_ kspbuildresidual
75: #define kspgetoptionsprefix_ kspgetoptionsprefix
76: #define kspview_ kspview
77: #define kspgetresidualnorm_ kspgetresidualnorm
78: #define kspgmressetrestart_ kspgmressetrestart
79: #define kspsetnormtype_ kspsetnormtype
80: #endif
82: EXTERN_C_BEGIN
83: static void (PETSC_STDCALL *f2)(KSP*,int*,PetscReal*,KSPConvergedReason*,void*,int*);
84: static void (PETSC_STDCALL *f1)(KSP*,int*,PetscReal*,void*,int*);
85: static void (PETSC_STDCALL *f21)(void*,int*);
86: static void (PETSC_STDCALL *f109)(KSP*,int*,int*,PetscReal*,void*,int*);
87: static void (PETSC_STDCALL *f210)(void*,int*);
88: EXTERN_C_END
90: /* These are not extern C because they are passed into non-extern C user level functions */
91: static int ourtest(KSP ksp,int i,PetscReal d,KSPConvergedReason *reason,void* ctx)
92: {
94: (*f2)(&ksp,&i,&d,reason,ctx,&ierr);
95: return 0;
96: }
98: static int ourmonitor(KSP ksp,int i,PetscReal d,void* ctx)
99: {
100: int 0;
101: (*f1)(&ksp,&i,&d,ctx,&ierr);
102: return 0;
103: }
105: static int ourdestroy(void* ctx)
106: {
107: int 0;
108: (*f21)(ctx,&ierr);
109: return 0;
110: }
112: static int ourmodify(KSP ksp,int i,int i2,PetscReal d,void* ctx)
113: {
114: int 0;
115: (*f109)(&ksp,&i,&i2,&d,ctx,&ierr);
116: return 0;
117: }
119: static int ourmoddestroy(void* ctx)
120: {
121: int 0;
122: (*f210)(ctx,&ierr);
123: return 0;
124: }
126: EXTERN_C_BEGIN
128: void PETSC_STDCALL kspgmressetrestart_(KSP *ksp,int *max_k, int *ierr )
129: {
130: *KSPGMRESSetRestart(*ksp,*max_k);
131: }
133: void PETSC_STDCALL kspgetresidualnorm_(KSP *ksp,PetscReal *rnorm,int *ierr)
134: {
135: *KSPGetResidualNorm(*ksp,rnorm);
136: }
138: void PETSC_STDCALL kspgetconvergedreason_(KSP *ksp,KSPConvergedReason *reason,int *ierr)
139: {
140: *KSPGetConvergedReason(*ksp,reason);
141: }
143: /* function */
144: void PETSC_STDCALL kspview_(KSP *ksp,PetscViewer *viewer, int *ierr)
145: {
146: PetscViewer v;
147: PetscPatchDefaultViewers_Fortran(viewer,v);
148: *KSPView(*ksp,v);
149: }
151: void kspdefaultconverged_(KSP *ksp,int *n,PetscReal *rnorm,KSPConvergedReason *flag,void *dummy,int *ierr)
152: {
153: CHKFORTRANNULLOBJECT(dummy);
154: *KSPDefaultConverged(*ksp,*n,*rnorm,flag,dummy);
155: }
157: void kspskipconverged_(KSP *ksp,int *n,PetscReal *rnorm,KSPConvergedReason *flag,void *dummy,int *ierr)
158: {
159: CHKFORTRANNULLOBJECT(dummy);
160: *KSPSkipConverged(*ksp,*n,*rnorm,flag,dummy);
161: }
163: void PETSC_STDCALL kspgetresidualhistory_(KSP *ksp,int *na,int *ierr)
164: {
165: *KSPGetResidualHistory(*ksp,PETSC_NULL,na);
166: }
168: void PETSC_STDCALL kspsettype_(KSP *ksp,CHAR type PETSC_MIXED_LEN(len),int *ierr PETSC_END_LEN(len))
169: {
170: char *t;
172: FIXCHAR(type,len,t);
173: *KSPSetType(*ksp,t);
174: FREECHAR(type,t);
175: }
177: void PETSC_STDCALL kspgettype_(KSP *ksp,CHAR name PETSC_MIXED_LEN(len),int *ierr PETSC_END_LEN(len))
178: {
179: char *tname;
181: *KSPGetType(*ksp,&tname);if (*ierr) return;
182: #if defined(PETSC_USES_CPTOFCD)
183: {
184: char *t = _fcdtocp(name); int len1 = _fcdlen(name);
185: *PetscStrncpy(t,tname,len1);
186: }
187: #else
188: *PetscStrncpy(name,tname,len);
189: #endif
190: }
192: void PETSC_STDCALL kspgetpreconditionerside_(KSP *ksp,PCSide *side,int *ierr){
193: *KSPGetPreconditionerSide(*ksp,side);
194: }
196: void PETSC_STDCALL kspsetoptionsprefix_(KSP *ksp,CHAR prefix PETSC_MIXED_LEN(len),
197: int *ierr PETSC_END_LEN(len))
198: {
199: char *t;
201: FIXCHAR(prefix,len,t);
202: *KSPSetOptionsPrefix(*ksp,t);
203: FREECHAR(prefix,t);
204: }
206: void PETSC_STDCALL kspappendoptionsprefix_(KSP *ksp,CHAR prefix PETSC_MIXED_LEN(len),
207: int *ierr PETSC_END_LEN(len))
208: {
209: char *t;
211: FIXCHAR(prefix,len,t);
212: *KSPAppendOptionsPrefix(*ksp,t);
213: FREECHAR(prefix,t);
214: }
216: void PETSC_STDCALL kspcreate_(MPI_Comm *comm,KSP *ksp,int *ierr){
217: *KSPCreate((MPI_Comm)PetscToPointerComm(*comm),ksp);
218: }
220: void PETSC_STDCALL kspsetconvergencetest_(KSP *ksp,
221: void (PETSC_STDCALL *converge)(KSP*,int*,PetscReal*,KSPConvergedReason*,void*,int*),void *cctx,int *ierr)
222: {
223: if ((FCNVOID)converge == (FCNVOID)kspdefaultconverged_) {
224: *KSPSetConvergenceTest(*ksp,KSPDefaultConverged,0);
225: } else if ((FCNVOID)converge == (FCNVOID)kspskipconverged_) {
226: *KSPSetConvergenceTest(*ksp,KSPSkipConverged,0);
227: } else {
228: f2 = converge;
229: *KSPSetConvergenceTest(*ksp,ourtest,cctx);
230: }
231: }
233: /*
234: These are not usually called from Fortran but allow Fortran users
235: to transparently set these monitors from .F code
236:
237: functions, hence no STDCALL
238: */
239: void kspgmreskrylovmonitor_(KSP *ksp,int *it,PetscReal *norm,void *ctx,int *ierr)
240: {
241: *KSPGMRESKrylovMonitor(*ksp,*it,*norm,ctx);
242: }
244: void kspdefaultmonitor_(KSP *ksp,int *it,PetscReal *norm,void *ctx,int *ierr)
245: {
246: *KSPDefaultMonitor(*ksp,*it,*norm,ctx);
247: }
248:
249: void kspsingularvaluemonitor_(KSP *ksp,int *it,PetscReal *norm,void *ctx,int *ierr)
250: {
251: *KSPSingularValueMonitor(*ksp,*it,*norm,ctx);
252: }
254: void ksplgmonitor_(KSP *ksp,int *it,PetscReal *norm,void *ctx,int *ierr)
255: {
256: *KSPLGMonitor(*ksp,*it,*norm,ctx);
257: }
259: void ksplgtruemonitor_(KSP *ksp,int *it,PetscReal *norm,void *ctx,int *ierr)
260: {
261: *KSPLGTrueMonitor(*ksp,*it,*norm,ctx);
262: }
264: void ksptruemonitor_(KSP *ksp,int *it,PetscReal *norm,void *ctx,int *ierr)
265: {
266: *KSPTrueMonitor(*ksp,*it,*norm,ctx);
267: }
269: void kspvecviewmonitor_(KSP *ksp,int *it,PetscReal *norm,void *ctx,int *ierr)
270: {
271: *KSPVecViewMonitor(*ksp,*it,*norm,ctx);
272: }
275: void PETSC_STDCALL kspsetmonitor_(KSP *ksp,void (PETSC_STDCALL *monitor)(KSP*,int*,PetscReal*,void*,int*),
276: void *mctx,void (PETSC_STDCALL *monitordestroy)(void *,int *),int *ierr)
277: {
278: if ((FCNVOID)monitor == (FCNVOID)kspdefaultmonitor_) {
279: *KSPSetMonitor(*ksp,KSPDefaultMonitor,0,0);
280: } else if ((FCNVOID)monitor == (FCNVOID)ksplgmonitor_) {
281: *KSPSetMonitor(*ksp,KSPLGMonitor,0,0);
282: } else if ((FCNVOID)monitor == (FCNVOID)ksplgtruemonitor_) {
283: *KSPSetMonitor(*ksp,KSPLGTrueMonitor,0,0);
284: } else if ((FCNVOID)monitor == (FCNVOID)kspvecviewmonitor_) {
285: *KSPSetMonitor(*ksp,KSPVecViewMonitor,0,0);
286: } else if ((FCNVOID)monitor == (FCNVOID)ksptruemonitor_) {
287: *KSPSetMonitor(*ksp,KSPTrueMonitor,0,0);
288: } else if ((FCNVOID)monitor == (FCNVOID)kspsingularvaluemonitor_) {
289: *KSPSetMonitor(*ksp,KSPSingularValueMonitor,0,0);
290: } else {
291: f1 = monitor;
292: if (FORTRANNULLFUNCTION(monitordestroy)) {
293: *KSPSetMonitor(*ksp,ourmonitor,mctx,0);
294: } else {
295: f21 = monitordestroy;
296: *KSPSetMonitor(*ksp,ourmonitor,mctx,ourdestroy);
297: }
298: }
299: }
301: void PETSC_STDCALL kspgetpc_(KSP *ksp,PC *B,int *ierr)
302: {
303: *KSPGetPC(*ksp,B);
304: }
306: void PETSC_STDCALL kspgetsolution_(KSP *ksp,Vec *v,int *ierr)
307: {
308: *KSPGetSolution(*ksp,v);
309: }
311: void PETSC_STDCALL kspgetrhs_(KSP *ksp,Vec *r,int *ierr)
312: {
313: *KSPGetRhs(*ksp,r);
314: }
316: /*
317: Possible bleeds memory but cannot be helped.
318: */
319: void PETSC_STDCALL ksplgmonitorcreate_(CHAR host PETSC_MIXED_LEN(len1),
320: CHAR label PETSC_MIXED_LEN(len2),int *x,int *y,int *m,int *n,PetscDrawLG *ctx,
321: int *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2))
322: {
323: char *t1,*t2;
325: FIXCHAR(host,len1,t1);
326: FIXCHAR(label,len2,t2);
327: *KSPLGMonitorCreate(t1,t2,*x,*y,*m,*n,ctx);
328: }
330: void PETSC_STDCALL ksplgmonitordestroy_(PetscDrawLG *ctx,int *ierr)
331: {
332: *KSPLGMonitorDestroy(*ctx);
333: }
335: void PETSC_STDCALL kspdestroy_(KSP *ksp,int *ierr)
336: {
337: *KSPDestroy(*ksp);
338: }
340: void PETSC_STDCALL kspregisterdestroy_(int* ierr)
341: {
342: *KSPRegisterDestroy();
343: }
345: void PETSC_STDCALL kspbuildsolution_(KSP *ctx,Vec *v,Vec *V,int *ierr)
346: {
347: *KSPBuildSolution(*ctx,*v,V);
348: }
350: void PETSC_STDCALL kspbuildresidual_(KSP *ctx,Vec *t,Vec *v,Vec *V,int *ierr)
351: {
352: *KSPBuildResidual(*ctx,*t,*v,V);
353: }
355: void PETSC_STDCALL kspgetoptionsprefix_(KSP *ksp,CHAR prefix PETSC_MIXED_LEN(len),int *ierr PETSC_END_LEN(len))
356: {
357: char *tname;
359: *KSPGetOptionsPrefix(*ksp,&tname);
360: #if defined(PETSC_USES_CPTOFCD)
361: {
362: char *t = _fcdtocp(prefix); int len1 = _fcdlen(prefix);
363: *PetscStrncpy(t,tname,len1); if (*ierr) return;
364: }
365: #else
366: *PetscStrncpy(prefix,tname,len); if (*ierr) return;
367: #endif
368: }
370: void PETSC_STDCALL kspfgmresmodifypcnochange_(KSP *ksp,int *total_its,int *loc_its,PetscReal *res_norm,void* dummy,int *ierr)
371: {
372: *KSPFGMRESModifyPCNoChange(*ksp,*total_its,*loc_its,*res_norm,dummy);
373: }
375: void PETSC_STDCALL kspfgmresmodifypcksp_(KSP *ksp,int *total_its,int *loc_its,PetscReal *res_norm,void*dummy,int *ierr)
376: {
377: *KSPFGMRESModifyPCKSP(*ksp,*total_its,*loc_its,*res_norm,dummy);
378: }
380: void PETSC_STDCALL kspfgmressetmodifypc_(KSP *ksp,void (PETSC_STDCALL *fcn)(KSP*,int*,int*,PetscReal*,void*,int*),void* ctx,void (PETSC_STDCALL *d)(void*,int*),int *ierr)
381: {
382: if ((FCNVOID)fcn == (FCNVOID)kspfgmresmodifypcksp_) {
383: *KSPFGMRESSetModifyPC(*ksp,KSPFGMRESModifyPCKSP,0,0);
384: } else if ((FCNVOID)fcn == (FCNVOID)kspfgmresmodifypcnochange_) {
385: *KSPFGMRESSetModifyPC(*ksp,KSPFGMRESModifyPCNoChange,0,0);
386: } else {
387: f109 = fcn;
388: if (FORTRANNULLFUNCTION(d)) {
389: *KSPFGMRESSetModifyPC(*ksp,ourmodify,ctx,0);
390: } else {
391: f210 = d;
392: *KSPFGMRESSetModifyPC(*ksp,ourmodify,ctx,ourmoddestroy);
393: }
394: }
395: }
397: void PETSC_STDCALL kspsetnormtype_(KSP *ksp,KSPNormType *type,int *ierr)
398: {
399: *KSPSetNormType(*ksp,*type);
400: }
402: EXTERN_C_END