xref: /petsc/src/sys/info/ftn-custom/zverboseinfof.c (revision b0dcfd164860a975c76f90dabf1036901aab1c4e)
1 #include <petsc/private/ftnimpl.h>
2 
3 #if defined(PETSC_HAVE_FORTRAN_CAPS)
4   #define petscinfo_ PETSCINFO
5 #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
6   #define petscinfo_ petscinfo
7 #endif
8 
PetscFixSlashN(const char * in,char ** out)9 static PetscErrorCode PetscFixSlashN(const char *in, char **out)
10 {
11   PetscInt i;
12   size_t   len;
13 
14   PetscFunctionBegin;
15   PetscCall(PetscStrallocpy(in, out));
16   PetscCall(PetscStrlen(*out, &len));
17   for (i = 0; i < (int)len - 1; i++) {
18     if ((*out)[i] == '\\' && (*out)[i + 1] == 'n') {
19       (*out)[i]     = ' ';
20       (*out)[i + 1] = '\n';
21     }
22   }
23   PetscFunctionReturn(PETSC_SUCCESS);
24 }
25 
petscinfo_(char * text,PetscErrorCode * ierr,PETSC_FORTRAN_CHARLEN_T len1)26 PETSC_EXTERN void petscinfo_(char *text, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len1)
27 {
28   char *c1, *tmp;
29 
30   FIXCHAR(text, len1, c1);
31   *ierr = PetscFixSlashN(c1, &tmp);
32   if (*ierr) return;
33   FREECHAR(text, c1);
34   *ierr = PetscInfo(NULL, "%s", tmp);
35   if (*ierr) return;
36   *ierr = PetscFree(tmp);
37 }
38