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 petscerrorf_ PETSCERRORF 14 #define petscrealview_ PETSCREALVIEW 15 #define petscintview_ PETSCINTVIEW 16 #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE) 17 #define petscpusherrorhandler_ petscpusherrorhandler 18 #define petsctracebackerrorhandler_ petsctracebackerrorhandler 19 #define petscaborterrorhandler_ petscaborterrorhandler 20 #define petscignoreerrorhandler_ petscignoreerrorhandler 21 #define petscemacsclienterrorhandler_ petscemacsclienterrorhandler 22 #define petscattachdebuggererrorhandler_ petscattachdebuggererrorhandler 23 #define petscerror_ petscerror 24 #define petscerrorf_ petscerrorf 25 #define petscrealview_ petscrealview 26 #define petscintview_ petscintview 27 #endif 28 29 static void (PETSC_STDCALL *f2)(MPI_Comm *comm,int*,const char* PETSC_MIXED_LEN(len1),const char* PETSC_MIXED_LEN(len2),PetscErrorCode*,PetscErrorType*,const char* PETSC_MIXED_LEN(len3),void*,PetscErrorCode* PETSC_END_LEN(len1) PETSC_END_LEN(len2) PETSC_END_LEN(len3)); 30 31 /* These are not extern C because they are passed into non-extern C user level functions */ 32 static PetscErrorCode ourerrorhandler(MPI_Comm comm,int line,const char *fun,const char *file,PetscErrorCode n,PetscErrorType p,const char *mess,void *ctx) 33 { 34 PetscErrorCode ierr = 0; 35 size_t len1,len2,len3; 36 int l1,l2,l3; 37 38 PetscStrlen(fun,&len1); l1 = (int)len1; 39 PetscStrlen(file,&len2);l2 = (int)len2; 40 PetscStrlen(mess,&len3);l3 = (int)len3; 41 42 #if defined(PETSC_HAVE_FORTRAN_MIXED_STR_ARG) 43 (*f2)(&comm,&line,fun,l1,file,l2,&n,&p,mess,l3,ctx,&ierr); 44 #else 45 (*f2)(&comm,&line,fun,file,&n,&p,mess,ctx,&ierr,l1,l2,l3); 46 #endif 47 return ierr; 48 } 49 50 /* 51 These are not usually called from Fortran but allow Fortran users 52 to transparently set these monitors from .F code 53 54 functions, hence no STDCALL 55 */ 56 PETSC_EXTERN void petsctracebackerrorhandler_(MPI_Comm *comm,int *line,const char *fun,const char *file,PetscErrorCode *n,PetscErrorType *p,const char *mess,void *ctx,PetscErrorCode *ierr) 57 { 58 *ierr = PetscTraceBackErrorHandler(*comm,*line,fun,file,*n,*p,mess,ctx); 59 } 60 61 PETSC_EXTERN void petscaborterrorhandler_(MPI_Comm *comm,int *line,const char *fun,const char *file,PetscErrorCode *n,PetscErrorType *p,const char *mess,void *ctx,PetscErrorCode *ierr) 62 { 63 *ierr = PetscAbortErrorHandler(*comm,*line,fun,file,*n,*p,mess,ctx); 64 } 65 66 PETSC_EXTERN void petscattachdebuggererrorhandler_(MPI_Comm *comm,int *line,const char *fun,const char *file,PetscErrorCode *n,PetscErrorType *p,const char *mess,void *ctx,PetscErrorCode *ierr) 67 { 68 *ierr = PetscAttachDebuggerErrorHandler(*comm,*line,fun,file,*n,*p,mess,ctx); 69 } 70 71 PETSC_EXTERN void petscemacsclienterrorhandler_(MPI_Comm *comm,int *line,const char *fun,const char *file,PetscErrorCode *n,PetscErrorType *p,const char *mess,void *ctx,PetscErrorCode *ierr) 72 { 73 *ierr = PetscEmacsClientErrorHandler(*comm,*line,fun,file,*n,*p,mess,ctx); 74 } 75 76 PETSC_EXTERN void petscignoreerrorhandler_(MPI_Comm *comm,int *line,const char *fun,const char *file,PetscErrorCode *n,PetscErrorType *p,const char *mess,void *ctx,PetscErrorCode *ierr) 77 { 78 *ierr = PetscIgnoreErrorHandler(*comm,*line,fun,file,*n,*p,mess,ctx); 79 } 80 81 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),PetscErrorCode*,PetscErrorType*,const char* PETSC_MIXED_LEN(len3),void*,PetscErrorCode* PETSC_END_LEN(len1) PETSC_END_LEN(len2) PETSC_END_LEN(len3)),void *ctx,PetscErrorCode *ierr) 82 { 83 if ((void(*)(void))handler == (void(*)(void))petsctracebackerrorhandler_) *ierr = PetscPushErrorHandler(PetscTraceBackErrorHandler,0); 84 else { 85 f2 = handler; 86 *ierr = PetscPushErrorHandler(ourerrorhandler,ctx); 87 } 88 } 89 90 PETSC_EXTERN void PETSC_STDCALL petscerror_(MPI_Fint *comm,PetscErrorCode *number,PetscErrorType *p,char* message PETSC_MIXED_LEN(len) PETSC_END_LEN(len)) 91 { 92 PetscErrorCode nierr,*ierr = &nierr; 93 char *t1; 94 FIXCHAR(message,len,t1); 95 nierr = PetscError(MPI_Comm_f2c(*(comm)),0,NULL,NULL,*number,*p,t1); 96 FREECHAR(message,t1); 97 } 98 99 /* helper routine for CHKERRQ and CHKERRABORT macros on the fortran side */ 100 PETSC_EXTERN void PETSC_STDCALL petscerrorf_(PetscErrorCode *number) 101 { 102 PetscError(PETSC_COMM_SELF,0,NULL,NULL,*number,PETSC_ERROR_REPEAT,NULL); 103 } 104 105 PETSC_EXTERN void PETSC_STDCALL petscrealview_(PetscInt *n,PetscReal *d,PetscViewer *viwer,PetscErrorCode *ierr) 106 { 107 PetscViewer v; 108 PetscPatchDefaultViewers_Fortran(viwer,v); 109 *ierr = PetscRealView(*n,d,v); 110 } 111 112 PETSC_EXTERN void PETSC_STDCALL petscintview_(PetscInt *n,PetscInt *d,PetscViewer *viwer,PetscErrorCode *ierr) 113 { 114 PetscViewer v; 115 PetscPatchDefaultViewers_Fortran(viwer,v); 116 *ierr = PetscIntView(*n,d,v); 117 } 118 119 #if defined(PETSC_HAVE_FORTRAN_CAPS) 120 #define petscscalarview_ PETSCSCALARVIEW 121 #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE) 122 #define petscscalarview_ petscscalarview 123 #endif 124 125 PETSC_EXTERN void PETSC_STDCALL petscscalarview_(PetscInt *n,PetscScalar *d,PetscViewer *viwer,PetscErrorCode *ierr) 126 { 127 PetscViewer v; 128 PetscPatchDefaultViewers_Fortran(viwer,v); 129 *ierr = PetscScalarView(*n,d,v); 130 } 131