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 (*f2)(MPI_Comm *comm,int*,const char*,const char*,PetscErrorCode*,PetscErrorType*,const char*,void*,PetscErrorCode*,PETSC_FORTRAN_CHARLEN_T len1,PETSC_FORTRAN_CHARLEN_T len2,PETSC_FORTRAN_CHARLEN_T 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 37 PetscStrlen(fun,&len1); 38 PetscStrlen(file,&len2); 39 PetscStrlen(mess,&len3); 40 41 (*f2)(&comm,&line,fun,file,&n,&p,mess,ctx,&ierr,((PETSC_FORTRAN_CHARLEN_T)(len1)),((PETSC_FORTRAN_CHARLEN_T)(len2)),((PETSC_FORTRAN_CHARLEN_T)(len3))); 42 return ierr; 43 } 44 45 /* 46 These are not usually called from Fortran but allow Fortran users 47 to transparently set these monitors from .F code 48 */ 49 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) 50 { 51 *ierr = PetscTraceBackErrorHandler(*comm,*line,fun,file,*n,*p,mess,ctx); 52 } 53 54 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) 55 { 56 *ierr = PetscAbortErrorHandler(*comm,*line,fun,file,*n,*p,mess,ctx); 57 } 58 59 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) 60 { 61 *ierr = PetscAttachDebuggerErrorHandler(*comm,*line,fun,file,*n,*p,mess,ctx); 62 } 63 64 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) 65 { 66 *ierr = PetscEmacsClientErrorHandler(*comm,*line,fun,file,*n,*p,mess,ctx); 67 } 68 69 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) 70 { 71 *ierr = PetscIgnoreErrorHandler(*comm,*line,fun,file,*n,*p,mess,ctx); 72 } 73 74 PETSC_EXTERN void petscpusherrorhandler_(void (*handler)(MPI_Comm *comm,int*,const char*,const char*,PetscErrorCode*,PetscErrorType*,const char*,void*,PetscErrorCode*,PETSC_FORTRAN_CHARLEN_T len1,PETSC_FORTRAN_CHARLEN_T len2,PETSC_FORTRAN_CHARLEN_T len3),void *ctx,PetscErrorCode *ierr) 75 { 76 if ((void(*)(void))handler == (void(*)(void))petsctracebackerrorhandler_) *ierr = PetscPushErrorHandler(PetscTraceBackErrorHandler,0); 77 else { 78 f2 = handler; 79 *ierr = PetscPushErrorHandler(ourerrorhandler,ctx); 80 } 81 } 82 83 PETSC_EXTERN void petscerror_(MPI_Fint *comm,PetscErrorCode *number,PetscErrorType *p,char* message,PETSC_FORTRAN_CHARLEN_T len) 84 { 85 PetscErrorCode nierr,*ierr = &nierr; 86 char *t1; 87 FIXCHAR(message,len,t1); 88 nierr = PetscError(MPI_Comm_f2c(*(comm)),0,NULL,NULL,*number,*p,t1); 89 FREECHAR(message,t1); 90 } 91 92 /* helper routine for CHKERRQ and CHKERRABORT macros on the fortran side */ 93 PETSC_EXTERN void petscerrorf_(PetscErrorCode *number) 94 { 95 PetscError(PETSC_COMM_SELF,0,NULL,NULL,*number,PETSC_ERROR_REPEAT,NULL); 96 } 97 98 PETSC_EXTERN void petscrealview_(PetscInt *n,PetscReal *d,PetscViewer *viwer,PetscErrorCode *ierr) 99 { 100 PetscViewer v; 101 PetscPatchDefaultViewers_Fortran(viwer,v); 102 *ierr = PetscRealView(*n,d,v); 103 } 104 105 PETSC_EXTERN void petscintview_(PetscInt *n,PetscInt *d,PetscViewer *viwer,PetscErrorCode *ierr) 106 { 107 PetscViewer v; 108 PetscPatchDefaultViewers_Fortran(viwer,v); 109 *ierr = PetscIntView(*n,d,v); 110 } 111 112 #if defined(PETSC_HAVE_FORTRAN_CAPS) 113 #define petscscalarview_ PETSCSCALARVIEW 114 #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE) 115 #define petscscalarview_ petscscalarview 116 #endif 117 118 PETSC_EXTERN void petscscalarview_(PetscInt *n,PetscScalar *d,PetscViewer *viwer,PetscErrorCode *ierr) 119 { 120 PetscViewer v; 121 PetscPatchDefaultViewers_Fortran(viwer,v); 122 *ierr = PetscScalarView(*n,d,v); 123 } 124