1 #include <petsc/private/fortranimpl.h> 2 #include <petscsnes.h> 3 #include <petscviewer.h> 4 #include <petsc/private/f90impl.h> 5 6 #if defined(PETSC_HAVE_FORTRAN_CAPS) 7 #define matmffdcomputejacobian_ MATMFFDCOMPUTEJACOBIAN 8 #define snessolve_ SNESSOLVE 9 #define snescomputejacobiandefault_ SNESCOMPUTEJACOBIANDEFAULT 10 #define snescomputejacobiandefaultcolor_ SNESCOMPUTEJACOBIANDEFAULTCOLOR 11 #define snessetjacobian_ SNESSETJACOBIAN 12 #define snesgetoptionsprefix_ SNESGETOPTIONSPREFIX 13 #define snesgettype_ SNESGETTYPE 14 #define snessetfunction_ SNESSETFUNCTION 15 #define snessetngs_ SNESSETNGS 16 #define snessetupdate_ SNESSETUPDATE 17 #define snesgetfunction_ SNESGETFUNCTION 18 #define snesgetngs_ SNESGETNGS 19 #define snessetconvergencetest_ SNESSETCONVERGENCETEST 20 #define snesconvergeddefault_ SNESCONVERGEDDEFAULT 21 #define snesconvergedskip_ SNESCONVERGEDSKIP 22 #define snesview_ SNESVIEW 23 #define snesgetconvergencehistory_ SNESGETCONVERGENCEHISTORY 24 #define snesgetjacobian_ SNESGETJACOBIAN 25 #define snessettype_ SNESSETTYPE 26 #define snesappendoptionsprefix_ SNESAPPENDOPTIONSPREFIX 27 #define snessetoptionsprefix_ SNESSETOPTIONSPREFIX 28 #define snesmonitordefault_ SNESMONITORDEFAULT 29 #define snesmonitorsolution_ SNESMONITORSOLUTION 30 #define snesmonitorlgresidualnorm_ SNESMONITORLGRESIDUALNORM 31 #define snesmonitorsolutionupdate_ SNESMONITORSOLUTIONUPDATE 32 #define snesmonitorset_ SNESMONITORSET 33 #define snesnewtontrsetprecheck_ SNESNEWTONTRSETPRECHECK 34 #define snesnewtontrsetpostcheck_ SNESNEWTONTRSETPOSTCHECK 35 #define snesviewfromoptions_ SNESVIEWFROMOPTIONS 36 #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE) 37 #define matmffdcomputejacobian_ matmffdcomputejacobian 38 #define snessolve_ snessolve 39 #define snescomputejacobiandefault_ snescomputejacobiandefault 40 #define snescomputejacobiandefaultcolor_ snescomputejacobiandefaultcolor 41 #define snessetjacobian_ snessetjacobian 42 #define snesgetoptionsprefix_ snesgetoptionsprefix 43 #define snesgettype_ snesgettype 44 #define snessetfunction_ snessetfunction 45 #define snessetngs_ snessetngs 46 #define snessetupdate_ snessetupdate 47 #define snesgetfunction_ snesgetfunction 48 #define snesgetngs_ snesgetngs 49 #define snessetconvergencetest_ snessetconvergencetest 50 #define snesconvergeddefault_ snesconvergeddefault 51 #define snesconvergedskip_ snesconvergedskip 52 #define snesview_ snesview 53 #define snesgetjacobian_ snesgetjacobian 54 #define snesgetconvergencehistory_ snesgetconvergencehistory 55 #define snessettype_ snessettype 56 #define snesappendoptionsprefix_ snesappendoptionsprefix 57 #define snessetoptionsprefix_ snessetoptionsprefix 58 #define snesmonitorlgresidualnorm_ snesmonitorlgresidualnorm 59 #define snesmonitordefault_ snesmonitordefault 60 #define snesmonitorsolution_ snesmonitorsolution 61 #define snesmonitorsolutionupdate_ snesmonitorsolutionupdate 62 #define snesmonitorset_ snesmonitorset 63 #define snesnewtontrsetprecheck_ snesnewtontrsetprecheck 64 #define snesnewtontrsetpostcheck_ snesnewtontrsetpostcheck 65 #define snesviewfromoptions_ snesviewfromoptions 66 #endif 67 68 static struct { 69 PetscFortranCallbackId function; 70 PetscFortranCallbackId test; 71 PetscFortranCallbackId destroy; 72 PetscFortranCallbackId jacobian; 73 PetscFortranCallbackId monitor; 74 PetscFortranCallbackId mondestroy; 75 PetscFortranCallbackId ngs; 76 PetscFortranCallbackId update; 77 PetscFortranCallbackId trprecheck; 78 PetscFortranCallbackId trpostcheck; 79 #if defined(PETSC_HAVE_F90_2PTR_ARG) 80 PetscFortranCallbackId function_pgiptr; 81 PetscFortranCallbackId trprecheck_pgiptr; 82 PetscFortranCallbackId trpostcheck_pgiptr; 83 #endif 84 } _cb; 85 86 static PetscErrorCode ourtrprecheckfunction(SNES snes,Vec x,Vec y,PetscBool *changed_y,void *ctx) 87 { 88 #if defined(PETSC_HAVE_F90_2PTR_ARG) 89 void* ptr; 90 PetscObjectGetFortranCallback((PetscObject)snes,PETSC_FORTRAN_CALLBACK_CLASS,_cb.trprecheck_pgiptr,NULL,&ptr); 91 #endif 92 PetscObjectUseFortranCallback(snes,_cb.trprecheck,(SNES*,Vec*,Vec*,PetscBool *,void*,PetscErrorCode* PETSC_F90_2PTR_PROTO_NOVAR),(&snes,&x,&y,changed_y,_ctx,&ierr PETSC_F90_2PTR_PARAM(ptr))); 93 } 94 95 PETSC_EXTERN void PETSC_STDCALL snesnewtontrsetprecheck_(SNES *snes, void (PETSC_STDCALL *func)(SNES,Vec,Vec,PetscBool*,void*),void *ctx,PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptr)) 96 { 97 *ierr = PetscObjectSetFortranCallback((PetscObject)*snes,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.trprecheck,(PetscVoidFunction)func,ctx);if (*ierr) return; 98 #if defined(PETSC_HAVE_F90_2PTR_ARG) 99 *ierr = PetscObjectSetFortranCallback((PetscObject)*snes,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.trprecheck_pgiptr,NULL,ptr);if (*ierr) return; 100 #endif 101 SNESNewtonTRSetPreCheck(*snes,ourtrprecheckfunction,NULL); 102 } 103 104 105 static PetscErrorCode ourtrpostcheckfunction(SNES snes,Vec x,Vec y,Vec w,PetscBool *changed_y,PetscBool *changed_w,void *ctx) 106 { 107 #if defined(PETSC_HAVE_F90_2PTR_ARG) 108 void* ptr; 109 PetscObjectGetFortranCallback((PetscObject)snes,PETSC_FORTRAN_CALLBACK_CLASS,_cb.trpostcheck_pgiptr,NULL,&ptr); 110 #endif 111 PetscObjectUseFortranCallback(snes,_cb.trpostcheck,(SNES*,Vec*,Vec*,Vec *,PetscBool *,PetscBool *,void*,PetscErrorCode* PETSC_F90_2PTR_PROTO_NOVAR),(&snes,&x,&y,&w,changed_y,changed_w,_ctx,&ierr PETSC_F90_2PTR_PARAM(ptr))); 112 } 113 114 PETSC_EXTERN void PETSC_STDCALL snesnewtontrsetpostcheck_(SNES *snes, void (PETSC_STDCALL *func)(SNES,Vec,Vec,Vec,PetscBool*,PetscBool*,void*),void *ctx,PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptr)) 115 { 116 *ierr = PetscObjectSetFortranCallback((PetscObject)*snes,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.trpostcheck,(PetscVoidFunction)func,ctx);if (*ierr) return; 117 #if defined(PETSC_HAVE_F90_2PTR_ARG) 118 *ierr = PetscObjectSetFortranCallback((PetscObject)*snes,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.trpostcheck_pgiptr,NULL,ptr);if (*ierr) return; 119 #endif 120 SNESNewtonTRSetPostCheck(*snes,ourtrpostcheckfunction,NULL); 121 } 122 123 static PetscErrorCode oursnesfunction(SNES snes,Vec x,Vec f,void *ctx) 124 { 125 #if defined(PETSC_HAVE_F90_2PTR_ARG) 126 void* ptr; 127 PetscObjectGetFortranCallback((PetscObject)snes,PETSC_FORTRAN_CALLBACK_CLASS,_cb.function_pgiptr,NULL,&ptr); 128 #endif 129 PetscObjectUseFortranCallback(snes,_cb.function,(SNES*,Vec*,Vec*,void*,PetscErrorCode* PETSC_F90_2PTR_PROTO_NOVAR),(&snes,&x,&f,_ctx,&ierr PETSC_F90_2PTR_PARAM(ptr))); 130 } 131 132 static PetscErrorCode oursnestest(SNES snes,PetscInt it,PetscReal a,PetscReal d,PetscReal c,SNESConvergedReason *reason,void *ctx) 133 { 134 PetscObjectUseFortranCallback(snes,_cb.test,(SNES*,PetscInt*,PetscReal*,PetscReal*,PetscReal*,SNESConvergedReason*,void*,PetscErrorCode*),(&snes,&it,&a,&d,&c,reason,_ctx,&ierr)); 135 } 136 137 static PetscErrorCode ourdestroy(void *ctx) 138 { 139 PetscObjectUseFortranCallback(ctx,_cb.destroy,(void*,PetscErrorCode*),(_ctx,&ierr)); 140 } 141 142 static PetscErrorCode oursnesjacobian(SNES snes,Vec x,Mat m,Mat p,void *ctx) 143 { 144 PetscObjectUseFortranCallback(snes,_cb.jacobian,(SNES*,Vec*,Mat*,Mat*,void*,PetscErrorCode*),(&snes,&x,&m,&p,_ctx,&ierr)); 145 } 146 147 static PetscErrorCode oursnesupdate(SNES snes,PetscInt i) 148 { 149 PetscObjectUseFortranCallback(snes,_cb.update,(SNES*,PetscInt *,PetscErrorCode*),(&snes,&i,&ierr)); 150 } 151 static PetscErrorCode oursnesngs(SNES snes,Vec x,Vec b,void *ctx) 152 { 153 PetscObjectUseFortranCallback(snes,_cb.ngs,(SNES*,Vec*,Vec*,void*,PetscErrorCode*),(&snes,&x,&b,_ctx,&ierr)); 154 } 155 static PetscErrorCode oursnesmonitor(SNES snes,PetscInt i,PetscReal d,void *ctx) 156 { 157 PetscObjectUseFortranCallback(snes,_cb.monitor,(SNES*,PetscInt*,PetscReal*,void*,PetscErrorCode*),(&snes,&i,&d,_ctx,&ierr)); 158 } 159 static PetscErrorCode ourmondestroy(void **ctx) 160 { 161 SNES snes = (SNES)*ctx; 162 PetscObjectUseFortranCallback(snes,_cb.mondestroy,(void*,PetscErrorCode*),(_ctx,&ierr)); 163 } 164 165 /* ---------------------------------------------------------*/ 166 /* 167 snescomputejacobiandefault() and snescomputejacobiandefaultcolor() 168 These can be used directly from Fortran but are mostly so that 169 Fortran SNESSetJacobian() will properly handle the defaults being passed in. 170 171 functions, hence no STDCALL 172 */ 173 PETSC_EXTERN void matmffdcomputejacobian_(SNES *snes,Vec *x,Mat *m,Mat *p,void *ctx,PetscErrorCode *ierr) 174 { 175 *ierr = MatMFFDComputeJacobian(*snes,*x,*m,*p,ctx); 176 } 177 PETSC_EXTERN void snescomputejacobiandefault_(SNES *snes,Vec *x,Mat *m,Mat *p,void *ctx,PetscErrorCode *ierr) 178 { 179 *ierr = SNESComputeJacobianDefault(*snes,*x,*m,*p,ctx); 180 } 181 PETSC_EXTERN void snescomputejacobiandefaultcolor_(SNES *snes,Vec *x,Mat *m,Mat *p,void *ctx,PetscErrorCode *ierr) 182 { 183 *ierr = SNESComputeJacobianDefaultColor(*snes,*x,*m,*p,*(MatFDColoring*)ctx); 184 } 185 186 PETSC_EXTERN void PETSC_STDCALL snessetjacobian_(SNES *snes,Mat *A,Mat *B, 187 void (PETSC_STDCALL *func)(SNES*,Vec*,Mat*,Mat*,void*,PetscErrorCode*), 188 void *ctx,PetscErrorCode *ierr) 189 { 190 CHKFORTRANNULLFUNCTION(func); 191 if ((PetscVoidFunction)func == (PetscVoidFunction)snescomputejacobiandefault_) { 192 *ierr = SNESSetJacobian(*snes,*A,*B,SNESComputeJacobianDefault,ctx); 193 } else if ((PetscVoidFunction)func == (PetscVoidFunction)snescomputejacobiandefaultcolor_) { 194 if (!ctx) { 195 *ierr = PETSC_ERR_ARG_NULL; 196 return; 197 } 198 *ierr = SNESSetJacobian(*snes,*A,*B,SNESComputeJacobianDefaultColor,*(MatFDColoring*)ctx); 199 } else if ((PetscVoidFunction)func == (PetscVoidFunction)matmffdcomputejacobian_) { 200 *ierr = SNESSetJacobian(*snes,*A,*B,MatMFFDComputeJacobian,ctx); 201 } else { 202 *ierr = PetscObjectSetFortranCallback((PetscObject)*snes,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.jacobian,(PetscVoidFunction)func,ctx); 203 if (!*ierr) *ierr = SNESSetJacobian(*snes,*A,*B,oursnesjacobian,NULL); 204 } 205 } 206 /* -------------------------------------------------------------*/ 207 208 PETSC_EXTERN void PETSC_STDCALL snesgetoptionsprefix_(SNES *snes,char* prefix PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len)) 209 { 210 const char *tname; 211 212 *ierr = SNESGetOptionsPrefix(*snes,&tname); 213 *ierr = PetscStrncpy(prefix,tname,len);if (*ierr) return; 214 FIXRETURNCHAR(PETSC_TRUE,prefix,len); 215 } 216 217 PETSC_EXTERN void PETSC_STDCALL snesgettype_(SNES *snes,char* name PETSC_MIXED_LEN(len), PetscErrorCode *ierr PETSC_END_LEN(len)) 218 { 219 const char *tname; 220 221 *ierr = SNESGetType(*snes,&tname); 222 *ierr = PetscStrncpy(name,tname,len);if (*ierr) return; 223 FIXRETURNCHAR(PETSC_TRUE,name,len); 224 } 225 226 /* ---------------------------------------------------------*/ 227 228 /* 229 These are not usually called from Fortran but allow Fortran users 230 to transparently set these monitors from .F code 231 232 functions, hence no STDCALL 233 */ 234 235 PETSC_EXTERN void PETSC_STDCALL snessetfunction_(SNES *snes,Vec *r,void (PETSC_STDCALL *func)(SNES*,Vec*,Vec*,void*,PetscErrorCode*),void *ctx,PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptr)) 236 { 237 *ierr = PetscObjectSetFortranCallback((PetscObject)*snes,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.function,(PetscVoidFunction)func,ctx);if (*ierr) return; 238 #if defined(PETSC_HAVE_F90_2PTR_ARG) 239 *ierr = PetscObjectSetFortranCallback((PetscObject)*snes,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.function_pgiptr,NULL,ptr);if (*ierr) return; 240 #endif 241 *ierr = SNESSetFunction(*snes,*r,oursnesfunction,NULL); 242 } 243 244 245 PETSC_EXTERN void PETSC_STDCALL snessetngs_(SNES *snes,void (PETSC_STDCALL *func)(SNES*,Vec*,Vec*,void*,PetscErrorCode*),void *ctx,PetscErrorCode *ierr) 246 { 247 *ierr = PetscObjectSetFortranCallback((PetscObject)*snes,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.ngs,(PetscVoidFunction)func,ctx);if (*ierr) return; 248 *ierr = SNESSetNGS(*snes,oursnesngs,NULL); 249 } 250 PETSC_EXTERN void PETSC_STDCALL snessetupdate_(SNES *snes,void (PETSC_STDCALL *func)(SNES*,PetscInt*,PetscErrorCode*),PetscErrorCode *ierr) 251 { 252 *ierr = PetscObjectSetFortranCallback((PetscObject)*snes,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.update,(PetscVoidFunction)func,NULL);if (*ierr) return; 253 *ierr = SNESSetUpdate(*snes,oursnesupdate); 254 } 255 /* ---------------------------------------------------------*/ 256 257 /* the func argument is ignored */ 258 PETSC_EXTERN void PETSC_STDCALL snesgetfunction_(SNES *snes,Vec *r,void (PETSC_STDCALL *func)(SNES,Vec,Vec,void*),void **ctx,PetscErrorCode *ierr) 259 { 260 CHKFORTRANNULLOBJECT(r); 261 *ierr = SNESGetFunction(*snes,r,NULL,NULL); if (*ierr) return; 262 if ((PetscVoidFunction)func == (PetscVoidFunction)PETSC_NULL_FUNCTION_Fortran) return; 263 *ierr = PetscObjectGetFortranCallback((PetscObject)*snes,PETSC_FORTRAN_CALLBACK_CLASS,_cb.function,NULL,ctx); 264 } 265 266 PETSC_EXTERN void PETSC_STDCALL snesgetngs_(SNES *snes,void *func,void **ctx,PetscErrorCode *ierr) 267 { 268 *ierr = PetscObjectGetFortranCallback((PetscObject)*snes,PETSC_FORTRAN_CALLBACK_CLASS,_cb.ngs,NULL,ctx); 269 } 270 271 /*----------------------------------------------------------------------*/ 272 273 PETSC_EXTERN void snesconvergeddefault_(SNES *snes,PetscInt *it,PetscReal *a,PetscReal *b,PetscReal *c,SNESConvergedReason *r, void *ct,PetscErrorCode *ierr) 274 { 275 *ierr = SNESConvergedDefault(*snes,*it,*a,*b,*c,r,ct); 276 } 277 278 PETSC_EXTERN void snesconvergedskip_(SNES *snes,PetscInt *it,PetscReal *a,PetscReal *b,PetscReal *c,SNESConvergedReason *r,void *ct,PetscErrorCode *ierr) 279 { 280 *ierr = SNESConvergedSkip(*snes,*it,*a,*b,*c,r,ct); 281 } 282 283 PETSC_EXTERN void PETSC_STDCALL snessetconvergencetest_(SNES *snes,void (PETSC_STDCALL *func)(SNES*,PetscInt*,PetscReal*,PetscReal*,PetscReal*,SNESConvergedReason*,void*,PetscErrorCode*), void *cctx,void (PETSC_STDCALL *destroy)(void*),PetscErrorCode *ierr) 284 { 285 CHKFORTRANNULLFUNCTION(destroy); 286 287 if ((PetscVoidFunction)func == (PetscVoidFunction)snesconvergeddefault_) { 288 *ierr = SNESSetConvergenceTest(*snes,SNESConvergedDefault,0,0); 289 } else if ((PetscVoidFunction)func == (PetscVoidFunction)snesconvergedskip_) { 290 *ierr = SNESSetConvergenceTest(*snes,SNESConvergedSkip,0,0); 291 } else { 292 *ierr = PetscObjectSetFortranCallback((PetscObject)*snes,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.test,(PetscVoidFunction)func,cctx);if (*ierr) return; 293 *ierr = PetscObjectSetFortranCallback((PetscObject)*snes,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.destroy,(PetscVoidFunction)destroy,cctx);if (*ierr) return; 294 *ierr = SNESSetConvergenceTest(*snes,oursnestest,*snes,ourdestroy); 295 } 296 } 297 /*----------------------------------------------------------------------*/ 298 299 PETSC_EXTERN void PETSC_STDCALL snesview_(SNES *snes,PetscViewer *viewer, PetscErrorCode *ierr) 300 { 301 PetscViewer v; 302 PetscPatchDefaultViewers_Fortran(viewer,v); 303 *ierr = SNESView(*snes,v); 304 } 305 306 /* func is currently ignored from Fortran */ 307 PETSC_EXTERN void PETSC_STDCALL snesgetjacobian_(SNES *snes,Mat *A,Mat *B,int *func,void **ctx,PetscErrorCode *ierr) 308 { 309 CHKFORTRANNULLINTEGER(ctx); 310 CHKFORTRANNULLOBJECT(A); 311 CHKFORTRANNULLOBJECT(B); 312 *ierr = SNESGetJacobian(*snes,A,B,0,NULL); if (*ierr) return; 313 *ierr = PetscObjectGetFortranCallback((PetscObject)*snes,PETSC_FORTRAN_CALLBACK_CLASS,_cb.jacobian,NULL,ctx); 314 315 } 316 317 PETSC_EXTERN void PETSC_STDCALL snesgetconvergencehistory_(SNES *snes,PetscInt *na,PetscErrorCode *ierr) 318 { 319 *ierr = SNESGetConvergenceHistory(*snes,NULL,NULL,na); 320 } 321 322 PETSC_EXTERN void PETSC_STDCALL snessettype_(SNES *snes,char* type PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len)) 323 { 324 char *t; 325 326 FIXCHAR(type,len,t); 327 *ierr = SNESSetType(*snes,t);if (*ierr) return; 328 FREECHAR(type,t); 329 } 330 331 PETSC_EXTERN void PETSC_STDCALL snesappendoptionsprefix_(SNES *snes,char* prefix PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len)) 332 { 333 char *t; 334 335 FIXCHAR(prefix,len,t); 336 *ierr = SNESAppendOptionsPrefix(*snes,t);if (*ierr) return; 337 FREECHAR(prefix,t); 338 } 339 340 PETSC_EXTERN void PETSC_STDCALL snessetoptionsprefix_(SNES *snes,char* prefix PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len)) 341 { 342 char *t; 343 344 FIXCHAR(prefix,len,t); 345 *ierr = SNESSetOptionsPrefix(*snes,t);if (*ierr) return; 346 FREECHAR(prefix,t); 347 } 348 349 /*----------------------------------------------------------------------*/ 350 /* functions, hence no STDCALL */ 351 352 PETSC_EXTERN void snesmonitorlgresidualnorm_(SNES *snes,PetscInt *its,PetscReal *fgnorm,PetscObject *dummy,PetscErrorCode *ierr) 353 { 354 *ierr = SNESMonitorLGResidualNorm(*snes,*its,*fgnorm,dummy); 355 } 356 357 PETSC_EXTERN void snesmonitordefault_(SNES *snes,PetscInt *its,PetscReal *fgnorm,PetscViewerAndFormat **dummy,PetscErrorCode *ierr) 358 { 359 *ierr = SNESMonitorDefault(*snes,*its,*fgnorm,*dummy); 360 } 361 362 PETSC_EXTERN void snesmonitorsolution_(SNES *snes,PetscInt *its,PetscReal *fgnorm,PetscViewerAndFormat **dummy,PetscErrorCode *ierr) 363 { 364 *ierr = SNESMonitorSolution(*snes,*its,*fgnorm,*dummy); 365 } 366 367 PETSC_EXTERN void snesmonitorsolutionupdate_(SNES *snes,PetscInt *its,PetscReal *fgnorm,PetscViewerAndFormat **dummy,PetscErrorCode *ierr) 368 { 369 *ierr = SNESMonitorSolutionUpdate(*snes,*its,*fgnorm,*dummy); 370 } 371 372 373 PETSC_EXTERN void PETSC_STDCALL snesmonitorset_(SNES *snes,void (PETSC_STDCALL *func)(SNES*,PetscInt*,PetscReal*,void*,PetscErrorCode*),void *mctx,void (PETSC_STDCALL *mondestroy)(void*,PetscErrorCode*),PetscErrorCode *ierr) 374 { 375 CHKFORTRANNULLFUNCTION(mondestroy); 376 if ((PetscVoidFunction)func == (PetscVoidFunction)snesmonitordefault_) { 377 *ierr = SNESMonitorSet(*snes,(PetscErrorCode (*)(SNES,PetscInt,PetscReal,void*))SNESMonitorDefault,*(PetscViewerAndFormat**)mctx,(PetscErrorCode (*)(void **))PetscViewerAndFormatDestroy); 378 } else if ((PetscVoidFunction)func == (PetscVoidFunction)snesmonitorsolution_) { 379 *ierr = SNESMonitorSet(*snes,(PetscErrorCode (*)(SNES,PetscInt,PetscReal,void*))SNESMonitorSolution,*(PetscViewerAndFormat**)mctx,(PetscErrorCode (*)(void **))PetscViewerAndFormatDestroy); 380 } else if ((PetscVoidFunction)func == (PetscVoidFunction)snesmonitorsolutionupdate_) { 381 *ierr = SNESMonitorSet(*snes,(PetscErrorCode (*)(SNES,PetscInt,PetscReal,void*))SNESMonitorSolutionUpdate,*(PetscViewerAndFormat**)mctx,(PetscErrorCode (*)(void **))PetscViewerAndFormatDestroy); 382 } else if ((PetscVoidFunction)func == (PetscVoidFunction)snesmonitorlgresidualnorm_) { 383 *ierr = SNESMonitorSet(*snes,(PetscErrorCode (*)(SNES,PetscInt,PetscReal,void*))SNESMonitorLGResidualNorm,0,0); 384 } else { 385 *ierr = PetscObjectSetFortranCallback((PetscObject)*snes,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.monitor,(PetscVoidFunction)func,mctx);if (*ierr) return; 386 *ierr = PetscObjectSetFortranCallback((PetscObject)*snes,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.mondestroy,(PetscVoidFunction)mondestroy,mctx);if (*ierr) return; 387 *ierr = SNESMonitorSet(*snes,oursnesmonitor,*snes,ourmondestroy); 388 } 389 } 390 391 PETSC_EXTERN void PETSC_STDCALL snesviewfromoptions_(SNES *ao,PetscObject obj,char* type PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len)) 392 { 393 char *t; 394 395 FIXCHAR(type,len,t); 396 *ierr = SNESViewFromOptions(*ao,obj,t);if (*ierr) return; 397 FREECHAR(type,t); 398 } 399