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