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 snesmonitorlgresidualnorm_ SNESMONITORLGRESIDUALNORM 35 #define snesmonitorsolutionupdate_ SNESMONITORSOLUTIONUPDATE 36 #define snesmonitorset_ SNESMONITORSET 37 #define snesnewtontrsetprecheck_ SNESNEWTONTRSETPRECHECK 38 #define snesnewtontrsetpostcheck_ SNESNEWTONTRSETPOSTCHECK 39 #define snesviewfromoptions_ SNESVIEWFROMOPTIONS 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 snesmonitorlgresidualnorm_ snesmonitorlgresidualnorm 67 #define snesmonitordefault_ snesmonitordefault 68 #define snesmonitorsolution_ snesmonitorsolution 69 #define snesmonitorsolutionupdate_ snesmonitorsolutionupdate 70 #define snesmonitorset_ snesmonitorset 71 #define snesnewtontrsetprecheck_ snesnewtontrsetprecheck 72 #define snesnewtontrsetpostcheck_ snesnewtontrsetpostcheck 73 #define snesviewfromoptions_ snesviewfromoptions 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 113 static PetscErrorCode ourtrpostcheckfunction(SNES snes,Vec x,Vec y,Vec w,PetscBool *changed_y,PetscBool *changed_w,void *ctx) 114 { 115 #if defined(PETSC_HAVE_F90_2PTR_ARG) 116 void* ptr; 117 PetscObjectGetFortranCallback((PetscObject)snes,PETSC_FORTRAN_CALLBACK_CLASS,_cb.trpostcheck_pgiptr,NULL,&ptr); 118 #endif 119 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))); 120 } 121 122 PETSC_EXTERN void snesnewtontrsetpostcheck_(SNES *snes, void (*func)(SNES,Vec,Vec,Vec,PetscBool*,PetscBool*,void*),void *ctx,PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptr)) 123 { 124 *ierr = PetscObjectSetFortranCallback((PetscObject)*snes,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.trpostcheck,(PetscVoidFunction)func,ctx);if (*ierr) return; 125 #if defined(PETSC_HAVE_F90_2PTR_ARG) 126 *ierr = PetscObjectSetFortranCallback((PetscObject)*snes,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.trpostcheck_pgiptr,NULL,ptr);if (*ierr) return; 127 #endif 128 SNESNewtonTRSetPostCheck(*snes,ourtrpostcheckfunction,NULL); 129 } 130 131 static PetscErrorCode oursnesfunction(SNES snes,Vec x,Vec f,void *ctx) 132 { 133 #if defined(PETSC_HAVE_F90_2PTR_ARG) 134 void* ptr; 135 PetscObjectGetFortranCallback((PetscObject)snes,PETSC_FORTRAN_CALLBACK_CLASS,_cb.function_pgiptr,NULL,&ptr); 136 #endif 137 PetscObjectUseFortranCallback(snes,_cb.function,(SNES*,Vec*,Vec*,void*,PetscErrorCode* PETSC_F90_2PTR_PROTO_NOVAR),(&snes,&x,&f,_ctx,&ierr PETSC_F90_2PTR_PARAM(ptr))); 138 } 139 140 static PetscErrorCode oursnestest(SNES snes,PetscInt it,PetscReal a,PetscReal d,PetscReal c,SNESConvergedReason *reason,void *ctx) 141 { 142 PetscObjectUseFortranCallback(snes,_cb.test,(SNES*,PetscInt*,PetscReal*,PetscReal*,PetscReal*,SNESConvergedReason*,void*,PetscErrorCode*),(&snes,&it,&a,&d,&c,reason,_ctx,&ierr)); 143 } 144 145 static PetscErrorCode ourdestroy(void *ctx) 146 { 147 PetscObjectUseFortranCallback(ctx,_cb.destroy,(void*,PetscErrorCode*),(_ctx,&ierr)); 148 } 149 150 static PetscErrorCode oursnesjacobian(SNES snes,Vec x,Mat m,Mat p,void *ctx) 151 { 152 PetscObjectUseFortranCallback(snes,_cb.jacobian,(SNES*,Vec*,Mat*,Mat*,void*,PetscErrorCode*),(&snes,&x,&m,&p,_ctx,&ierr)); 153 } 154 155 static PetscErrorCode oursnesupdate(SNES snes,PetscInt i) 156 { 157 PetscObjectUseFortranCallback(snes,_cb.update,(SNES*,PetscInt *,PetscErrorCode*),(&snes,&i,&ierr)); 158 } 159 static PetscErrorCode oursnesngs(SNES snes,Vec x,Vec b,void *ctx) 160 { 161 PetscObjectUseFortranCallback(snes,_cb.ngs,(SNES*,Vec*,Vec*,void*,PetscErrorCode*),(&snes,&x,&b,_ctx,&ierr)); 162 } 163 static PetscErrorCode oursnesmonitor(SNES snes,PetscInt i,PetscReal d,void *ctx) 164 { 165 PetscObjectUseFortranCallback(snes,_cb.monitor,(SNES*,PetscInt*,PetscReal*,void*,PetscErrorCode*),(&snes,&i,&d,_ctx,&ierr)); 166 } 167 static PetscErrorCode ourmondestroy(void **ctx) 168 { 169 SNES snes = (SNES)*ctx; 170 PetscObjectUseFortranCallback(snes,_cb.mondestroy,(void*,PetscErrorCode*),(_ctx,&ierr)); 171 } 172 173 /* ---------------------------------------------------------*/ 174 /* 175 snescomputejacobiandefault() and snescomputejacobiandefaultcolor() 176 These can be used directly from Fortran but are mostly so that 177 Fortran SNESSetJacobian() will properly handle the defaults being passed in. 178 */ 179 PETSC_EXTERN void matmffdcomputejacobian_(SNES *snes,Vec *x,Mat *m,Mat *p,void *ctx,PetscErrorCode *ierr) 180 { 181 *ierr = MatMFFDComputeJacobian(*snes,*x,*m,*p,ctx); 182 } 183 PETSC_EXTERN void snescomputejacobiandefault_(SNES *snes,Vec *x,Mat *m,Mat *p,void *ctx,PetscErrorCode *ierr) 184 { 185 *ierr = SNESComputeJacobianDefault(*snes,*x,*m,*p,ctx); 186 } 187 PETSC_EXTERN void snescomputejacobiandefaultcolor_(SNES *snes,Vec *x,Mat *m,Mat *p,void *ctx,PetscErrorCode *ierr) 188 { 189 *ierr = SNESComputeJacobianDefaultColor(*snes,*x,*m,*p,*(MatFDColoring*)ctx); 190 } 191 192 PETSC_EXTERN void snessetjacobian_(SNES *snes,Mat *A,Mat *B, 193 void (*func)(SNES*,Vec*,Mat*,Mat*,void*,PetscErrorCode*), 194 void *ctx,PetscErrorCode *ierr) 195 { 196 CHKFORTRANNULLFUNCTION(func); 197 if ((PetscVoidFunction)func == (PetscVoidFunction)snescomputejacobiandefault_) { 198 *ierr = SNESSetJacobian(*snes,*A,*B,SNESComputeJacobianDefault,ctx); 199 } else if ((PetscVoidFunction)func == (PetscVoidFunction)snescomputejacobiandefaultcolor_) { 200 if (!ctx) { 201 *ierr = PETSC_ERR_ARG_NULL; 202 return; 203 } 204 *ierr = SNESSetJacobian(*snes,*A,*B,SNESComputeJacobianDefaultColor,*(MatFDColoring*)ctx); 205 } else if ((PetscVoidFunction)func == (PetscVoidFunction)matmffdcomputejacobian_) { 206 *ierr = SNESSetJacobian(*snes,*A,*B,MatMFFDComputeJacobian,ctx); 207 } else { 208 *ierr = PetscObjectSetFortranCallback((PetscObject)*snes,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.jacobian,(PetscVoidFunction)func,ctx); 209 if (!*ierr) *ierr = SNESSetJacobian(*snes,*A,*B,oursnesjacobian,NULL); 210 } 211 } 212 PETSC_EXTERN void snessetjacobian1_(SNES *snes,Mat *A,Mat *B, 213 void (*func)(SNES*,Vec*,Mat*,Mat*,void*,PetscErrorCode*), 214 void *ctx,PetscErrorCode *ierr) 215 { 216 snessetjacobian_(snes,A,B,func,ctx,ierr); 217 } 218 PETSC_EXTERN void snessetjacobian2_(SNES *snes,Mat *A,Mat *B, 219 void (*func)(SNES*,Vec*,Mat*,Mat*,void*,PetscErrorCode*), 220 void *ctx,PetscErrorCode *ierr) 221 { 222 snessetjacobian_(snes,A,B,func,ctx,ierr); 223 } 224 /* -------------------------------------------------------------*/ 225 static PetscErrorCode oursnespicardfunction(SNES snes,Vec x,Vec f,void *ctx) 226 { 227 #if defined(PETSC_HAVE_F90_2PTR_ARG) 228 void* ptr; 229 PetscObjectGetFortranCallback((PetscObject)snes,PETSC_FORTRAN_CALLBACK_CLASS,_cb.function_pgiptr,NULL,&ptr); 230 #endif 231 PetscObjectUseFortranCallback(snes,_cb.function,(SNES*,Vec*,Vec*,void*,PetscErrorCode* PETSC_F90_2PTR_PROTO_NOVAR),(&snes,&x,&f,_ctx,&ierr PETSC_F90_2PTR_PARAM(ptr))); 232 } 233 234 static PetscErrorCode oursnespicardjacobian(SNES snes,Vec x,Mat m,Mat p,void *ctx) 235 { 236 PetscObjectUseFortranCallback(snes,_cb.jacobian,(SNES*,Vec*,Mat*,Mat*,void*,PetscErrorCode*),(&snes,&x,&m,&p,_ctx,&ierr)); 237 } 238 239 PETSC_EXTERN void snessetpicard_(SNES *snes,Vec *r,void (*func)(SNES*,Vec*,Vec *,void*,PetscErrorCode*),Mat *A,Mat *B, 240 PetscErrorCode (*J)(SNES,Vec,Mat,Mat,void*),void *ctx,PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptr)) 241 { 242 *ierr = PetscObjectSetFortranCallback((PetscObject)*snes,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.function,(PetscVoidFunction)func,ctx); 243 #if defined(PETSC_HAVE_F90_2PTR_ARG) 244 *ierr = PetscObjectSetFortranCallback((PetscObject)*snes,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.function_pgiptr,NULL,ptr);if (*ierr) return; 245 #endif 246 *ierr = PetscObjectSetFortranCallback((PetscObject)*snes,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.jacobian,(PetscVoidFunction)J,ctx); 247 if (!*ierr) *ierr = SNESSetPicard(*snes,*r,oursnespicardfunction,*A,*B,oursnespicardjacobian,NULL); 248 } 249 /* -------------------------------------------------------------*/ 250 251 PETSC_EXTERN void snesgetoptionsprefix_(SNES *snes,char* prefix,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len) 252 { 253 const char *tname; 254 255 *ierr = SNESGetOptionsPrefix(*snes,&tname); 256 *ierr = PetscStrncpy(prefix,tname,len);if (*ierr) return; 257 FIXRETURNCHAR(PETSC_TRUE,prefix,len); 258 } 259 260 PETSC_EXTERN void snesgettype_(SNES *snes,char* name, PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len) 261 { 262 const char *tname; 263 264 *ierr = SNESGetType(*snes,&tname); 265 *ierr = PetscStrncpy(name,tname,len);if (*ierr) return; 266 FIXRETURNCHAR(PETSC_TRUE,name,len); 267 } 268 269 /* ---------------------------------------------------------*/ 270 271 /* 272 These are not usually called from Fortran but allow Fortran users 273 to transparently set these monitors from .F code 274 */ 275 276 PETSC_EXTERN void snessetfunction_(SNES *snes,Vec *r,void (*func)(SNES*,Vec*,Vec*,void*,PetscErrorCode*),void *ctx,PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptr)) 277 { 278 *ierr = PetscObjectSetFortranCallback((PetscObject)*snes,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.function,(PetscVoidFunction)func,ctx);if (*ierr) return; 279 #if defined(PETSC_HAVE_F90_2PTR_ARG) 280 *ierr = PetscObjectSetFortranCallback((PetscObject)*snes,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.function_pgiptr,NULL,ptr);if (*ierr) return; 281 #endif 282 *ierr = SNESSetFunction(*snes,*r,oursnesfunction,NULL); 283 } 284 285 286 PETSC_EXTERN void snessetngs_(SNES *snes,void (*func)(SNES*,Vec*,Vec*,void*,PetscErrorCode*),void *ctx,PetscErrorCode *ierr) 287 { 288 *ierr = PetscObjectSetFortranCallback((PetscObject)*snes,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.ngs,(PetscVoidFunction)func,ctx);if (*ierr) return; 289 *ierr = SNESSetNGS(*snes,oursnesngs,NULL); 290 } 291 PETSC_EXTERN void snessetupdate_(SNES *snes,void (*func)(SNES*,PetscInt*,PetscErrorCode*),PetscErrorCode *ierr) 292 { 293 *ierr = PetscObjectSetFortranCallback((PetscObject)*snes,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.update,(PetscVoidFunction)func,NULL);if (*ierr) return; 294 *ierr = SNESSetUpdate(*snes,oursnesupdate); 295 } 296 /* ---------------------------------------------------------*/ 297 298 /* the func argument is ignored */ 299 PETSC_EXTERN void snesgetfunction_(SNES *snes,Vec *r,void (*func)(SNES,Vec,Vec,void*),void **ctx,PetscErrorCode *ierr) 300 { 301 CHKFORTRANNULLOBJECT(r); 302 *ierr = SNESGetFunction(*snes,r,NULL,NULL); if (*ierr) return; 303 if ((PetscVoidFunction)func == (PetscVoidFunction)PETSC_NULL_FUNCTION_Fortran) return; 304 *ierr = PetscObjectGetFortranCallback((PetscObject)*snes,PETSC_FORTRAN_CALLBACK_CLASS,_cb.function,NULL,ctx); 305 } 306 307 PETSC_EXTERN void snesgetngs_(SNES *snes,void *func,void **ctx,PetscErrorCode *ierr) 308 { 309 *ierr = PetscObjectGetFortranCallback((PetscObject)*snes,PETSC_FORTRAN_CALLBACK_CLASS,_cb.ngs,NULL,ctx); 310 } 311 312 /*----------------------------------------------------------------------*/ 313 314 PETSC_EXTERN void snesconvergeddefault_(SNES *snes,PetscInt *it,PetscReal *a,PetscReal *b,PetscReal *c,SNESConvergedReason *r, void *ct,PetscErrorCode *ierr) 315 { 316 *ierr = SNESConvergedDefault(*snes,*it,*a,*b,*c,r,ct); 317 } 318 319 PETSC_EXTERN void snesconvergedskip_(SNES *snes,PetscInt *it,PetscReal *a,PetscReal *b,PetscReal *c,SNESConvergedReason *r,void *ct,PetscErrorCode *ierr) 320 { 321 *ierr = SNESConvergedSkip(*snes,*it,*a,*b,*c,r,ct); 322 } 323 324 PETSC_EXTERN void snessetconvergencetest_(SNES *snes,void (*func)(SNES*,PetscInt*,PetscReal*,PetscReal*,PetscReal*,SNESConvergedReason*,void*,PetscErrorCode*), void *cctx,void (*destroy)(void*),PetscErrorCode *ierr) 325 { 326 CHKFORTRANNULLFUNCTION(destroy); 327 328 if ((PetscVoidFunction)func == (PetscVoidFunction)snesconvergeddefault_) { 329 *ierr = SNESSetConvergenceTest(*snes,SNESConvergedDefault,0,0); 330 } else if ((PetscVoidFunction)func == (PetscVoidFunction)snesconvergedskip_) { 331 *ierr = SNESSetConvergenceTest(*snes,SNESConvergedSkip,0,0); 332 } else { 333 *ierr = PetscObjectSetFortranCallback((PetscObject)*snes,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.test,(PetscVoidFunction)func,cctx);if (*ierr) return; 334 *ierr = PetscObjectSetFortranCallback((PetscObject)*snes,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.destroy,(PetscVoidFunction)destroy,cctx);if (*ierr) return; 335 *ierr = SNESSetConvergenceTest(*snes,oursnestest,*snes,ourdestroy); 336 } 337 } 338 /*----------------------------------------------------------------------*/ 339 340 PETSC_EXTERN void snesview_(SNES *snes,PetscViewer *viewer, PetscErrorCode *ierr) 341 { 342 PetscViewer v; 343 PetscPatchDefaultViewers_Fortran(viewer,v); 344 *ierr = SNESView(*snes,v); 345 } 346 347 /* func is currently ignored from Fortran */ 348 PETSC_EXTERN void snesgetjacobian_(SNES *snes,Mat *A,Mat *B,int *func,void **ctx,PetscErrorCode *ierr) 349 { 350 CHKFORTRANNULLINTEGER(ctx); 351 CHKFORTRANNULLOBJECT(A); 352 CHKFORTRANNULLOBJECT(B); 353 *ierr = SNESGetJacobian(*snes,A,B,0,NULL); if (*ierr) return; 354 *ierr = PetscObjectGetFortranCallback((PetscObject)*snes,PETSC_FORTRAN_CALLBACK_CLASS,_cb.jacobian,NULL,ctx); 355 356 } 357 358 PETSC_EXTERN void snesgetconvergencehistory_(SNES *snes,PetscInt *na,PetscErrorCode *ierr) 359 { 360 *ierr = SNESGetConvergenceHistory(*snes,NULL,NULL,na); 361 } 362 363 PETSC_EXTERN void snessettype_(SNES *snes,char* type,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len) 364 { 365 char *t; 366 367 FIXCHAR(type,len,t); 368 *ierr = SNESSetType(*snes,t);if (*ierr) return; 369 FREECHAR(type,t); 370 } 371 372 PETSC_EXTERN void snesappendoptionsprefix_(SNES *snes,char* prefix,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len) 373 { 374 char *t; 375 376 FIXCHAR(prefix,len,t); 377 *ierr = SNESAppendOptionsPrefix(*snes,t);if (*ierr) return; 378 FREECHAR(prefix,t); 379 } 380 381 PETSC_EXTERN void snessetoptionsprefix_(SNES *snes,char* prefix,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len) 382 { 383 char *t; 384 385 FIXCHAR(prefix,len,t); 386 *ierr = SNESSetOptionsPrefix(*snes,t);if (*ierr) return; 387 FREECHAR(prefix,t); 388 } 389 390 /*----------------------------------------------------------------------*/ 391 392 PETSC_EXTERN void snesmonitorlgresidualnorm_(SNES *snes,PetscInt *its,PetscReal *fgnorm,PetscObject *dummy,PetscErrorCode *ierr) 393 { 394 *ierr = SNESMonitorLGResidualNorm(*snes,*its,*fgnorm,dummy); 395 } 396 397 PETSC_EXTERN void snesmonitordefault_(SNES *snes,PetscInt *its,PetscReal *fgnorm,PetscViewerAndFormat **dummy,PetscErrorCode *ierr) 398 { 399 *ierr = SNESMonitorDefault(*snes,*its,*fgnorm,*dummy); 400 } 401 402 PETSC_EXTERN void snesmonitorsolution_(SNES *snes,PetscInt *its,PetscReal *fgnorm,PetscViewerAndFormat **dummy,PetscErrorCode *ierr) 403 { 404 *ierr = SNESMonitorSolution(*snes,*its,*fgnorm,*dummy); 405 } 406 407 PETSC_EXTERN void snesmonitorsolutionupdate_(SNES *snes,PetscInt *its,PetscReal *fgnorm,PetscViewerAndFormat **dummy,PetscErrorCode *ierr) 408 { 409 *ierr = SNESMonitorSolutionUpdate(*snes,*its,*fgnorm,*dummy); 410 } 411 412 413 PETSC_EXTERN void snesmonitorset_(SNES *snes,void (*func)(SNES*,PetscInt*,PetscReal*,void*,PetscErrorCode*),void *mctx,void (*mondestroy)(void*,PetscErrorCode*),PetscErrorCode *ierr) 414 { 415 CHKFORTRANNULLFUNCTION(mondestroy); 416 if ((PetscVoidFunction)func == (PetscVoidFunction)snesmonitordefault_) { 417 *ierr = SNESMonitorSet(*snes,(PetscErrorCode (*)(SNES,PetscInt,PetscReal,void*))SNESMonitorDefault,*(PetscViewerAndFormat**)mctx,(PetscErrorCode (*)(void **))PetscViewerAndFormatDestroy); 418 } else if ((PetscVoidFunction)func == (PetscVoidFunction)snesmonitorsolution_) { 419 *ierr = SNESMonitorSet(*snes,(PetscErrorCode (*)(SNES,PetscInt,PetscReal,void*))SNESMonitorSolution,*(PetscViewerAndFormat**)mctx,(PetscErrorCode (*)(void **))PetscViewerAndFormatDestroy); 420 } else if ((PetscVoidFunction)func == (PetscVoidFunction)snesmonitorsolutionupdate_) { 421 *ierr = SNESMonitorSet(*snes,(PetscErrorCode (*)(SNES,PetscInt,PetscReal,void*))SNESMonitorSolutionUpdate,*(PetscViewerAndFormat**)mctx,(PetscErrorCode (*)(void **))PetscViewerAndFormatDestroy); 422 } else if ((PetscVoidFunction)func == (PetscVoidFunction)snesmonitorlgresidualnorm_) { 423 *ierr = SNESMonitorSet(*snes,(PetscErrorCode (*)(SNES,PetscInt,PetscReal,void*))SNESMonitorLGResidualNorm,0,0); 424 } else { 425 *ierr = PetscObjectSetFortranCallback((PetscObject)*snes,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.monitor,(PetscVoidFunction)func,mctx);if (*ierr) return; 426 *ierr = PetscObjectSetFortranCallback((PetscObject)*snes,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.mondestroy,(PetscVoidFunction)mondestroy,mctx);if (*ierr) return; 427 *ierr = SNESMonitorSet(*snes,oursnesmonitor,*snes,ourmondestroy); 428 } 429 } 430 431 PETSC_EXTERN void snesviewfromoptions_(SNES *ao,PetscObject obj,char* type,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len) 432 { 433 char *t; 434 435 FIXCHAR(type,len,t); 436 *ierr = SNESViewFromOptions(*ao,obj,t);if (*ierr) return; 437 FREECHAR(type,t); 438 } 439 440 PETSC_EXTERN void snesconvergedreasonview_(SNES *snes,PetscViewer *viewer, PetscErrorCode *ierr) 441 { 442 PetscViewer v; 443 PetscPatchDefaultViewers_Fortran(viewer,v); 444 *ierr = SNESConvergedReasonView(*snes,v); 445 } 446