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