xref: /petsc/src/sys/classes/viewer/impls/ascii/ftn-custom/zfilevf.c (revision bebe2cf65d55febe21a5af8db2bd2e168caaa2e7)
1 #include <petsc/private/fortranimpl.h>
2 #include <petscviewer.h>
3 
4 #if defined(PETSC_HAVE_FORTRAN_CAPS)
5 #define petscviewerfilesetname_                PETSCVIEWERFILESETNAME
6 #define petscviewerasciiprintf_                PETSCVIEWERASCIIPRINTF
7 #define petscviewerasciisynchronizedprintf_    PETSCVIEWERASCIISYNCHRONIZEDPRINTF
8 #define petscviewerasciisynchronizedallow_     PETSCVIEWERASCIISYNCHRONIZEALLOW
9 #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
10 #define petscviewerfilesetname_                petscviewerfilesetname
11 #define petscviewerasciiprintf_                petscviewerasciiprintf
12 #define petscviewerasciisynchronizedprintf_    petscviewerasciisynchronizedprintf
13 #define petscviewerasciisynchronizedallow_     petscviewerasciisynchronizedallow
14 #endif
15 
16 PETSC_EXTERN void PETSC_STDCALL petscviewerfilesetname_(PetscViewer *viewer,CHAR name PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len))
17 {
18   char        *c1;
19   PetscViewer v;
20   PetscPatchDefaultViewers_Fortran(viewer,v);
21   FIXCHAR(name,len,c1);
22   *ierr = PetscViewerFileSetName(v,c1);
23   FREECHAR(name,c1);
24 }
25 
26 #undef __FUNCT__
27 #define __FUNCT__ "PetscFixSlashN"
28 static PetscErrorCode PetscFixSlashN(const char *in, char **out)
29 {
30   PetscErrorCode ierr;
31   PetscInt       i;
32   size_t         len;
33 
34   PetscFunctionBegin;
35   ierr = PetscStrallocpy(in,out);CHKERRQ(ierr);
36   ierr = PetscStrlen(*out,&len);CHKERRQ(ierr);
37   for (i=0; i<(int)len-1; i++) {
38     if ((*out)[i] == '\\' && (*out)[i+1] == 'n') {(*out)[i] = ' '; (*out)[i+1] = '\n';}
39   }
40   PetscFunctionReturn(0);
41 }
42 
43 PETSC_EXTERN void PETSC_STDCALL petscviewerasciiprintf_(PetscViewer *viewer,CHAR str PETSC_MIXED_LEN(len1),PetscErrorCode *ierr PETSC_END_LEN(len1))
44 {
45   char        *c1, *tmp;
46   PetscViewer v;
47 
48   PetscPatchDefaultViewers_Fortran(viewer,v);
49   FIXCHAR(str,len1,c1);
50   *ierr = PetscFixSlashN(c1,&tmp);if (*ierr) return;
51   FREECHAR(str,c1);
52   *ierr = PetscViewerASCIIPrintf(v,tmp);if (*ierr) return;
53   *ierr = PetscFree(tmp);
54 }
55 
56 PETSC_EXTERN void PETSC_STDCALL petscviewerasciisynchronizedprintf_(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 = PetscViewerASCIISynchronizedPrintf(v,tmp);if (*ierr) return;
66   *ierr = PetscFree(tmp);
67 }
68 
69 PETSC_EXTERN void PETSC_STDCALL petscviewerasciisynchronizedallow_(PetscViewer *viewer,PetscBool *allow,PetscErrorCode *ierr)
70 {
71   PetscViewer v;
72 
73   PetscPatchDefaultViewers_Fortran(viewer,v);
74   *ierr = PetscViewerASCIISynchronizedAllow(v,*allow);
75 }
76