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