1 #include <petsc/private/fortranimpl.h> 2 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 8 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 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; 29 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 } 37 38 PETSC_EXTERN void petscinfogetclass_(char *classname, PetscBool **found, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len) 39 { 40 char *t; 41 42 FIXCHAR(classname, len, t); 43 *ierr = PetscInfoGetClass(t, *found); 44 if (*ierr) return; 45 FREECHAR(classname, t); 46 } 47 48 PETSC_EXTERN void petscinfoprocessclass_(char *classname, PetscInt *numClassID, PetscClassId *classIDs[], PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len) 49 { 50 char *t; 51 52 FIXCHAR(classname, len, t); 53 *ierr = PetscInfoProcessClass(t, *numClassID, *classIDs); 54 if (*ierr) return; 55 FREECHAR(classname, t); 56 } 57 58 PETSC_EXTERN void petscinfo_(char *text, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len1) 59 { 60 char *c1, *tmp; 61 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 } 70