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