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 petscerrormpi_ PETSCERRORMPI 15 #define petscrealview_ PETSCREALVIEW 16 #define petscintview_ PETSCINTVIEW 17 #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE) 18 #define petscpusherrorhandler_ petscpusherrorhandler 19 #define petsctracebackerrorhandler_ petsctracebackerrorhandler 20 #define petscaborterrorhandler_ petscaborterrorhandler 21 #define petscignoreerrorhandler_ petscignoreerrorhandler 22 #define petscemacsclienterrorhandler_ petscemacsclienterrorhandler 23 #define petscattachdebuggererrorhandler_ petscattachdebuggererrorhandler 24 #define petscerror_ petscerror 25 #define petscerrorf_ petscerrorf 26 #define petscerrormpi_ petscerrormpi 27 #define petscrealview_ petscrealview 28 #define petscintview_ petscintview 29 #endif 30 31 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); 32 33 /* These are not extern C because they are passed into non-extern C user level functions */ 34 static PetscErrorCode ourerrorhandler(MPI_Comm comm,int line,const char *fun,const char *file,PetscErrorCode n,PetscErrorType p,const char *mess,void *ctx) 35 { 36 PetscErrorCode ierr = 0; 37 size_t len1,len2,len3; 38 39 PetscStrlen(fun,&len1); 40 PetscStrlen(file,&len2); 41 PetscStrlen(mess,&len3); 42 43 (*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))); 44 return ierr; 45 } 46 47 /* 48 These are not usually called from Fortran but allow Fortran users 49 to transparently set these monitors from .F code 50 */ 51 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) 52 { 53 *ierr = PetscTraceBackErrorHandler(*comm,*line,fun,file,*n,*p,mess,ctx); 54 } 55 56 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) 57 { 58 *ierr = PetscAbortErrorHandler(*comm,*line,fun,file,*n,*p,mess,ctx); 59 } 60 61 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) 62 { 63 *ierr = PetscAttachDebuggerErrorHandler(*comm,*line,fun,file,*n,*p,mess,ctx); 64 } 65 66 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) 67 { 68 *ierr = PetscEmacsClientErrorHandler(*comm,*line,fun,file,*n,*p,mess,ctx); 69 } 70 71 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) 72 { 73 *ierr = PetscIgnoreErrorHandler(*comm,*line,fun,file,*n,*p,mess,ctx); 74 } 75 76 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) 77 { 78 if ((void(*)(void))handler == (void(*)(void))petsctracebackerrorhandler_) *ierr = PetscPushErrorHandler(PetscTraceBackErrorHandler,0); 79 else { 80 f2 = handler; 81 *ierr = PetscPushErrorHandler(ourerrorhandler,ctx); 82 } 83 } 84 85 PETSC_EXTERN void petscerror_(MPI_Fint *comm,PetscErrorCode *number,PetscErrorType *p,char* message,PETSC_FORTRAN_CHARLEN_T len) 86 { 87 PetscErrorCode nierr,*ierr = &nierr; 88 char *t1; 89 FIXCHAR(message,len,t1); 90 nierr = PetscError(MPI_Comm_f2c(*(comm)),0,NULL,NULL,*number,*p,"%s",t1); 91 FREECHAR(message,t1); 92 } 93 94 #if defined(PETSC_HAVE_FORTRAN_FREE_LINE_LENGTH_NONE) 95 PETSC_EXTERN void petscerrorf_(PetscErrorCode *err,int *line,char *file,PETSC_FORTRAN_CHARLEN_T len) 96 { 97 char *tfile; 98 PetscErrorCode derr,*ierr = &derr; /* needed by FIXCHAR */ 99 100 FIXCHAR(file,len,tfile); 101 PetscError(PETSC_COMM_SELF,*line,NULL,tfile,*err,PETSC_ERROR_REPEAT,NULL); 102 FREECHAR(file,tfile); 103 } 104 105 PETSC_EXTERN void petscerrormpi_(PetscErrorCode *err,int *line,char *file,PETSC_FORTRAN_CHARLEN_T len) 106 { 107 char errorstring[2*MPI_MAX_ERROR_STRING]; 108 char *tfile; 109 PetscErrorCode derr,*ierr = &derr; /* needed by FIXCHAR */ 110 111 FIXCHAR(file,len,tfile); 112 PetscMPIErrorString(*err,errorstring); 113 PetscError(PETSC_COMM_SELF,*line,NULL,file,PETSC_ERR_MPI,PETSC_ERROR_INITIAL,"MPI error %d %s",*err,errorstring); 114 FREECHAR(file,tfile); 115 *err = PETSC_ERR_MPI; 116 } 117 #else 118 PETSC_EXTERN void petscerrorf_(PetscErrorCode *err) 119 { 120 PetscError(PETSC_COMM_SELF,0,NULL,NULL,*err,PETSC_ERROR_REPEAT,NULL); 121 } 122 123 PETSC_EXTERN void petscerrormpi_(PetscErrorCode *err) 124 { 125 char errorstring[2*MPI_MAX_ERROR_STRING]; 126 127 PetscMPIErrorString(*err,errorstring); 128 PetscError(PETSC_COMM_SELF,0,NULL,NULL,PETSC_ERR_MPI,PETSC_ERROR_INITIAL,"MPI error %d %s",*err,errorstring); 129 *err = PETSC_ERR_MPI; 130 } 131 #endif 132 133 PETSC_EXTERN void petscrealview_(PetscInt *n,PetscReal *d,PetscViewer *viwer,PetscErrorCode *ierr) 134 { 135 PetscViewer v; 136 PetscPatchDefaultViewers_Fortran(viwer,v); 137 *ierr = PetscRealView(*n,d,v); 138 } 139 140 PETSC_EXTERN void petscintview_(PetscInt *n,PetscInt *d,PetscViewer *viwer,PetscErrorCode *ierr) 141 { 142 PetscViewer v; 143 PetscPatchDefaultViewers_Fortran(viwer,v); 144 *ierr = PetscIntView(*n,d,v); 145 } 146 147 #if defined(PETSC_HAVE_FORTRAN_CAPS) 148 #define petscscalarview_ PETSCSCALARVIEW 149 #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE) 150 #define petscscalarview_ petscscalarview 151 #endif 152 153 PETSC_EXTERN void petscscalarview_(PetscInt *n,PetscScalar *d,PetscViewer *viwer,PetscErrorCode *ierr) 154 { 155 PetscViewer v; 156 PetscPatchDefaultViewers_Fortran(viwer,v); 157 *ierr = PetscScalarView(*n,d,v); 158 } 159