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 snesnewtontrsetprecheck_(SNES *snes, void (*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 snesnewtontrsetpostcheck_(SNES *snes, void (*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 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 snessetjacobian_(SNES *snes,Mat *A,Mat *B, 185 void (*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 snesgetoptionsprefix_(SNES *snes,char* prefix,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T 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 snesgettype_(SNES *snes,char* name, PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T 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 231 PETSC_EXTERN void snessetfunction_(SNES *snes,Vec *r,void (*func)(SNES*,Vec*,Vec*,void*,PetscErrorCode*),void *ctx,PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptr)) 232 { 233 *ierr = PetscObjectSetFortranCallback((PetscObject)*snes,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.function,(PetscVoidFunction)func,ctx);if (*ierr) return; 234 #if defined(PETSC_HAVE_F90_2PTR_ARG) 235 *ierr = PetscObjectSetFortranCallback((PetscObject)*snes,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.function_pgiptr,NULL,ptr);if (*ierr) return; 236 #endif 237 *ierr = SNESSetFunction(*snes,*r,oursnesfunction,NULL); 238 } 239 240 241 PETSC_EXTERN void snessetngs_(SNES *snes,void (*func)(SNES*,Vec*,Vec*,void*,PetscErrorCode*),void *ctx,PetscErrorCode *ierr) 242 { 243 *ierr = PetscObjectSetFortranCallback((PetscObject)*snes,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.ngs,(PetscVoidFunction)func,ctx);if (*ierr) return; 244 *ierr = SNESSetNGS(*snes,oursnesngs,NULL); 245 } 246 PETSC_EXTERN void snessetupdate_(SNES *snes,void (*func)(SNES*,PetscInt*,PetscErrorCode*),PetscErrorCode *ierr) 247 { 248 *ierr = PetscObjectSetFortranCallback((PetscObject)*snes,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.update,(PetscVoidFunction)func,NULL);if (*ierr) return; 249 *ierr = SNESSetUpdate(*snes,oursnesupdate); 250 } 251 /* ---------------------------------------------------------*/ 252 253 /* the func argument is ignored */ 254 PETSC_EXTERN void snesgetfunction_(SNES *snes,Vec *r,void (*func)(SNES,Vec,Vec,void*),void **ctx,PetscErrorCode *ierr) 255 { 256 CHKFORTRANNULLOBJECT(r); 257 *ierr = SNESGetFunction(*snes,r,NULL,NULL); if (*ierr) return; 258 if ((PetscVoidFunction)func == (PetscVoidFunction)PETSC_NULL_FUNCTION_Fortran) return; 259 *ierr = PetscObjectGetFortranCallback((PetscObject)*snes,PETSC_FORTRAN_CALLBACK_CLASS,_cb.function,NULL,ctx); 260 } 261 262 PETSC_EXTERN void snesgetngs_(SNES *snes,void *func,void **ctx,PetscErrorCode *ierr) 263 { 264 *ierr = PetscObjectGetFortranCallback((PetscObject)*snes,PETSC_FORTRAN_CALLBACK_CLASS,_cb.ngs,NULL,ctx); 265 } 266 267 /*----------------------------------------------------------------------*/ 268 269 PETSC_EXTERN void snesconvergeddefault_(SNES *snes,PetscInt *it,PetscReal *a,PetscReal *b,PetscReal *c,SNESConvergedReason *r, void *ct,PetscErrorCode *ierr) 270 { 271 *ierr = SNESConvergedDefault(*snes,*it,*a,*b,*c,r,ct); 272 } 273 274 PETSC_EXTERN void snesconvergedskip_(SNES *snes,PetscInt *it,PetscReal *a,PetscReal *b,PetscReal *c,SNESConvergedReason *r,void *ct,PetscErrorCode *ierr) 275 { 276 *ierr = SNESConvergedSkip(*snes,*it,*a,*b,*c,r,ct); 277 } 278 279 PETSC_EXTERN void snessetconvergencetest_(SNES *snes,void (*func)(SNES*,PetscInt*,PetscReal*,PetscReal*,PetscReal*,SNESConvergedReason*,void*,PetscErrorCode*), void *cctx,void (*destroy)(void*),PetscErrorCode *ierr) 280 { 281 CHKFORTRANNULLFUNCTION(destroy); 282 283 if ((PetscVoidFunction)func == (PetscVoidFunction)snesconvergeddefault_) { 284 *ierr = SNESSetConvergenceTest(*snes,SNESConvergedDefault,0,0); 285 } else if ((PetscVoidFunction)func == (PetscVoidFunction)snesconvergedskip_) { 286 *ierr = SNESSetConvergenceTest(*snes,SNESConvergedSkip,0,0); 287 } else { 288 *ierr = PetscObjectSetFortranCallback((PetscObject)*snes,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.test,(PetscVoidFunction)func,cctx);if (*ierr) return; 289 *ierr = PetscObjectSetFortranCallback((PetscObject)*snes,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.destroy,(PetscVoidFunction)destroy,cctx);if (*ierr) return; 290 *ierr = SNESSetConvergenceTest(*snes,oursnestest,*snes,ourdestroy); 291 } 292 } 293 /*----------------------------------------------------------------------*/ 294 295 PETSC_EXTERN void snesview_(SNES *snes,PetscViewer *viewer, PetscErrorCode *ierr) 296 { 297 PetscViewer v; 298 PetscPatchDefaultViewers_Fortran(viewer,v); 299 *ierr = SNESView(*snes,v); 300 } 301 302 /* func is currently ignored from Fortran */ 303 PETSC_EXTERN void snesgetjacobian_(SNES *snes,Mat *A,Mat *B,int *func,void **ctx,PetscErrorCode *ierr) 304 { 305 CHKFORTRANNULLINTEGER(ctx); 306 CHKFORTRANNULLOBJECT(A); 307 CHKFORTRANNULLOBJECT(B); 308 *ierr = SNESGetJacobian(*snes,A,B,0,NULL); if (*ierr) return; 309 *ierr = PetscObjectGetFortranCallback((PetscObject)*snes,PETSC_FORTRAN_CALLBACK_CLASS,_cb.jacobian,NULL,ctx); 310 311 } 312 313 PETSC_EXTERN void snesgetconvergencehistory_(SNES *snes,PetscInt *na,PetscErrorCode *ierr) 314 { 315 *ierr = SNESGetConvergenceHistory(*snes,NULL,NULL,na); 316 } 317 318 PETSC_EXTERN void snessettype_(SNES *snes,char* type,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len) 319 { 320 char *t; 321 322 FIXCHAR(type,len,t); 323 *ierr = SNESSetType(*snes,t);if (*ierr) return; 324 FREECHAR(type,t); 325 } 326 327 PETSC_EXTERN void snesappendoptionsprefix_(SNES *snes,char* prefix,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len) 328 { 329 char *t; 330 331 FIXCHAR(prefix,len,t); 332 *ierr = SNESAppendOptionsPrefix(*snes,t);if (*ierr) return; 333 FREECHAR(prefix,t); 334 } 335 336 PETSC_EXTERN void snessetoptionsprefix_(SNES *snes,char* prefix,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len) 337 { 338 char *t; 339 340 FIXCHAR(prefix,len,t); 341 *ierr = SNESSetOptionsPrefix(*snes,t);if (*ierr) return; 342 FREECHAR(prefix,t); 343 } 344 345 /*----------------------------------------------------------------------*/ 346 347 PETSC_EXTERN void snesmonitorlgresidualnorm_(SNES *snes,PetscInt *its,PetscReal *fgnorm,PetscObject *dummy,PetscErrorCode *ierr) 348 { 349 *ierr = SNESMonitorLGResidualNorm(*snes,*its,*fgnorm,dummy); 350 } 351 352 PETSC_EXTERN void snesmonitordefault_(SNES *snes,PetscInt *its,PetscReal *fgnorm,PetscViewerAndFormat **dummy,PetscErrorCode *ierr) 353 { 354 *ierr = SNESMonitorDefault(*snes,*its,*fgnorm,*dummy); 355 } 356 357 PETSC_EXTERN void snesmonitorsolution_(SNES *snes,PetscInt *its,PetscReal *fgnorm,PetscViewerAndFormat **dummy,PetscErrorCode *ierr) 358 { 359 *ierr = SNESMonitorSolution(*snes,*its,*fgnorm,*dummy); 360 } 361 362 PETSC_EXTERN void snesmonitorsolutionupdate_(SNES *snes,PetscInt *its,PetscReal *fgnorm,PetscViewerAndFormat **dummy,PetscErrorCode *ierr) 363 { 364 *ierr = SNESMonitorSolutionUpdate(*snes,*its,*fgnorm,*dummy); 365 } 366 367 368 PETSC_EXTERN void snesmonitorset_(SNES *snes,void (*func)(SNES*,PetscInt*,PetscReal*,void*,PetscErrorCode*),void *mctx,void (*mondestroy)(void*,PetscErrorCode*),PetscErrorCode *ierr) 369 { 370 CHKFORTRANNULLFUNCTION(mondestroy); 371 if ((PetscVoidFunction)func == (PetscVoidFunction)snesmonitordefault_) { 372 *ierr = SNESMonitorSet(*snes,(PetscErrorCode (*)(SNES,PetscInt,PetscReal,void*))SNESMonitorDefault,*(PetscViewerAndFormat**)mctx,(PetscErrorCode (*)(void **))PetscViewerAndFormatDestroy); 373 } else if ((PetscVoidFunction)func == (PetscVoidFunction)snesmonitorsolution_) { 374 *ierr = SNESMonitorSet(*snes,(PetscErrorCode (*)(SNES,PetscInt,PetscReal,void*))SNESMonitorSolution,*(PetscViewerAndFormat**)mctx,(PetscErrorCode (*)(void **))PetscViewerAndFormatDestroy); 375 } else if ((PetscVoidFunction)func == (PetscVoidFunction)snesmonitorsolutionupdate_) { 376 *ierr = SNESMonitorSet(*snes,(PetscErrorCode (*)(SNES,PetscInt,PetscReal,void*))SNESMonitorSolutionUpdate,*(PetscViewerAndFormat**)mctx,(PetscErrorCode (*)(void **))PetscViewerAndFormatDestroy); 377 } else if ((PetscVoidFunction)func == (PetscVoidFunction)snesmonitorlgresidualnorm_) { 378 *ierr = SNESMonitorSet(*snes,(PetscErrorCode (*)(SNES,PetscInt,PetscReal,void*))SNESMonitorLGResidualNorm,0,0); 379 } else { 380 *ierr = PetscObjectSetFortranCallback((PetscObject)*snes,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.monitor,(PetscVoidFunction)func,mctx);if (*ierr) return; 381 *ierr = PetscObjectSetFortranCallback((PetscObject)*snes,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.mondestroy,(PetscVoidFunction)mondestroy,mctx);if (*ierr) return; 382 *ierr = SNESMonitorSet(*snes,oursnesmonitor,*snes,ourmondestroy); 383 } 384 } 385 386 PETSC_EXTERN void snesviewfromoptions_(SNES *ao,PetscObject obj,char* type,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len) 387 { 388 char *t; 389 390 FIXCHAR(type,len,t); 391 *ierr = SNESViewFromOptions(*ao,obj,t);if (*ierr) return; 392 FREECHAR(type,t); 393 } 394