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 #define snesgetconvergedreasonstring_ SNESGETCONVERGEDREASONSTRING 40 #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE) 41 #define snesconvergedreasonview_ snesconvergedreasonview 42 #define snessetpicard_ snessetpicard 43 #define matmffdcomputejacobian_ matmffdcomputejacobian 44 #define snessolve_ snessolve 45 #define snescomputejacobiandefault_ snescomputejacobiandefault 46 #define snescomputejacobiandefaultcolor_ snescomputejacobiandefaultcolor 47 #define snessetjacobian_ snessetjacobian 48 #define snessetjacobian1_ snessetjacobian1 49 #define snessetjacobian2_ snessetjacobian2 50 #define snesgetoptionsprefix_ snesgetoptionsprefix 51 #define snesgettype_ snesgettype 52 #define snessetfunction_ snessetfunction 53 #define snessetngs_ snessetngs 54 #define snessetupdate_ snessetupdate 55 #define snesgetfunction_ snesgetfunction 56 #define snesgetngs_ snesgetngs 57 #define snessetconvergencetest_ snessetconvergencetest 58 #define snesconvergeddefault_ snesconvergeddefault 59 #define snesconvergedskip_ snesconvergedskip 60 #define snesview_ snesview 61 #define snesgetjacobian_ snesgetjacobian 62 #define snesgetconvergencehistory_ snesgetconvergencehistory 63 #define snessettype_ snessettype 64 #define snesappendoptionsprefix_ snesappendoptionsprefix 65 #define snessetoptionsprefix_ snessetoptionsprefix 66 #define snesmonitordefault_ snesmonitordefault 67 #define snesmonitorsolution_ snesmonitorsolution 68 #define snesmonitorsolutionupdate_ snesmonitorsolutionupdate 69 #define snesmonitorset_ snesmonitorset 70 #define snesnewtontrsetprecheck_ snesnewtontrsetprecheck 71 #define snesnewtontrsetpostcheck_ snesnewtontrsetpostcheck 72 #define snesviewfromoptions_ snesviewfromoptions 73 #define snesgetconvergedreasonstring_ snesgetconvergedreasonstring 74 #endif 75 76 static struct { 77 PetscFortranCallbackId function; 78 PetscFortranCallbackId test; 79 PetscFortranCallbackId destroy; 80 PetscFortranCallbackId jacobian; 81 PetscFortranCallbackId monitor; 82 PetscFortranCallbackId mondestroy; 83 PetscFortranCallbackId ngs; 84 PetscFortranCallbackId update; 85 PetscFortranCallbackId trprecheck; 86 PetscFortranCallbackId trpostcheck; 87 #if defined(PETSC_HAVE_F90_2PTR_ARG) 88 PetscFortranCallbackId function_pgiptr; 89 PetscFortranCallbackId trprecheck_pgiptr; 90 PetscFortranCallbackId trpostcheck_pgiptr; 91 #endif 92 } _cb; 93 94 static PetscErrorCode ourtrprecheckfunction(SNES snes,Vec x,Vec y,PetscBool *changed_y,void *ctx) 95 { 96 #if defined(PETSC_HAVE_F90_2PTR_ARG) 97 void* ptr; 98 PetscObjectGetFortranCallback((PetscObject)snes,PETSC_FORTRAN_CALLBACK_CLASS,_cb.trprecheck_pgiptr,NULL,&ptr); 99 #endif 100 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))); 101 } 102 103 PETSC_EXTERN void snesnewtontrsetprecheck_(SNES *snes, void (*func)(SNES,Vec,Vec,PetscBool*,void*),void *ctx,PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptr)) 104 { 105 *ierr = PetscObjectSetFortranCallback((PetscObject)*snes,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.trprecheck,(PetscVoidFunction)func,ctx);if (*ierr) return; 106 #if defined(PETSC_HAVE_F90_2PTR_ARG) 107 *ierr = PetscObjectSetFortranCallback((PetscObject)*snes,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.trprecheck_pgiptr,NULL,ptr);if (*ierr) return; 108 #endif 109 SNESNewtonTRSetPreCheck(*snes,ourtrprecheckfunction,NULL); 110 } 111 112 static PetscErrorCode ourtrpostcheckfunction(SNES snes,Vec x,Vec y,Vec w,PetscBool *changed_y,PetscBool *changed_w,void *ctx) 113 { 114 #if defined(PETSC_HAVE_F90_2PTR_ARG) 115 void* ptr; 116 PetscObjectGetFortranCallback((PetscObject)snes,PETSC_FORTRAN_CALLBACK_CLASS,_cb.trpostcheck_pgiptr,NULL,&ptr); 117 #endif 118 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))); 119 } 120 121 PETSC_EXTERN void snesnewtontrsetpostcheck_(SNES *snes, void (*func)(SNES,Vec,Vec,Vec,PetscBool*,PetscBool*,void*),void *ctx,PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptr)) 122 { 123 *ierr = PetscObjectSetFortranCallback((PetscObject)*snes,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.trpostcheck,(PetscVoidFunction)func,ctx);if (*ierr) return; 124 #if defined(PETSC_HAVE_F90_2PTR_ARG) 125 *ierr = PetscObjectSetFortranCallback((PetscObject)*snes,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.trpostcheck_pgiptr,NULL,ptr);if (*ierr) return; 126 #endif 127 SNESNewtonTRSetPostCheck(*snes,ourtrpostcheckfunction,NULL); 128 } 129 130 static PetscErrorCode oursnesfunction(SNES snes,Vec x,Vec f,void *ctx) 131 { 132 #if defined(PETSC_HAVE_F90_2PTR_ARG) 133 void* ptr; 134 PetscObjectGetFortranCallback((PetscObject)snes,PETSC_FORTRAN_CALLBACK_CLASS,_cb.function_pgiptr,NULL,&ptr); 135 #endif 136 PetscObjectUseFortranCallback(snes,_cb.function,(SNES*,Vec*,Vec*,void*,PetscErrorCode* PETSC_F90_2PTR_PROTO_NOVAR),(&snes,&x,&f,_ctx,&ierr PETSC_F90_2PTR_PARAM(ptr))); 137 } 138 139 static PetscErrorCode oursnestest(SNES snes,PetscInt it,PetscReal a,PetscReal d,PetscReal c,SNESConvergedReason *reason,void *ctx) 140 { 141 PetscObjectUseFortranCallback(snes,_cb.test,(SNES*,PetscInt*,PetscReal*,PetscReal*,PetscReal*,SNESConvergedReason*,void*,PetscErrorCode*),(&snes,&it,&a,&d,&c,reason,_ctx,&ierr)); 142 } 143 144 static PetscErrorCode ourdestroy(void *ctx) 145 { 146 PetscObjectUseFortranCallback(ctx,_cb.destroy,(void*,PetscErrorCode*),(_ctx,&ierr)); 147 } 148 149 static PetscErrorCode oursnesjacobian(SNES snes,Vec x,Mat m,Mat p,void *ctx) 150 { 151 PetscObjectUseFortranCallback(snes,_cb.jacobian,(SNES*,Vec*,Mat*,Mat*,void*,PetscErrorCode*),(&snes,&x,&m,&p,_ctx,&ierr)); 152 } 153 154 static PetscErrorCode oursnesupdate(SNES snes,PetscInt i) 155 { 156 PetscObjectUseFortranCallback(snes,_cb.update,(SNES*,PetscInt *,PetscErrorCode*),(&snes,&i,&ierr)); 157 } 158 static PetscErrorCode oursnesngs(SNES snes,Vec x,Vec b,void *ctx) 159 { 160 PetscObjectUseFortranCallback(snes,_cb.ngs,(SNES*,Vec*,Vec*,void*,PetscErrorCode*),(&snes,&x,&b,_ctx,&ierr)); 161 } 162 static PetscErrorCode oursnesmonitor(SNES snes,PetscInt i,PetscReal d,void *ctx) 163 { 164 PetscObjectUseFortranCallback(snes,_cb.monitor,(SNES*,PetscInt*,PetscReal*,void*,PetscErrorCode*),(&snes,&i,&d,_ctx,&ierr)); 165 } 166 static PetscErrorCode ourmondestroy(void **ctx) 167 { 168 SNES snes = (SNES)*ctx; 169 PetscObjectUseFortranCallback(snes,_cb.mondestroy,(void*,PetscErrorCode*),(_ctx,&ierr)); 170 } 171 172 /* ---------------------------------------------------------*/ 173 /* 174 snescomputejacobiandefault() and snescomputejacobiandefaultcolor() 175 These can be used directly from Fortran but are mostly so that 176 Fortran SNESSetJacobian() will properly handle the defaults being passed in. 177 */ 178 PETSC_EXTERN void matmffdcomputejacobian_(SNES *snes,Vec *x,Mat *m,Mat *p,void *ctx,PetscErrorCode *ierr) 179 { 180 *ierr = MatMFFDComputeJacobian(*snes,*x,*m,*p,ctx); 181 } 182 PETSC_EXTERN void snescomputejacobiandefault_(SNES *snes,Vec *x,Mat *m,Mat *p,void *ctx,PetscErrorCode *ierr) 183 { 184 *ierr = SNESComputeJacobianDefault(*snes,*x,*m,*p,ctx); 185 } 186 PETSC_EXTERN void snescomputejacobiandefaultcolor_(SNES *snes,Vec *x,Mat *m,Mat *p,void *ctx,PetscErrorCode *ierr) 187 { 188 *ierr = SNESComputeJacobianDefaultColor(*snes,*x,*m,*p,*(MatFDColoring*)ctx); 189 } 190 191 PETSC_EXTERN void snessetjacobian_(SNES *snes,Mat *A,Mat *B, 192 void (*func)(SNES*,Vec*,Mat*,Mat*,void*,PetscErrorCode*), 193 void *ctx,PetscErrorCode *ierr) 194 { 195 CHKFORTRANNULLFUNCTION(func); 196 if ((PetscVoidFunction)func == (PetscVoidFunction)snescomputejacobiandefault_) { 197 *ierr = SNESSetJacobian(*snes,*A,*B,SNESComputeJacobianDefault,ctx); 198 } else if ((PetscVoidFunction)func == (PetscVoidFunction)snescomputejacobiandefaultcolor_) { 199 if (!ctx) { 200 *ierr = PETSC_ERR_ARG_NULL; 201 return; 202 } 203 *ierr = SNESSetJacobian(*snes,*A,*B,SNESComputeJacobianDefaultColor,*(MatFDColoring*)ctx); 204 } else if ((PetscVoidFunction)func == (PetscVoidFunction)matmffdcomputejacobian_) { 205 *ierr = SNESSetJacobian(*snes,*A,*B,MatMFFDComputeJacobian,ctx); 206 } else { 207 *ierr = PetscObjectSetFortranCallback((PetscObject)*snes,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.jacobian,(PetscVoidFunction)func,ctx); 208 if (!*ierr) *ierr = SNESSetJacobian(*snes,*A,*B,oursnesjacobian,NULL); 209 } 210 } 211 PETSC_EXTERN void snessetjacobian1_(SNES *snes,Mat *A,Mat *B, 212 void (*func)(SNES*,Vec*,Mat*,Mat*,void*,PetscErrorCode*), 213 void *ctx,PetscErrorCode *ierr) 214 { 215 snessetjacobian_(snes,A,B,func,ctx,ierr); 216 } 217 PETSC_EXTERN void snessetjacobian2_(SNES *snes,Mat *A,Mat *B, 218 void (*func)(SNES*,Vec*,Mat*,Mat*,void*,PetscErrorCode*), 219 void *ctx,PetscErrorCode *ierr) 220 { 221 snessetjacobian_(snes,A,B,func,ctx,ierr); 222 } 223 /* -------------------------------------------------------------*/ 224 static PetscErrorCode oursnespicardfunction(SNES snes,Vec x,Vec f,void *ctx) 225 { 226 #if defined(PETSC_HAVE_F90_2PTR_ARG) 227 void* ptr; 228 PetscObjectGetFortranCallback((PetscObject)snes,PETSC_FORTRAN_CALLBACK_CLASS,_cb.function_pgiptr,NULL,&ptr); 229 #endif 230 PetscObjectUseFortranCallback(snes,_cb.function,(SNES*,Vec*,Vec*,void*,PetscErrorCode* PETSC_F90_2PTR_PROTO_NOVAR),(&snes,&x,&f,_ctx,&ierr PETSC_F90_2PTR_PARAM(ptr))); 231 } 232 233 static PetscErrorCode oursnespicardjacobian(SNES snes,Vec x,Mat m,Mat p,void *ctx) 234 { 235 PetscObjectUseFortranCallback(snes,_cb.jacobian,(SNES*,Vec*,Mat*,Mat*,void*,PetscErrorCode*),(&snes,&x,&m,&p,_ctx,&ierr)); 236 } 237 238 PETSC_EXTERN void snessetpicard_(SNES *snes,Vec *r,void (*func)(SNES*,Vec*,Vec *,void*,PetscErrorCode*),Mat *A,Mat *B, 239 PetscErrorCode (*J)(SNES,Vec,Mat,Mat,void*),void *ctx,PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptr)) 240 { 241 *ierr = PetscObjectSetFortranCallback((PetscObject)*snes,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.function,(PetscVoidFunction)func,ctx); 242 #if defined(PETSC_HAVE_F90_2PTR_ARG) 243 *ierr = PetscObjectSetFortranCallback((PetscObject)*snes,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.function_pgiptr,NULL,ptr);if (*ierr) return; 244 #endif 245 *ierr = PetscObjectSetFortranCallback((PetscObject)*snes,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.jacobian,(PetscVoidFunction)J,ctx); 246 if (!*ierr) *ierr = SNESSetPicard(*snes,*r,oursnespicardfunction,*A,*B,oursnespicardjacobian,NULL); 247 } 248 /* -------------------------------------------------------------*/ 249 250 PETSC_EXTERN void snesgetoptionsprefix_(SNES *snes,char* prefix,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len) 251 { 252 const char *tname; 253 254 *ierr = SNESGetOptionsPrefix(*snes,&tname); 255 *ierr = PetscStrncpy(prefix,tname,len);if (*ierr) return; 256 FIXRETURNCHAR(PETSC_TRUE,prefix,len); 257 } 258 259 PETSC_EXTERN void snesgettype_(SNES *snes,char* name, PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len) 260 { 261 const char *tname; 262 263 *ierr = SNESGetType(*snes,&tname); 264 *ierr = PetscStrncpy(name,tname,len);if (*ierr) return; 265 FIXRETURNCHAR(PETSC_TRUE,name,len); 266 } 267 268 /* ---------------------------------------------------------*/ 269 270 /* 271 These are not usually called from Fortran but allow Fortran users 272 to transparently set these monitors from .F code 273 */ 274 275 PETSC_EXTERN void snessetfunction_(SNES *snes,Vec *r,void (*func)(SNES*,Vec*,Vec*,void*,PetscErrorCode*),void *ctx,PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptr)) 276 { 277 *ierr = PetscObjectSetFortranCallback((PetscObject)*snes,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.function,(PetscVoidFunction)func,ctx);if (*ierr) return; 278 #if defined(PETSC_HAVE_F90_2PTR_ARG) 279 *ierr = PetscObjectSetFortranCallback((PetscObject)*snes,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.function_pgiptr,NULL,ptr);if (*ierr) return; 280 #endif 281 *ierr = SNESSetFunction(*snes,*r,oursnesfunction,NULL); 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 PETSC_EXTERN void snesmonitorset_(SNES *snes,void (*func)(SNES*,PetscInt*,PetscReal*,void*,PetscErrorCode*),void *mctx,void (*mondestroy)(void*,PetscErrorCode*),PetscErrorCode *ierr) 406 { 407 CHKFORTRANNULLFUNCTION(mondestroy); 408 if ((PetscVoidFunction)func == (PetscVoidFunction)snesmonitordefault_) { 409 *ierr = SNESMonitorSet(*snes,(PetscErrorCode (*)(SNES,PetscInt,PetscReal,void*))SNESMonitorDefault,*(PetscViewerAndFormat**)mctx,(PetscErrorCode (*)(void **))PetscViewerAndFormatDestroy); 410 } else if ((PetscVoidFunction)func == (PetscVoidFunction)snesmonitorsolution_) { 411 *ierr = SNESMonitorSet(*snes,(PetscErrorCode (*)(SNES,PetscInt,PetscReal,void*))SNESMonitorSolution,*(PetscViewerAndFormat**)mctx,(PetscErrorCode (*)(void **))PetscViewerAndFormatDestroy); 412 } else if ((PetscVoidFunction)func == (PetscVoidFunction)snesmonitorsolutionupdate_) { 413 *ierr = SNESMonitorSet(*snes,(PetscErrorCode (*)(SNES,PetscInt,PetscReal,void*))SNESMonitorSolutionUpdate,*(PetscViewerAndFormat**)mctx,(PetscErrorCode (*)(void **))PetscViewerAndFormatDestroy); 414 } else { 415 *ierr = PetscObjectSetFortranCallback((PetscObject)*snes,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.monitor,(PetscVoidFunction)func,mctx);if (*ierr) return; 416 *ierr = PetscObjectSetFortranCallback((PetscObject)*snes,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.mondestroy,(PetscVoidFunction)mondestroy,mctx);if (*ierr) return; 417 *ierr = SNESMonitorSet(*snes,oursnesmonitor,*snes,ourmondestroy); 418 } 419 } 420 421 PETSC_EXTERN void snesviewfromoptions_(SNES *ao,PetscObject obj,char* type,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len) 422 { 423 char *t; 424 425 FIXCHAR(type,len,t); 426 CHKFORTRANNULLOBJECT(obj); 427 *ierr = SNESViewFromOptions(*ao,obj,t);if (*ierr) return; 428 FREECHAR(type,t); 429 } 430 431 PETSC_EXTERN void snesconvergedreasonview_(SNES *snes,PetscViewer *viewer, PetscErrorCode *ierr) 432 { 433 PetscViewer v; 434 PetscPatchDefaultViewers_Fortran(viewer,v); 435 *ierr = SNESConvergedReasonView(*snes,v); 436 } 437 438 PETSC_EXTERN void snesgetconvergedreasonstring_(SNES *snes, char* strreason, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len) 439 { 440 const char *tstrreason; 441 *ierr = SNESGetConvergedReasonString(*snes,&tstrreason); 442 *ierr = PetscStrncpy(strreason,tstrreason,len);if (*ierr) return; 443 FIXRETURNCHAR(PETSC_TRUE,strreason,len); 444 } 445