Actual source code: zmprintf.c
1: #include <petsc/private/fortranimpl.h>
3: #if defined(PETSC_HAVE_FORTRAN_CAPS)
4: #define petscfprintf_ PETSCFPRINTF
5: #define petscprintf_ PETSCPRINTF
6: #define petscsynchronizedfprintf_ PETSCSYNCHRONIZEDFPRINTF
7: #define petscsynchronizedprintf_ PETSCSYNCHRONIZEDPRINTF
8: #define petscsynchronizedflush_ PETSCSYNCHRONIZEDFLUSH
9: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
10: #define petscfprintf_ petscfprintf
11: #define petscprintf_ petscprintf
12: #define petscsynchronizedfprintf_ petscsynchronizedfprintf
13: #define petscsynchronizedprintf_ petscsynchronizedprintf
14: #define petscsynchronizedflush_ petscsynchronizedflush
15: #endif
17: #if defined(__cplusplus)
18: extern "C" {
19: #endif
21: PETSC_EXTERN void petscsynchronizedflush_(MPI_Fint *comm, FILE **file, int *ierr)
22: {
23: FILE *f = *file;
24: if (!f) f = PETSC_STDOUT; /* support for PETSC_STDOUT in Fortran */
25: *ierr = PetscSynchronizedFlush(MPI_Comm_f2c(*(comm)), f);
26: }
28: static PetscErrorCode PetscFixSlashN(const char *in, char *out[])
29: {
30: size_t i, len;
32: PetscFunctionBegin;
33: PetscCall(PetscStrallocpy(in, out));
34: PetscCall(PetscStrlen(*out, &len));
35: for (i = 0; i < len - 1; i++) {
36: if ((*out)[i] == '\\' && (*out)[i + 1] == 'n') {
37: (*out)[i] = ' ';
38: (*out)[i + 1] = '\n';
39: }
40: }
41: PetscFunctionReturn(PETSC_SUCCESS);
42: }
44: PETSC_EXTERN void petscfprintf_(MPI_Comm *comm, FILE **file, char *fname, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len1)
45: {
46: char *c1, *tmp;
48: FIXCHAR(fname, len1, c1);
49: *ierr = PetscFixSlashN(c1, &tmp);
50: if (*ierr) return;
51: FREECHAR(fname, c1);
52: *ierr = PetscFPrintf(MPI_Comm_f2c(*(MPI_Fint *)&*comm), *file, "%s", tmp);
53: if (*ierr) return;
54: *ierr = PetscFree(tmp);
55: }
57: PETSC_EXTERN void petscprintf_(MPI_Comm *comm, char *fname, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len1)
58: {
59: char *c1, *tmp;
61: FIXCHAR(fname, len1, c1);
62: *ierr = PetscFixSlashN(c1, &tmp);
63: if (*ierr) return;
64: FREECHAR(fname, c1);
65: *ierr = PetscPrintf(MPI_Comm_f2c(*(MPI_Fint *)&*comm), "%s", tmp);
66: if (*ierr) return;
67: *ierr = PetscFree(tmp);
68: }
70: PETSC_EXTERN void petscsynchronizedfprintf_(MPI_Comm *comm, FILE **file, char *fname, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len1)
71: {
72: char *c1, *tmp;
74: FIXCHAR(fname, len1, c1);
75: *ierr = PetscFixSlashN(c1, &tmp);
76: if (*ierr) return;
77: FREECHAR(fname, c1);
78: *ierr = PetscSynchronizedFPrintf(MPI_Comm_f2c(*(MPI_Fint *)&*comm), *file, "%s", tmp);
79: if (*ierr) return;
80: *ierr = PetscFree(tmp);
81: }
83: PETSC_EXTERN void petscsynchronizedprintf_(MPI_Comm *comm, char *fname, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len1)
84: {
85: char *c1, *tmp;
87: FIXCHAR(fname, len1, c1);
88: *ierr = PetscFixSlashN(c1, &tmp);
89: if (*ierr) return;
90: FREECHAR(fname, c1);
91: *ierr = PetscSynchronizedPrintf(MPI_Comm_f2c(*(MPI_Fint *)&*comm), "%s", tmp);
92: if (*ierr) return;
93: *ierr = PetscFree(tmp);
94: }
95: #if defined(__cplusplus)
96: }
97: #endif