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: }