Actual source code: zksp.c

 2:  #include src/fortran/custom/zpetsc.h
 3:  #include petscksp.h

  5: #ifdef PETSC_HAVE_FORTRAN_CAPS
  6: #define kspsetnullspace_           KSPSETNULLSPACE
  7: #define kspgetnullspace_           KSPGETNULLSPACE
  8: #define kspgetresidualnorm_        KSPGETRESIDUALNORM
  9: #define kspgetconvergedreason_     KSPGETCONVERGEDREASON
 10: #define kspfgmressetmodifypc_      KSPFGMRESSETMODIFYPC
 11: #define kspfgmresmodifypcksp_      KSPFGMRESMODIFYPCKSP
 12: #define kspfgmresmodifypcnochange_ KSPFGMRESMODIFYPCNOCHANGE
 13: #define kspdefaultconverged_       KSPDEFAULTCONVERGED
 14: #define kspskipconverged_          KSPSKIPCONVERGED
 15: #define kspgmreskrylovmonitor_     KSPGMRESKRYLOVMONITOR
 16: #define kspdefaultmonitor_         KSPDEFAULTMONITOR
 17: #define ksptruemonitor_            KSPTRUEMONITOR
 18: #define kspvecviewmonitor_         KSPVECVIEWMONITOR
 19: #define ksplgmonitor_              KSPLGMONITOR
 20: #define ksplgtruemonitor_          KSPLGTRUEMONITOR
 21: #define kspsingularvaluemonitor_   KSPSINGULARVALUEMONITOR
 22: #define kspregisterdestroy_        KSPREGISTERDESTROY
 23: #define kspdestroy_                KSPDESTROY
 24: #define ksplgmonitordestroy_       KSPLGMONITORDESTROY
 25: #define ksplgmonitorcreate_        KSPLGMONITORCREATE
 26: #define kspgetrhs_                 KSPGETRHS
 27: #define kspgetsolution_            KSPGETSOLUTION
 28: #define kspgetpc_                  KSPGETPC
 29: #define kspsetmonitor_             KSPSETMONITOR
 30: #define kspsetconvergencetest_     KSPSETCONVERGENCETEST
 31: #define kspcreate_                 KSPCREATE
 32: #define kspsetoptionsprefix_       KSPSETOPTIONSPREFIX
 33: #define kspappendoptionsprefix_    KSPAPPENDOPTIONSPREFIX
 34: #define kspgettype_                KSPGETTYPE
 35: #define kspgetpreconditionerside_  KSPGETPRECONDITIONERSIDE
 36: #define kspbuildsolution_          KSPBUILDSOLUTION 
 37: #define kspbuildresidual_          KSPBUILDRESIDUAL
 38: #define kspsettype_                KSPSETTYPE           
 39: #define kspgetresidualhistory_     KSPGETRESIDUALHISTORY
 40: #define kspgetoptionsprefix_       KSPGETOPTIONSPREFIX
 41: #define kspview_                   KSPVIEW
 42: #define kspgmressetrestart_        KSPGMRESSETRESTART
 43: #define kspsetnormtype_            KSPSETNORMTYPE
 44: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
 45: #define kspsetnullspace_           kspsetnullspace
 46: #define kspgetnullspace_           kspgetnullspace
 47: #define kspgetconvergedreason_     kspgetconvergedreason
 48: #define kspfgmressetmodifypc_      kspfgmressetmodifypc
 49: #define kspfgmresmodifypcksp_      kspfgmresmodifypcksp
 50: #define kspfgmresmodifypcnochange_ kspfgmresmodifypcnochange
 51: #define kspdefaultconverged_       kspdefaultconverged
 52: #define kspskipconverged_          kspskipconverged
 53: #define kspsingularvaluemonitor_   kspsingularvaluemonitor
 54: #define kspgmreskrylovmonitor_     kspgmreskrylovmonitor
 55: #define kspdefaultmonitor_         kspdefaultmonitor
 56: #define ksptruemonitor_            ksptruemonitor
 57: #define kspvecviewmonitor_         kspvecviewmonitor
 58: #define ksplgmonitor_              ksplgmonitor
 59: #define ksplgtruemonitor_          ksplgtruemonitor
 60: #define kspgetresidualhistory_     kspgetresidualhistory
 61: #define kspsettype_                kspsettype
 62: #define kspregisterdestroy_        kspregisterdestroy
 63: #define kspdestroy_                kspdestroy
 64: #define ksplgmonitordestroy_       ksplgmonitordestroy
 65: #define ksplgmonitorcreate_        ksplgmonitorcreate
 66: #define kspgetrhs_                 kspgetrhs
 67: #define kspgetsolution_            kspgetsolution
 68: #define kspgetpc_                  kspgetpc
 69: #define kspsetmonitor_             kspsetmonitor
 70: #define kspsetconvergencetest_     kspsetconvergencetest
 71: #define kspcreate_                 kspcreate
 72: #define kspsetoptionsprefix_       kspsetoptionsprefix
 73: #define kspappendoptionsprefix_    kspappendoptionsprefix
 74: #define kspgettype_                kspgettype
 75: #define kspgetpreconditionerside_  kspgetpreconditionerside
 76: #define kspbuildsolution_          kspbuildsolution
 77: #define kspbuildresidual_          kspbuildresidual
 78: #define kspgetoptionsprefix_       kspgetoptionsprefix
 79: #define kspview_                   kspview
 80: #define kspgetresidualnorm_        kspgetresidualnorm
 81: #define kspgmressetrestart_        kspgmressetrestart
 82: #define kspsetnormtype_            kspsetnormtype
 83: #endif

 86: static void (PETSC_STDCALL *f2)(KSP*,PetscInt*,PetscReal*,KSPConvergedReason*,void*,PetscErrorCode*);
 87: static void (PETSC_STDCALL *f1)(KSP*,PetscInt*,PetscReal*,void*,PetscErrorCode*);
 88: static void (PETSC_STDCALL *f21)(void*,PetscErrorCode*);
 89: static void (PETSC_STDCALL *f109)(KSP*,PetscInt*,PetscInt*,PetscReal*,void*,PetscErrorCode*);
 90: static void (PETSC_STDCALL *f210)(void*,PetscErrorCode*);

 94: static PetscErrorCode ourtest(KSP ksp,PetscInt i,PetscReal d,KSPConvergedReason *reason,void* ctx)
 95: {
 97:   (*f2)(&ksp,&i,&d,reason,ctx,&ierr);
 98:   return 0;
 99: }

101: static PetscErrorCode ourmonitor(KSP ksp,PetscInt i,PetscReal d,void* ctx)
102: {
103:   PetscErrorCode 0;
104:   (*f1)(&ksp,&i,&d,ctx,&ierr);
105:   return 0;
106: }

108: static PetscErrorCode ourdestroy(void* ctx)
109: {
110:   PetscErrorCode 0;
111:   (*f21)(ctx,&ierr);
112:   return 0;
113: }

115: static PetscErrorCode ourmodify(KSP ksp,PetscInt i,PetscInt i2,PetscReal d,void* ctx)
116: {
117:   PetscErrorCode 0;
118:   (*f109)(&ksp,&i,&i2,&d,ctx,&ierr);
119:   return 0;
120: }

122: static PetscErrorCode ourmoddestroy(void* ctx)
123: {
124:   PetscErrorCode 0;
125:   (*f210)(ctx,&ierr);
126:   return 0;
127: }


131: void PETSC_STDCALL kspgmressetrestart_(KSP *ksp,PetscInt *max_k, PetscErrorCode *ierr)
132: {
133:   *KSPGMRESSetRestart(*ksp,*max_k);
134: }

136: void PETSC_STDCALL kspgetresidualnorm_(KSP *ksp,PetscReal *rnorm,PetscErrorCode *ierr)
137: {
138:   *KSPGetResidualNorm(*ksp,rnorm);
139: }

141: void PETSC_STDCALL kspgetconvergedreason_(KSP *ksp,KSPConvergedReason *reason,PetscErrorCode *ierr)
142: {
143:   *KSPGetConvergedReason(*ksp,reason);
144: }

146: /* function */
147: void PETSC_STDCALL kspsetnullspace_(KSP *ksp,MatNullSpace *sp, PetscErrorCode *ierr)
148: {
149:   *KSPSetNullSpace(*ksp,*sp);
150: }

152: void PETSC_STDCALL kspgetnullspace_(KSP *ksp,MatNullSpace *sp, PetscErrorCode *ierr)
153: {
154:   *KSPGetNullSpace(*ksp,sp);
155: }

157: void PETSC_STDCALL kspview_(KSP *ksp,PetscViewer *viewer, PetscErrorCode *ierr)
158: {
159:   PetscViewer v;
160:   PetscPatchDefaultViewers_Fortran(viewer,v);
161:   *KSPView(*ksp,v);
162: }

164: void kspdefaultconverged_(KSP *ksp,PetscInt *n,PetscReal *rnorm,KSPConvergedReason *flag,void *dummy,PetscErrorCode *ierr)
165: {
166:   CHKFORTRANNULLOBJECT(dummy);
167:   *KSPDefaultConverged(*ksp,*n,*rnorm,flag,dummy);
168: }

170: void kspskipconverged_(KSP *ksp,PetscInt *n,PetscReal *rnorm,KSPConvergedReason *flag,void *dummy,PetscErrorCode *ierr)
171: {
172:   CHKFORTRANNULLOBJECT(dummy);
173:   *KSPSkipConverged(*ksp,*n,*rnorm,flag,dummy);
174: }

176: void PETSC_STDCALL kspgetresidualhistory_(KSP *ksp,PetscInt *na,PetscErrorCode *ierr)
177: {
178:   *KSPGetResidualHistory(*ksp,PETSC_NULL,na);
179: }

181: void PETSC_STDCALL kspsettype_(KSP *ksp,CHAR type PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len))
182: {
183:   char *t;

185:   FIXCHAR(type,len,t);
186:   *KSPSetType(*ksp,t);
187:   FREECHAR(type,t);
188: }

190: void PETSC_STDCALL kspgettype_(KSP *ksp,CHAR name PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len))
191: {
192:   const char *tname;

194:   *KSPGetType(*ksp,&tname);if (*ierr) return;
195: #if defined(PETSC_USES_CPTOFCD)
196:   {
197:     char *t = _fcdtocp(name); int len1 = _fcdlen(name);
198:     *PetscStrncpy(t,tname,len1);
199:   }
200: #else
201:   *PetscStrncpy(name,tname,len);
202: #endif
203:   FIXRETURNCHAR(name,len);

205: }

207: void PETSC_STDCALL kspgetpreconditionerside_(KSP *ksp,PCSide *side,PetscErrorCode *ierr){
208: *KSPGetPreconditionerSide(*ksp,side);
209: }

211: void PETSC_STDCALL kspsetoptionsprefix_(KSP *ksp,CHAR prefix PETSC_MIXED_LEN(len),
212:                                         PetscErrorCode *ierr PETSC_END_LEN(len))
213: {
214:   char *t;

216:   FIXCHAR(prefix,len,t);
217:   *KSPSetOptionsPrefix(*ksp,t);
218:   FREECHAR(prefix,t);
219: }

221: void PETSC_STDCALL kspappendoptionsprefix_(KSP *ksp,CHAR prefix PETSC_MIXED_LEN(len),
222:                                            PetscErrorCode *ierr PETSC_END_LEN(len))
223: {
224:   char *t;

226:   FIXCHAR(prefix,len,t);
227:   *KSPAppendOptionsPrefix(*ksp,t);
228:   FREECHAR(prefix,t);
229: }

231: void PETSC_STDCALL kspcreate_(MPI_Comm *comm,KSP *ksp,PetscErrorCode *ierr){
232:   *KSPCreate((MPI_Comm)PetscToPointerComm(*comm),ksp);
233: }

235: void PETSC_STDCALL kspsetconvergencetest_(KSP *ksp,
236:       void (PETSC_STDCALL *converge)(KSP*,PetscInt*,PetscReal*,KSPConvergedReason*,void*,PetscErrorCode*),void *cctx,PetscErrorCode *ierr)
237: {
238:   if ((FCNVOID)converge == (FCNVOID)kspdefaultconverged_) {
239:     *KSPSetConvergenceTest(*ksp,KSPDefaultConverged,0);
240:   } else if ((FCNVOID)converge == (FCNVOID)kspskipconverged_) {
241:     *KSPSetConvergenceTest(*ksp,KSPSkipConverged,0);
242:   } else {
243:     f2 = converge;
244:     *KSPSetConvergenceTest(*ksp,ourtest,cctx);
245:   }
246: }

248: /*
249:         These are not usually called from Fortran but allow Fortran users 
250:    to transparently set these monitors from .F code
251:    
252:    functions, hence no STDCALL
253: */
254: void kspgmreskrylovmonitor_(KSP *ksp,PetscInt *it,PetscReal *norm,void *ctx,PetscErrorCode *ierr)
255: {
256:   *KSPGMRESKrylovMonitor(*ksp,*it,*norm,ctx);
257: }

259: void  kspdefaultmonitor_(KSP *ksp,PetscInt *it,PetscReal *norm,void *ctx,PetscErrorCode *ierr)
260: {
261:   *KSPDefaultMonitor(*ksp,*it,*norm,ctx);
262: }
263: 
264: void  kspsingularvaluemonitor_(KSP *ksp,PetscInt *it,PetscReal *norm,void *ctx,PetscErrorCode *ierr)
265: {
266:   *KSPSingularValueMonitor(*ksp,*it,*norm,ctx);
267: }

269: void  ksplgmonitor_(KSP *ksp,PetscInt *it,PetscReal *norm,void *ctx,PetscErrorCode *ierr)
270: {
271:   *KSPLGMonitor(*ksp,*it,*norm,ctx);
272: }

274: void  ksplgtruemonitor_(KSP *ksp,PetscInt *it,PetscReal *norm,void *ctx,PetscErrorCode *ierr)
275: {
276:   *KSPLGTrueMonitor(*ksp,*it,*norm,ctx);
277: }

279: void  ksptruemonitor_(KSP *ksp,PetscInt *it,PetscReal *norm,void *ctx,PetscErrorCode *ierr)
280: {
281:   *KSPTrueMonitor(*ksp,*it,*norm,ctx);
282: }

284: void  kspvecviewmonitor_(KSP *ksp,PetscInt *it,PetscReal *norm,void *ctx,PetscErrorCode *ierr)
285: {
286:   *KSPVecViewMonitor(*ksp,*it,*norm,ctx);
287: }


290: void PETSC_STDCALL kspsetmonitor_(KSP *ksp,void (PETSC_STDCALL *monitor)(KSP*,PetscInt*,PetscReal*,void*,PetscErrorCode*),
291:                     void *mctx,void (PETSC_STDCALL *monitordestroy)(void*,PetscErrorCode*),PetscErrorCode *ierr)
292: {
293:   if ((FCNVOID)monitor == (FCNVOID)kspdefaultmonitor_) {
294:     *KSPSetMonitor(*ksp,KSPDefaultMonitor,0,0);
295:   } else if ((FCNVOID)monitor == (FCNVOID)ksplgmonitor_) {
296:     *KSPSetMonitor(*ksp,KSPLGMonitor,0,0);
297:   } else if ((FCNVOID)monitor == (FCNVOID)ksplgtruemonitor_) {
298:     *KSPSetMonitor(*ksp,KSPLGTrueMonitor,0,0);
299:   } else if ((FCNVOID)monitor == (FCNVOID)kspvecviewmonitor_) {
300:     *KSPSetMonitor(*ksp,KSPVecViewMonitor,0,0);
301:   } else if ((FCNVOID)monitor == (FCNVOID)ksptruemonitor_) {
302:     *KSPSetMonitor(*ksp,KSPTrueMonitor,0,0);
303:   } else if ((FCNVOID)monitor == (FCNVOID)kspsingularvaluemonitor_) {
304:     *KSPSetMonitor(*ksp,KSPSingularValueMonitor,0,0);
305:   } else {
306:     f1  = monitor;
307:     if (FORTRANNULLFUNCTION(monitordestroy)) {
308:       *KSPSetMonitor(*ksp,ourmonitor,mctx,0);
309:     } else {
310:       f21 = monitordestroy;
311:       *KSPSetMonitor(*ksp,ourmonitor,mctx,ourdestroy);
312:     }
313:   }
314: }

316: void PETSC_STDCALL kspgetpc_(KSP *ksp,PC *B,PetscErrorCode *ierr)
317: {
318:   *KSPGetPC(*ksp,B);
319: }

321: void PETSC_STDCALL kspgetsolution_(KSP *ksp,Vec *v,PetscErrorCode *ierr)
322: {
323:   *KSPGetSolution(*ksp,v);
324: }

326: void PETSC_STDCALL kspgetrhs_(KSP *ksp,Vec *r,PetscErrorCode *ierr)
327: {
328:   *KSPGetRhs(*ksp,r);
329: }

331: /*
332:    Possible bleeds memory but cannot be helped.
333: */
334: void PETSC_STDCALL ksplgmonitorcreate_(CHAR host PETSC_MIXED_LEN(len1),
335:                     CHAR label PETSC_MIXED_LEN(len2),int *x,int *y,int *m,int *n,PetscDrawLG *ctx,
336:                     PetscErrorCode *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2))
337: {
338:   char   *t1,*t2;

340:   FIXCHAR(host,len1,t1);
341:   FIXCHAR(label,len2,t2);
342:   *KSPLGMonitorCreate(t1,t2,*x,*y,*m,*n,ctx);
343: }

345: void PETSC_STDCALL ksplgmonitordestroy_(PetscDrawLG *ctx,PetscErrorCode *ierr)
346: {
347:   *KSPLGMonitorDestroy(*ctx);
348: }

350: void PETSC_STDCALL kspdestroy_(KSP *ksp,PetscErrorCode *ierr)
351: {
352:   *KSPDestroy(*ksp);
353: }

355: void PETSC_STDCALL kspregisterdestroy_(PetscErrorCode* ierr)
356: {
357:   *KSPRegisterDestroy();
358: }

360: void PETSC_STDCALL kspbuildsolution_(KSP *ctx,Vec *v,Vec *V,PetscErrorCode *ierr)
361: {
362:   *KSPBuildSolution(*ctx,*v,V);
363: }

365: void PETSC_STDCALL kspbuildresidual_(KSP *ctx,Vec *t,Vec *v,Vec *V,PetscErrorCode *ierr)
366: {
367:   *KSPBuildResidual(*ctx,*t,*v,V);
368: }

370: void PETSC_STDCALL kspgetoptionsprefix_(KSP *ksp,CHAR prefix PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len))
371: {
372:   const char *tname;

374:   *KSPGetOptionsPrefix(*ksp,&tname);
375: #if defined(PETSC_USES_CPTOFCD)
376:   {
377:     char *t = _fcdtocp(prefix); int len1 = _fcdlen(prefix);
378:     *PetscStrncpy(t,tname,len1); if (*ierr) return;
379:   }
380: #else
381:   *PetscStrncpy(prefix,tname,len); if (*ierr) return;
382: #endif
383: }

385: void PETSC_STDCALL kspfgmresmodifypcnochange_(KSP *ksp,PetscInt *total_its,PetscInt *loc_its,PetscReal *res_norm,void* dummy,PetscErrorCode *ierr)
386: {
387:   *KSPFGMRESModifyPCNoChange(*ksp,*total_its,*loc_its,*res_norm,dummy);
388: }

390: void PETSC_STDCALL kspfgmresmodifypcksp_(KSP *ksp,PetscInt *total_its,PetscInt *loc_its,PetscReal *res_norm,void*dummy,PetscErrorCode *ierr)
391: {
392:   *KSPFGMRESModifyPCKSP(*ksp,*total_its,*loc_its,*res_norm,dummy);
393: }

395: void PETSC_STDCALL kspfgmressetmodifypc_(KSP *ksp,void (PETSC_STDCALL *fcn)(KSP*,PetscInt*,PetscInt*,PetscReal*,void*,PetscErrorCode*),void* ctx,void (PETSC_STDCALL *d)(void*,PetscErrorCode*),PetscErrorCode *ierr)
396: {
397:   if ((FCNVOID)fcn == (FCNVOID)kspfgmresmodifypcksp_) {
398:     *KSPFGMRESSetModifyPC(*ksp,KSPFGMRESModifyPCKSP,0,0);
399:   } else if ((FCNVOID)fcn == (FCNVOID)kspfgmresmodifypcnochange_) {
400:     *KSPFGMRESSetModifyPC(*ksp,KSPFGMRESModifyPCNoChange,0,0);
401:   } else {
402:     f109 = fcn;
403:     if (FORTRANNULLFUNCTION(d)) {
404:       *KSPFGMRESSetModifyPC(*ksp,ourmodify,ctx,0);
405:     } else {
406:       f210 = d;
407:       *KSPFGMRESSetModifyPC(*ksp,ourmodify,ctx,ourmoddestroy);
408:     }
409:   }
410: }

412: void PETSC_STDCALL kspsetnormtype_(KSP *ksp,KSPNormType *type,PetscErrorCode *ierr)
413: {
414:   *KSPSetNormType(*ksp,*type);
415: }