1 #include <petsc/private/ftnimpl.h>
2
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
16
17 #if defined(__cplusplus)
18 extern "C" {
19 #endif
20
petscsynchronizedflush_(MPI_Fint * comm,FILE ** file,int * ierr)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 }
27
PetscFixSlashN(const char * in,char * out[])28 static PetscErrorCode PetscFixSlashN(const char *in, char *out[])
29 {
30 size_t i, len;
31
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 }
43
petscfprintf_(MPI_Comm * comm,FILE ** file,char * fname,PetscErrorCode * ierr,PETSC_FORTRAN_CHARLEN_T len1)44 PETSC_EXTERN void petscfprintf_(MPI_Comm *comm, FILE **file, char *fname, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len1)
45 {
46 char *c1, *tmp;
47
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 }
56
petscprintf_(MPI_Comm * comm,char * fname,PetscErrorCode * ierr,PETSC_FORTRAN_CHARLEN_T len1)57 PETSC_EXTERN void petscprintf_(MPI_Comm *comm, char *fname, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len1)
58 {
59 char *c1, *tmp;
60
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 }
69
petscsynchronizedfprintf_(MPI_Comm * comm,FILE ** file,char * fname,PetscErrorCode * ierr,PETSC_FORTRAN_CHARLEN_T len1)70 PETSC_EXTERN void petscsynchronizedfprintf_(MPI_Comm *comm, FILE **file, char *fname, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len1)
71 {
72 char *c1, *tmp;
73
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 }
82
petscsynchronizedprintf_(MPI_Comm * comm,char * fname,PetscErrorCode * ierr,PETSC_FORTRAN_CHARLEN_T len1)83 PETSC_EXTERN void petscsynchronizedprintf_(MPI_Comm *comm, char *fname, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len1)
84 {
85 char *c1, *tmp;
86
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
98