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