Actual source code: zfilevf.c
1: #include <petsc/private/fortranimpl.h>
2: #include <petscviewer.h>
4: #if defined(PETSC_HAVE_FORTRAN_CAPS)
5: #define petscviewerfilesetname_ PETSCVIEWERFILESETNAME
6: #define petscviewerfilegetname_ PETSCVIEWERFILEGETNAME
7: #define petscviewerasciiprintf_ PETSCVIEWERASCIIPRINTF
8: #define petscviewerasciipushtab_ PETSCVIEWERASCIIPUSHTAB
9: #define petscviewerasciipoptab_ PETSCVIEWERASCIIPOPTAB
10: #define petscviewerasciisynchronizedprintf_ PETSCVIEWERASCIISYNCHRONIZEDPRINTF
11: #define petscviewerasciipushsynchronized_ PETSCVIEWERASCIIPUSHSYNCHRONIZED
12: #define petscviewerasciipopsynchronized_ PETSCVIEWERASCIIPOPSYNCHRONIZED
13: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
14: #define petscviewerfilesetname_ petscviewerfilesetname
15: #define petscviewerfilegetname_ petscviewerfilegetname
16: #define petscviewerasciiprintf_ petscviewerasciiprintf
17: #define petscviewerasciipushtab_ petscviewerasciipushtab
18: #define petscviewerasciipoptab_ petscviewerasciipoptab
19: #define petscviewerasciisynchronizedprintf_ petscviewerasciisynchronizedprintf
20: #define petscviewerasciipushsynchronized_ petscviewerasciipushsynchronized
21: #define petscviewerasciipopsynchronized_ petscviewerasciipopsynchronized
22: #endif
24: PETSC_EXTERN void petscviewerfilesetname_(PetscViewer *viewer, char *name, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len)
25: {
26: char *c1;
27: PetscViewer v;
28: PetscPatchDefaultViewers_Fortran(viewer, v);
29: FIXCHAR(name, len, c1);
30: *ierr = PetscViewerFileSetName(v, c1);
31: if (*ierr) return;
32: FREECHAR(name, c1);
33: }
35: PETSC_EXTERN void petscviewerfilegetname_(PetscViewer *viewer, char *name, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len)
36: {
37: const char *c1;
39: *ierr = PetscViewerGetType(*viewer, &c1);
40: if (*ierr) return;
41: *ierr = PetscStrncpy(name, c1, len);
42: if (*ierr) return;
43: FIXRETURNCHAR(PETSC_TRUE, name, len);
44: }
46: static PetscErrorCode PetscFixSlashN(const char *in, char **out)
47: {
48: PetscInt i;
49: size_t len;
51: PetscFunctionBegin;
52: PetscCall(PetscStrallocpy(in, out));
53: PetscCall(PetscStrlen(*out, &len));
54: for (i = 0; i < (int)len - 1; i++) {
55: if ((*out)[i] == '\\' && (*out)[i + 1] == 'n') {
56: (*out)[i] = ' ';
57: (*out)[i + 1] = '\n';
58: }
59: }
60: PetscFunctionReturn(PETSC_SUCCESS);
61: }
63: PETSC_EXTERN void petscviewerasciiprintf_(PetscViewer *viewer, char *str, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len1)
64: {
65: char *c1, *tmp;
66: PetscViewer v;
68: PetscPatchDefaultViewers_Fortran(viewer, v);
69: FIXCHAR(str, len1, c1);
70: *ierr = PetscFixSlashN(c1, &tmp);
71: if (*ierr) return;
72: FREECHAR(str, c1);
73: *ierr = PetscViewerASCIIPrintf(v, "%s", tmp);
74: if (*ierr) return;
75: *ierr = PetscFree(tmp);
76: }
78: PETSC_EXTERN void petscviewerasciipushtab_(PetscViewer *viewer, PetscErrorCode *ierr)
79: {
80: PetscViewer v;
81: PetscPatchDefaultViewers_Fortran(viewer, v);
82: *ierr = PetscViewerASCIIPushTab(v);
83: }
85: PETSC_EXTERN void petscviewerasciipoptab_(PetscViewer *viewer, PetscErrorCode *ierr)
86: {
87: PetscViewer v;
88: PetscPatchDefaultViewers_Fortran(viewer, v);
89: *ierr = PetscViewerASCIIPopTab(v);
90: }
92: PETSC_EXTERN void petscviewerasciisynchronizedprintf_(PetscViewer *viewer, char *str, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len1)
93: {
94: char *c1, *tmp;
95: PetscViewer v;
97: PetscPatchDefaultViewers_Fortran(viewer, v);
98: FIXCHAR(str, len1, c1);
99: *ierr = PetscFixSlashN(c1, &tmp);
100: if (*ierr) return;
101: FREECHAR(str, c1);
102: *ierr = PetscViewerASCIISynchronizedPrintf(v, "%s", tmp);
103: if (*ierr) return;
104: *ierr = PetscFree(tmp);
105: }
107: PETSC_EXTERN void petscviewerasciipushsynchronized_(PetscViewer *viewer, PetscErrorCode *ierr)
108: {
109: PetscViewer v;
111: PetscPatchDefaultViewers_Fortran(viewer, v);
112: *ierr = PetscViewerASCIIPushSynchronized(v);
113: }
115: PETSC_EXTERN void petscviewerasciipopsynchronized_(PetscViewer *viewer, PetscErrorCode *ierr)
116: {
117: PetscViewer v;
119: PetscPatchDefaultViewers_Fortran(viewer, v);
120: *ierr = PetscViewerASCIIPopSynchronized(v);
121: }