Actual source code: zverboseinfof.c
1: #include <petsc/private/fortranimpl.h>
3: #if defined(PETSC_HAVE_FORTRAN_CAPS)
4: #define petscinfo_ PETSCINFO
5: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE) && !defined(FORTRANDOUBLEUNDERSCORE)
6: #define petscinfo_ petscinfo
7: #endif
9: static PetscErrorCode PetscFixSlashN(const char *in, char **out)
10: {
11: PetscInt i;
12: size_t len;
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: }
26: PETSC_EXTERN void petscinfosetfile_(char *filename, char *mode, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len1, PETSC_FORTRAN_CHARLEN_T len2)
27: {
28: char *t1, *t2;
30: FIXCHAR(filename, len1, t1);
31: FIXCHAR(mode, len2, t2);
32: *ierr = PetscInfoSetFile(t1, t2);
33: if (*ierr) return;
34: FREECHAR(filename, t1);
35: FREECHAR(mode, t2);
36: }
38: PETSC_EXTERN void petscinfogetclass_(char *classname, PetscBool **found, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len)
39: {
40: char *t;
42: FIXCHAR(classname, len, t);
43: *ierr = PetscInfoGetClass(t, *found);
44: if (*ierr) return;
45: FREECHAR(classname, t);
46: }
48: PETSC_EXTERN void petscinfoprocessclass_(char *classname, PetscInt *numClassID, PetscClassId *classIDs[], PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len)
49: {
50: char *t;
52: FIXCHAR(classname, len, t);
53: *ierr = PetscInfoProcessClass(t, *numClassID, *classIDs);
54: if (*ierr) return;
55: FREECHAR(classname, t);
56: }
58: PETSC_EXTERN void petscinfo_(char *text, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len1)
59: {
60: char *c1, *tmp;
62: FIXCHAR(text, len1, c1);
63: *ierr = PetscFixSlashN(c1, &tmp);
64: if (*ierr) return;
65: FREECHAR(text, c1);
66: *ierr = PetscInfo(NULL, "%s", tmp);
67: if (*ierr) return;
68: *ierr = PetscFree(tmp);
69: }