xref: /petsc/src/sys/info/ftn-custom/zverboseinfof.c (revision e94e781be4d0de67afa8d29cbcd676556dbc0369)
1af0996ceSBarry Smith #include <petsc/private/fortranimpl.h>
25c6c1daeSBarry Smith 
35c6c1daeSBarry Smith 
4519f805aSKarl Rupp #if defined(PETSC_HAVE_FORTRAN_CAPS)
55c6c1daeSBarry Smith #define petscinfo_ PETSCINFO
65c6c1daeSBarry Smith #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE) && !defined(FORTRANDOUBLEUNDERSCORE)
75c6c1daeSBarry Smith #define petscinfo_ petscinfo
85c6c1daeSBarry Smith #endif
95c6c1daeSBarry Smith 
105c6c1daeSBarry Smith static PetscErrorCode PetscFixSlashN(const char *in, char **out)
115c6c1daeSBarry Smith {
125c6c1daeSBarry Smith   PetscErrorCode ierr;
135c6c1daeSBarry Smith   PetscInt       i;
145c6c1daeSBarry Smith   size_t         len;
155c6c1daeSBarry Smith 
165c6c1daeSBarry Smith   PetscFunctionBegin;
175c6c1daeSBarry Smith   ierr = PetscStrallocpy(in,out);CHKERRQ(ierr);
185c6c1daeSBarry Smith   ierr = PetscStrlen(*out,&len);CHKERRQ(ierr);
195c6c1daeSBarry Smith   for (i=0; i<(int)len-1; i++) {
205c6c1daeSBarry Smith     if ((*out)[i] == '\\' && (*out)[i+1] == 'n') {(*out)[i] = ' '; (*out)[i+1] = '\n';}
215c6c1daeSBarry Smith   }
225c6c1daeSBarry Smith   PetscFunctionReturn(0);
235c6c1daeSBarry Smith }
245c6c1daeSBarry Smith 
25*e94e781bSJacob Faibussowitsch PETSC_EXTERN void petscinfosetfile_(char* filename, char* mode,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len1,PETSC_FORTRAN_CHARLEN_T len2)
26*e94e781bSJacob Faibussowitsch {
27*e94e781bSJacob Faibussowitsch   char *t1, *t2;
28*e94e781bSJacob Faibussowitsch 
29*e94e781bSJacob Faibussowitsch   FIXCHAR(filename,len1,t1);
30*e94e781bSJacob Faibussowitsch   FIXCHAR(mode,len2,t2);
31*e94e781bSJacob Faibussowitsch   *ierr = PetscInfoSetFile(t1,t2); if (*ierr) return;
32*e94e781bSJacob Faibussowitsch   FREECHAR(filename,t1);
33*e94e781bSJacob Faibussowitsch   FREECHAR(mode,t2);
34*e94e781bSJacob Faibussowitsch }
35*e94e781bSJacob Faibussowitsch 
36*e94e781bSJacob Faibussowitsch PETSC_EXTERN void petscinfogetclass_(char *classname,PetscBool **found,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len)
37*e94e781bSJacob Faibussowitsch {
38*e94e781bSJacob Faibussowitsch   char *t;
39*e94e781bSJacob Faibussowitsch 
40*e94e781bSJacob Faibussowitsch   FIXCHAR(classname,len,t);
41*e94e781bSJacob Faibussowitsch   *ierr = PetscInfoGetClass(t,*found);if (*ierr) return;
42*e94e781bSJacob Faibussowitsch   FREECHAR(classname,t);
43*e94e781bSJacob Faibussowitsch }
44*e94e781bSJacob Faibussowitsch 
45*e94e781bSJacob Faibussowitsch PETSC_EXTERN void petscinfoprocessclass_(char *classname,PetscInt *numClassID,PetscClassId *classIDs[],PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len)
46*e94e781bSJacob Faibussowitsch {
47*e94e781bSJacob Faibussowitsch   char *t;
48*e94e781bSJacob Faibussowitsch 
49*e94e781bSJacob Faibussowitsch   FIXCHAR(classname,len,t);
50*e94e781bSJacob Faibussowitsch   *ierr = PetscInfoProcessClass(t,*numClassID,*classIDs); if (*ierr) return;
51*e94e781bSJacob Faibussowitsch   FREECHAR(classname,t);
52*e94e781bSJacob Faibussowitsch }
53*e94e781bSJacob Faibussowitsch 
5419caf8f3SSatish Balay PETSC_EXTERN void petscinfo_(char* text,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len1)
555c6c1daeSBarry Smith {
565c6c1daeSBarry Smith   char *c1,*tmp;
575c6c1daeSBarry Smith 
585c6c1daeSBarry Smith   FIXCHAR(text,len1,c1);
595c6c1daeSBarry Smith   *ierr = PetscFixSlashN(c1,&tmp);if (*ierr) return;
605c6c1daeSBarry Smith   FREECHAR(text,c1);
618bceffaeSBarry Smith   *ierr = PetscInfo(NULL,tmp);if (*ierr) return;
628bceffaeSBarry Smith   *ierr = PetscFree(tmp);
635c6c1daeSBarry Smith }
64