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