1 #include <petsc-private/fortranimpl.h> 2 #include <petscsys.h> 3 #include <petscviewer.h> 4 5 #if defined(PETSC_HAVE_FORTRAN_CAPS) 6 #define petscpusherrorhandler_ PETSCPUSHERRORHANDLER 7 #define petsctracebackerrorhandler_ PETSCTRACEBACKERRORHANDLER 8 #define petscaborterrorhandler_ PETSCABORTERRORHANDLER 9 #define petscignoreerrorhandler_ PETSCIGNOREERRORHANDLER 10 #define petscemacsclienterrorhandler_ PETSCEMACSCLIENTERRORHANDLER 11 #define petscattachdebuggererrorhandler_ PETSCATTACHDEBUGGERERRORHANDLER 12 #define petscerror_ PETSCERROR 13 #define petscrealview_ PETSCREALVIEW 14 #define petscintview_ PETSCINTVIEW 15 #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE) 16 #define petscpusherrorhandler_ petscpusherrorhandler 17 #define petsctracebackerrorhandler_ petsctracebackerrorhandler 18 #define petscaborterrorhandler_ petscaborterrorhandler 19 #define petscignoreerrorhandler_ petscignoreerrorhandler 20 #define petscemacsclienterrorhandler_ petscemacsclienterrorhandler 21 #define petscattachdebuggererrorhandler_ petscattachdebuggererrorhandler 22 #define petscerror_ petscerror 23 #define petscrealview_ petscrealview 24 #define petscintview_ petscintview 25 #endif 26 27 static void (PETSC_STDCALL *f2)(MPI_Comm *comm,int*,const CHAR PETSC_MIXED_LEN(len1),const CHAR PETSC_MIXED_LEN(len2),const CHAR PETSC_MIXED_LEN(len3),PetscErrorCode*,PetscErrorType*,const CHAR PETSC_MIXED_LEN(len4),void*,PetscErrorCode* PETSC_END_LEN(len1) PETSC_END_LEN(len2) PETSC_END_LEN(len3) PETSC_END_LEN(len4)); 28 29 /* These are not extern C because they are passed into non-extern C user level functions */ 30 static PetscErrorCode ourerrorhandler(MPI_Comm comm,int line,const char *fun,const char *file,const char *dir,PetscErrorCode n,PetscErrorType p,const char *mess,void *ctx) 31 { 32 PetscErrorCode ierr = 0; 33 size_t len1,len2,len3,len4; 34 int l1,l2,l3,l4; 35 36 PetscStrlen(fun,&len1); l1 = (int)len1; 37 PetscStrlen(file,&len2);l2 = (int)len2; 38 PetscStrlen(dir,&len3); l3 = (int)len3; 39 PetscStrlen(mess,&len4);l4 = (int)len4; 40 41 #if defined(PETSC_HAVE_FORTRAN_MIXED_STR_ARG) 42 (*f2)(&comm,&line,fun,l1,file,l2,dir,l3,&n,&p,mess,l4,ctx,&ierr); 43 #else 44 (*f2)(&comm,&line,fun,file,dir,&n,&p,mess,ctx,&ierr,l1,l2,l3,l4); 45 #endif 46 return ierr; 47 } 48 49 /* 50 These are not usually called from Fortran but allow Fortran users 51 to transparently set these monitors from .F code 52 53 functions, hence no STDCALL 54 */ 55 PETSC_EXTERN void petsctracebackerrorhandler_(MPI_Comm *comm,int *line,const char *fun,const char *file,const char *dir,PetscErrorCode *n,PetscErrorType *p,const char *mess,void *ctx,PetscErrorCode *ierr) 56 { 57 *ierr = PetscTraceBackErrorHandler(*comm,*line,fun,file,dir,*n,*p,mess,ctx); 58 } 59 60 PETSC_EXTERN void petscaborterrorhandler_(MPI_Comm *comm,int *line,const char *fun,const char *file,const char *dir,PetscErrorCode *n,PetscErrorType *p,const char *mess,void *ctx,PetscErrorCode *ierr) 61 { 62 *ierr = PetscAbortErrorHandler(*comm,*line,fun,file,dir,*n,*p,mess,ctx); 63 } 64 65 PETSC_EXTERN void petscattachdebuggererrorhandler_(MPI_Comm *comm,int *line,const char *fun,const char *file,const char *dir,PetscErrorCode *n,PetscErrorType *p,const char *mess,void *ctx,PetscErrorCode *ierr) 66 { 67 *ierr = PetscAttachDebuggerErrorHandler(*comm,*line,fun,file,dir,*n,*p,mess,ctx); 68 } 69 70 PETSC_EXTERN void petscemacsclienterrorhandler_(MPI_Comm *comm,int *line,const char *fun,const char *file,const char *dir,PetscErrorCode *n,PetscErrorType *p,const char *mess,void *ctx,PetscErrorCode *ierr) 71 { 72 *ierr = PetscEmacsClientErrorHandler(*comm,*line,fun,file,dir,*n,*p,mess,ctx); 73 } 74 75 PETSC_EXTERN void petscignoreerrorhandler_(MPI_Comm *comm,int *line,const char *fun,const char *file,const char *dir,PetscErrorCode *n,PetscErrorType *p,const char *mess,void *ctx,PetscErrorCode *ierr) 76 { 77 *ierr = PetscIgnoreErrorHandler(*comm,*line,fun,file,dir,*n,*p,mess,ctx); 78 } 79 80 PETSC_EXTERN void PETSC_STDCALL petscpusherrorhandler_(void (PETSC_STDCALL *handler)(MPI_Comm *comm,int*,const CHAR PETSC_MIXED_LEN(len1),const CHAR PETSC_MIXED_LEN(len2),const CHAR PETSC_MIXED_LEN(len3),PetscErrorCode*,PetscErrorType*,const CHAR PETSC_MIXED_LEN(len4),void*,PetscErrorCode* PETSC_END_LEN(len1) PETSC_END_LEN(len2) PETSC_END_LEN(len3) PETSC_END_LEN(len4)),void *ctx,PetscErrorCode *ierr) 81 { 82 if ((void(*)(void))handler == (void(*)(void))petsctracebackerrorhandler_) *ierr = PetscPushErrorHandler(PetscTraceBackErrorHandler,0); 83 else { 84 f2 = handler; 85 *ierr = PetscPushErrorHandler(ourerrorhandler,ctx); 86 } 87 } 88 89 PETSC_EXTERN void PETSC_STDCALL petscerror_(MPI_Comm *comm,PetscErrorCode *number,int *line,PetscErrorType *p,CHAR message PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len)) 90 { 91 char *t1; 92 FIXCHAR(message,len,t1); 93 *ierr = PetscError(*comm,*line,0,0,0,*number,*p,t1); 94 FREECHAR(message,t1); 95 } 96 97 PETSC_EXTERN void PETSC_STDCALL petscrealview_(PetscInt *n,PetscReal *d,PetscViewer *viwer,PetscErrorCode *ierr) 98 { 99 PetscViewer v; 100 PetscPatchDefaultViewers_Fortran(viwer,v); 101 *ierr = PetscRealView(*n,d,v); 102 } 103 104 PETSC_EXTERN void PETSC_STDCALL petscintview_(PetscInt *n,PetscInt *d,PetscViewer *viwer,PetscErrorCode *ierr) 105 { 106 PetscViewer v; 107 PetscPatchDefaultViewers_Fortran(viwer,v); 108 *ierr = PetscIntView(*n,d,v); 109 } 110 111 #if defined(PETSC_HAVE_FORTRAN_CAPS) 112 #define petscscalarview_ PETSCSCALARVIEW 113 #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE) 114 #define petscscalarview_ petscscalarview 115 #endif 116 117 PETSC_EXTERN void PETSC_STDCALL petscscalarview_(PetscInt *n,PetscScalar *d,PetscViewer *viwer,PetscErrorCode *ierr) 118 { 119 PetscViewer v; 120 PetscPatchDefaultViewers_Fortran(viwer,v); 121 *ierr = PetscScalarView(*n,d,v); 122 } 123