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