Actual source code: zfilevf.c
1: #include <petsc/private/ftnimpl.h>
2: #include <petscviewer.h>
4: #if PetscDefined(HAVE_FORTRAN_CAPS)
5: #define petscviewerasciiprintf_ PETSCVIEWERASCIIPRINTF
6: #define petscviewerasciisynchronizedprintf_ PETSCVIEWERASCIISYNCHRONIZEDPRINTF
7: #elif !PetscDefined(HAVE_FORTRAN_UNDERSCORE)
8: #define petscviewerasciiprintf_ petscviewerasciiprintf
9: #define petscviewerasciisynchronizedprintf_ petscviewerasciisynchronizedprintf
10: #endif
12: static PetscErrorCode PetscFixSlashN(const char *in, char **out)
13: {
14: size_t len;
16: PetscFunctionBegin;
17: PetscCall(PetscStrallocpy(in, out));
18: PetscCall(PetscStrlen(*out, &len));
19: for (PetscInt i = 0; i < (int)len - 1; i++) {
20: if ((*out)[i] == '\\' && (*out)[i + 1] == 'n') {
21: (*out)[i] = ' ';
22: (*out)[i + 1] = '\n';
23: }
24: }
25: PetscFunctionReturn(PETSC_SUCCESS);
26: }
28: PETSC_EXTERN void petscviewerasciiprintf_(PetscViewer *viewer, char *str, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len1)
29: {
30: char *c1, *tmp;
31: PetscViewer v;
33: PetscPatchDefaultViewers_Fortran(viewer, v);
34: FIXCHAR(str, len1, c1);
35: *ierr = PetscFixSlashN(c1, &tmp);
36: if (*ierr) return;
37: FREECHAR(str, c1);
38: *ierr = PetscViewerASCIIPrintf(v, "%s", tmp);
39: if (*ierr) return;
40: *ierr = PetscFree(tmp);
41: }
43: PETSC_EXTERN void petscviewerasciisynchronizedprintf_(PetscViewer *viewer, char *str, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len1)
44: {
45: char *c1, *tmp;
46: PetscViewer v;
48: PetscPatchDefaultViewers_Fortran(viewer, v);
49: FIXCHAR(str, len1, c1);
50: *ierr = PetscFixSlashN(c1, &tmp);
51: if (*ierr) return;
52: FREECHAR(str, c1);
53: *ierr = PetscViewerASCIISynchronizedPrintf(v, "%s", tmp);
54: if (*ierr) return;
55: *ierr = PetscFree(tmp);
56: }