Actual source code: zerrf.c
1: #include <petsc/private/fortranimpl.h>
2: #include <petscsys.h>
3: #include <petscviewer.h>
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: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
16: #define petscpusherrorhandler_ petscpusherrorhandler
17: #define petsctracebackerrorhandler_ petsctracebackerrorhandler
18: #define petscaborterrorhandler_ petscaborterrorhandler
19: #define petscignoreerrorhandler_ petscignoreerrorhandler
20: #define petscemacsclienterrorhandler_ petscemacsclienterrorhandler
21: #define petscattachdebuggererrorhandler_ petscattachdebuggererrorhandler
22: #define petscerror_ petscerror
23: #define petscerrorf_ petscerrorf
24: #define petscerrormpi_ petscerrormpi
25: #endif
27: 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);
29: /* These are not extern C because they are passed into non-extern C user level functions */
30: static PetscErrorCode ourerrorhandler(MPI_Comm comm, int line, const char *fun, const char *file, PetscErrorCode n, PetscErrorType p, const char *mess, void *ctx)
31: {
32: PetscErrorCode ierr = PETSC_SUCCESS;
33: size_t len1, len2, len3;
35: ierr = PetscStrlen(fun, &len1);
36: ierr = PetscStrlen(file, &len2);
37: ierr = PetscStrlen(mess, &len3);
39: ierr = PETSC_SUCCESS;
40: (*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);
41: return ierr;
42: }
44: /*
45: These are not usually called from Fortran but allow Fortran users
46: to transparently set these monitors from .F code
47: */
48: 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)
49: {
50: *ierr = PetscTraceBackErrorHandler(*comm, *line, fun, file, *n, *p, mess, ctx);
51: }
53: 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)
54: {
55: *ierr = PetscAbortErrorHandler(*comm, *line, fun, file, *n, *p, mess, ctx);
56: }
58: 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)
59: {
60: *ierr = PetscAttachDebuggerErrorHandler(*comm, *line, fun, file, *n, *p, mess, ctx);
61: }
63: 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)
64: {
65: *ierr = PetscEmacsClientErrorHandler(*comm, *line, fun, file, *n, *p, mess, ctx);
66: }
68: 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)
69: {
70: *ierr = PetscIgnoreErrorHandler(*comm, *line, fun, file, *n, *p, mess, ctx);
71: }
73: 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)
74: {
75: if ((void (*)(void))handler == (void (*)(void))petsctracebackerrorhandler_) *ierr = PetscPushErrorHandler(PetscTraceBackErrorHandler, NULL);
76: else {
77: f2 = handler;
78: *ierr = PetscPushErrorHandler(ourerrorhandler, ctx);
79: }
80: }
82: PETSC_EXTERN void petscerror_(MPI_Fint *comm, PetscErrorCode *number, PetscErrorType *p, char *message, PETSC_FORTRAN_CHARLEN_T len)
83: {
84: PetscErrorCode nierr, *ierr = &nierr;
85: char *t1;
86: FIXCHAR(message, len, t1);
87: nierr = PetscError(MPI_Comm_f2c(*(comm)), 0, NULL, NULL, *number, *p, "%s", t1);
88: FREECHAR(message, t1);
89: }
91: #if defined(PETSC_HAVE_FORTRAN_FREE_LINE_LENGTH_NONE)
92: PETSC_EXTERN void petscerrorf_(PetscErrorCode *err, int *line, char *file, PETSC_FORTRAN_CHARLEN_T len)
93: {
94: char *tfile;
95: PetscErrorCode ierr[] = {PETSC_SUCCESS}; /* needed by FIXCHAR */
97: FIXCHAR(file, len, tfile);
98: *err = PetscError(PETSC_COMM_SELF, *line, NULL, tfile, *err, PETSC_ERROR_REPEAT, NULL);
99: FREECHAR(file, tfile);
100: }
102: PETSC_EXTERN void petscerrormpi_(PetscErrorCode *err, int *line, char *file, PETSC_FORTRAN_CHARLEN_T len)
103: {
104: char errorstring[2 * MPI_MAX_ERROR_STRING];
105: char *tfile;
106: PetscErrorCode ierr[] = {PETSC_SUCCESS}; /* needed by FIXCHAR */
108: FIXCHAR(file, len, tfile);
109: PetscMPIErrorString(*err, 2 * MPI_MAX_ERROR_STRING, errorstring);
110: *err = PetscError(PETSC_COMM_SELF, *line, NULL, file, PETSC_ERR_MPI, PETSC_ERROR_INITIAL, "MPI error %d %s", *err, errorstring);
111: FREECHAR(file, tfile);
112: *err = PETSC_ERR_MPI;
113: }
114: #else
115: PETSC_EXTERN void petscerrorf_(PetscErrorCode *err)
116: {
117: *err = PetscError(PETSC_COMM_SELF, 0, NULL, NULL, *err, PETSC_ERROR_REPEAT, NULL);
118: }
120: PETSC_EXTERN void petscerrormpi_(PetscErrorCode *err)
121: {
122: char errorstring[2 * MPI_MAX_ERROR_STRING];
124: PetscMPIErrorString(*err, 2 * MPI_MAX_ERROR_STRING, errorstring);
125: *err = PetscError(PETSC_COMM_SELF, 0, NULL, NULL, PETSC_ERR_MPI, PETSC_ERROR_INITIAL, "MPI error %d %s", *err, errorstring);
126: *err = PETSC_ERR_MPI;
127: }
128: #endif