1 #include "zpetsc.h" 2 #include "petsc.h" 3 4 #if defined(PETSC_HAVE_FORTRAN_CAPS) 5 #define petscpusherrorhandler_ PETSCPUSHERRORHANDLER 6 #define petsctracebackerrorhandler_ PETSCTRACEBACKERRORHANDLER 7 #define petscaborterrorhandler_ PETSCABORTERRORHANDLER 8 #define petscignoreerrorhandler_ PETSCIGNOREERRORHANDLER 9 #define petscemacsclienterrorhandler_ PETSCEMACSCLIENTERRORHANDLER 10 #define petscattachdebuggererrorhandler_ PETSCATTACHDEBUGGERERRORHANDLER 11 #define petscerror_ PETSCERROR 12 #define petscrealview_ PETSCREALVIEW 13 #define petscintview_ PETSCINTVIEW 14 #define petscerroriscatchable_ PETSCERRORISCATCHABLE 15 #define petscexceptionvalue_ PETSCEXCEPTIONVALUE 16 #define petscexceptioncaught PETSCEXCEPTIONCAUGHT 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 petscrealview_ petscrealview 26 #define petscintview_ petscintview 27 #define petscerroriscatchable_ petscerroriscatchable 28 #define petscexceptionvalue_ petscexceptionvalue 29 #define petscexceptioncaught_ petscexceptioncaught 30 #endif 31 32 EXTERN_C_BEGIN 33 static void (PETSC_STDCALL *f2)(int*,const CHAR PETSC_MIXED_LEN(len1),const CHAR PETSC_MIXED_LEN(len2),const CHAR PETSC_MIXED_LEN(len3),int*,int*,const CHAR PETSC_MIXED_LEN(len4),void*,PetscErrorCode* PETSC_END_LEN(len1) PETSC_END_LEN(len2) PETSC_END_LEN(len3) PETSC_END_LEN(len4)); 34 EXTERN_C_END 35 36 /* These are not extern C because they are passed into non-extern C user level functions */ 37 static PetscErrorCode ourerrorhandler(int line,const char *fun,const char *file,const char *dir,int n,int p,const char *mess,void *ctx) 38 { 39 PetscErrorCode ierr = 0; 40 size_t len1,len2,len3,len4; 41 int l1,l2,l3,l4; 42 43 PetscStrlen(fun,&len1); l1 = (int)len1; 44 PetscStrlen(file,&len2);l2 = (int)len2; 45 PetscStrlen(dir,&len3);l3 = (int)len3; 46 PetscStrlen(mess,&len4);l4 = (int)len4; 47 48 #if defined(PETSC_USES_CPTOFCD) 49 { 50 CHAR fun_c,file_c,dir_c,mess_c; 51 52 fun_c = _cptofcd(fun,len1); 53 file_c = _cptofcd(file,len2); 54 dir_c = _cptofcd(dir,len3); 55 mess_c = _cptofcd(mess,len4); 56 (*f2)(&line,fun_c,file_c,dir_c,&n,&p,mess_c,ctx,&ierr,len1,len2,len3,len4); 57 58 } 59 #elif defined(PETSC_HAVE_FORTRAN_MIXED_STR_ARG) 60 (*f2)(&line,fun,l1,file,l2,dir,l3,&n,&p,mess,l4,ctx,&ierr); 61 #else 62 (*f2)(&line,fun,file,dir,&n,&p,mess,ctx,&ierr,l1,l2,l3,l4); 63 #endif 64 return ierr; 65 } 66 67 EXTERN_C_BEGIN 68 69 /* 70 These are not usually called from Fortran but allow Fortran users 71 to transparently set these monitors from .F code 72 73 functions, hence no STDCALL 74 */ 75 void petsctracebackerrorhandler_(int *line,const char *fun,const char *file,const char *dir,int *n,int *p,const char *mess,void *ctx,PetscErrorCode *ierr) 76 { 77 *ierr = PetscTraceBackErrorHandler(*line,fun,file,dir,*n,*p,mess,ctx); 78 } 79 80 void petscaborterrorhandler_(int *line,const char *fun,const char *file,const char *dir,int *n,int *p,const char *mess,void *ctx,PetscErrorCode *ierr) 81 { 82 *ierr = PetscAbortErrorHandler(*line,fun,file,dir,*n,*p,mess,ctx); 83 } 84 85 void petscattachdebuggererrorhandler_(int *line,const char *fun,const char *file,const char *dir,int *n,int *p,const char *mess,void *ctx,PetscErrorCode *ierr) 86 { 87 *ierr = PetscAttachDebuggerErrorHandler(*line,fun,file,dir,*n,*p,mess,ctx); 88 } 89 90 void petscemacsclienterrorhandler_(int *line,const char *fun,const char *file,const char *dir,int *n,int *p,const char *mess,void *ctx,PetscErrorCode *ierr) 91 { 92 *ierr = PetscEmacsClientErrorHandler(*line,fun,file,dir,*n,*p,mess,ctx); 93 } 94 95 void petscignoreerrorhandler_(int *line,const char *fun,const char *file,const char *dir,int *n,int *p,const char *mess,void *ctx,PetscErrorCode *ierr) 96 { 97 *ierr = PetscIgnoreErrorHandler(*line,fun,file,dir,*n,*p,mess,ctx); 98 } 99 100 void PETSC_STDCALL petscpusherrorhandler_(void (PETSC_STDCALL *handler)(int*,const CHAR PETSC_MIXED_LEN(len1),const CHAR PETSC_MIXED_LEN(len2),const CHAR PETSC_MIXED_LEN(len3),int*,int*,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) 101 { 102 if ((void(*)(void))handler == (void(*)(void))petsctracebackerrorhandler_) { 103 *ierr = PetscPushErrorHandler(PetscTraceBackErrorHandler,0); 104 } else { 105 f2 = handler; 106 *ierr = PetscPushErrorHandler(ourerrorhandler,ctx); 107 } 108 } 109 110 void PETSC_STDCALL petscerror_(int *number,int *line,int *p,CHAR message PETSC_MIXED_LEN(len), 111 PetscErrorCode *ierr PETSC_END_LEN(len)) 112 { 113 char *t1; 114 FIXCHAR(message,len,t1); 115 *ierr = PetscError(*line,0,0,0,*number,*p,t1); 116 FREECHAR(message,t1); 117 } 118 119 void PETSC_STDCALL petscrealview_(PetscInt *n,PetscReal *d,PetscViewer *viwer,PetscErrorCode *ierr) 120 { 121 PetscViewer v; 122 PetscPatchDefaultViewers_Fortran(viwer,v); 123 *ierr = PetscRealView(*n,d,v); 124 } 125 126 void PETSC_STDCALL petscintview_(PetscInt *n,PetscInt *d,PetscViewer *viwer,PetscErrorCode *ierr) 127 { 128 PetscViewer v; 129 PetscPatchDefaultViewers_Fortran(viwer,v); 130 *ierr = PetscIntView(*n,d,v); 131 } 132 133 void PETSC_STDCALL petscerroriscatchable_(PetscErrorCode *ierr,PetscTruth *is) 134 { 135 *is = PetscErrorIsCatchable(*ierr); 136 } 137 138 void PETSC_STDCALL petscexceptionvalue_(PetscErrorCode *ierr,PetscTruth *is) 139 { 140 *is = PetscExceptionValue(*ierr); 141 } 142 143 void PETSC_STDCALL petscexceptioncaught_(PetscErrorCode *ierr,PetscErrorCode *zierr,PetscTruth *is) 144 { 145 *is = PetscExceptionCaught(*ierr,*zierr); 146 } 147 148 #if defined(PETSC_HAVE_FORTRAN_CAPS) 149 #define petscscalarview_ PETSCSCALARVIEW 150 #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE) 151 #define petscscalarview_ petscscalarview 152 #endif 153 154 void PETSC_STDCALL petscscalarview_(PetscInt *n,PetscScalar *d,PetscViewer *viwer,PetscErrorCode *ierr) 155 { 156 PetscViewer v; 157 PetscPatchDefaultViewers_Fortran(viwer,v); 158 *ierr = PetscScalarView(*n,d,v); 159 } 160 161 EXTERN_C_END 162