xref: /petsc/src/sys/classes/viewer/impls/ascii/ftn-custom/zfilevf.c (revision 419beca1004e80ebaf01ed86ca4fa04d30fb35e8)
1 #include <petsc/private/fortranimpl.h>
2 #include <petscviewer.h>
3 
4 #if defined(PETSC_HAVE_FORTRAN_CAPS)
5 #define petscviewerfilesetname_                PETSCVIEWERFILESETNAME
6 #define petscviewerfilegetname_                PETSCVIEWERFILEGETNAME
7 #define petscviewerasciiprintf_                PETSCVIEWERASCIIPRINTF
8 #define petscviewerasciisynchronizedprintf_    PETSCVIEWERASCIISYNCHRONIZEDPRINTF
9 #define petscviewerasciipushsynchronized_      PETSCVIEWERASCIIPUSHSYNCHRONIZED
10 #define petscviewerasciipopsynchronized_       PETSCVIEWERASCIIPOPSYNCHRONIZED
11 #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
12 #define petscviewerfilesetname_                petscviewerfilesetname
13 #define petscviewerfilegetname_                petscviewerfilegetname
14 #define petscviewerasciiprintf_                petscviewerasciiprintf
15 #define petscviewerasciisynchronizedprintf_    petscviewerasciisynchronizedprintf
16 #define petscviewerasciipushsynchronized_      petscviewerasciipushsynchronized
17 #define petscviewerasciipopsynchronized_       petscviewerasciipopsynchronized
18 #endif
19 
20 PETSC_EXTERN void PETSC_STDCALL petscviewerfilesetname_(PetscViewer *viewer,CHAR name PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len))
21 {
22   char        *c1;
23   PetscViewer v;
24   PetscPatchDefaultViewers_Fortran(viewer,v);
25   FIXCHAR(name,len,c1);
26   *ierr = PetscViewerFileSetName(v,c1);
27   FREECHAR(name,c1);
28 }
29 
30 PETSC_EXTERN void PETSC_STDCALL petscviewerfilegetname_(PetscViewer *viewer, CHAR name PETSC_MIXED_LEN(len), PetscErrorCode *ierr PETSC_END_LEN(len))
31 {
32    const char *c1;
33 
34    *ierr = PetscViewerGetType(*viewer, &c1);
35    *ierr = PetscStrncpy(name, c1, len);
36    FIXRETURNCHAR(PETSC_TRUE, name, len);
37 }
38 
39 #undef __FUNCT__
40 #define __FUNCT__ "PetscFixSlashN"
41 static PetscErrorCode PetscFixSlashN(const char *in, char **out)
42 {
43   PetscErrorCode ierr;
44   PetscInt       i;
45   size_t         len;
46 
47   PetscFunctionBegin;
48   ierr = PetscStrallocpy(in,out);CHKERRQ(ierr);
49   ierr = PetscStrlen(*out,&len);CHKERRQ(ierr);
50   for (i=0; i<(int)len-1; i++) {
51     if ((*out)[i] == '\\' && (*out)[i+1] == 'n') {(*out)[i] = ' '; (*out)[i+1] = '\n';}
52   }
53   PetscFunctionReturn(0);
54 }
55 
56 PETSC_EXTERN void PETSC_STDCALL petscviewerasciiprintf_(PetscViewer *viewer,CHAR str PETSC_MIXED_LEN(len1),PetscErrorCode *ierr PETSC_END_LEN(len1))
57 {
58   char        *c1, *tmp;
59   PetscViewer v;
60 
61   PetscPatchDefaultViewers_Fortran(viewer,v);
62   FIXCHAR(str,len1,c1);
63   *ierr = PetscFixSlashN(c1,&tmp);if (*ierr) return;
64   FREECHAR(str,c1);
65   *ierr = PetscViewerASCIIPrintf(v,tmp);if (*ierr) return;
66   *ierr = PetscFree(tmp);
67 }
68 
69 PETSC_EXTERN void PETSC_STDCALL petscviewerasciisynchronizedprintf_(PetscViewer *viewer,CHAR str PETSC_MIXED_LEN(len1),PetscErrorCode *ierr PETSC_END_LEN(len1))
70 {
71   char        *c1, *tmp;
72   PetscViewer v;
73 
74   PetscPatchDefaultViewers_Fortran(viewer,v);
75   FIXCHAR(str,len1,c1);
76   *ierr = PetscFixSlashN(c1,&tmp);if (*ierr) return;
77   FREECHAR(str,c1);
78   *ierr = PetscViewerASCIISynchronizedPrintf(v,tmp);if (*ierr) return;
79   *ierr = PetscFree(tmp);
80 }
81 
82 PETSC_EXTERN void PETSC_STDCALL petscviewerasciipushsynchronized_(PetscViewer *viewer,PetscErrorCode *ierr)
83 {
84   PetscViewer v;
85 
86   PetscPatchDefaultViewers_Fortran(viewer,v);
87   *ierr = PetscViewerASCIIPushSynchronized(v);
88 }
89 
90 PETSC_EXTERN void PETSC_STDCALL petscviewerasciipopsynchronized_(PetscViewer *viewer,PetscErrorCode *ierr)
91 {
92   PetscViewer v;
93 
94   PetscPatchDefaultViewers_Fortran(viewer,v);
95   *ierr = PetscViewerASCIIPopSynchronized(v);
96 }
97