Actual source code: zst.c

  2: #include "src/fortran/custom/zpetsc.h"
 3:  #include slepcst.h

  5: #ifdef PETSC_HAVE_FORTRAN_CAPS
  6: #define stsettype_                STSETTYPE           
  7: #define stregisterdestroy_        STREGISTERDESTROY
  8: #define stgettype_                STGETTYPE
  9: #define stdestroy_                STDESTROY
 10: #define stcreate_                 STCREATE
 11: #define stgetoperators_           STGETOPERATORS
 12: #define stsetoptionsprefix_       STSETOPTIONSPREFIX
 13: #define stappendoptionsprefix_    STAPPENDOPTIONSPREFIX
 14: #define stgetoptionsprefix_       STGETOPTIONSPREFIX
 15: #define stview_                   STVIEW
 16: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
 17: #define stsettype_                stsettype
 18: #define stregisterdestroy_        stregisterdestroy
 19: #define stgettype_                stgettype
 20: #define stdestroy_                stdestroy
 21: #define stcreate_                 stcreate
 22: #define stgetoperators_           stgetoperators
 23: #define stsetoptionsprefix_       stsetoptionsprefix
 24: #define stappendoptionsprefix_    stappendoptionsprefix
 25: #define stgetoptionsprefix_       stgetoptionsprefix
 26: #define stview_                   stview
 27: #endif

 29: EXTERN_C_BEGIN

 31: void PETSC_STDCALL stsettype_(ST *st,CHAR type PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len))
 32: {
 33:   char *t;

 35:   FIXCHAR(type,len,t);
 36:   *STSetType(*st,t);
 37:   FREECHAR(type,t);
 38: }

 40: void PETSC_STDCALL stregisterdestroy_(PetscErrorCode *ierr)
 41: {
 42:   *STRegisterDestroy();
 43: }

 45: void PETSC_STDCALL stgettype_(ST *st,CHAR name PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len))
 46: {
 47:   char *tname;

 49:   *STGetType(*st,&tname);
 50: #if defined(PETSC_USES_CPTOFCD)
 51:   {
 52:   char *t = _fcdtocp(name); int len1 = _fcdlen(name);
 53:   *PetscStrncpy(t,tname,len1); if (*ierr) return;
 54:   }
 55: #else
 56:   *PetscStrncpy(name,tname,len);if (*ierr) return;
 57: #endif
 58:   FIXRETURNCHAR(name,len);
 59: }

 61: void PETSC_STDCALL stdestroy_(ST *st,PetscErrorCode *ierr)
 62: {
 63:   *STDestroy(*st);
 64: }

 66: void PETSC_STDCALL stcreate_(MPI_Comm *comm,ST *newst,PetscErrorCode *ierr)
 67: {
 68:   *STCreate((MPI_Comm)PetscToPointerComm(*comm),newst);
 69: }

 71: void PETSC_STDCALL stgetoperators_(ST *st,Mat *mat,Mat *pmat,PetscErrorCode *ierr)
 72: {
 73:   if (FORTRANNULLOBJECT(mat))   mat = PETSC_NULL;
 74:   if (FORTRANNULLOBJECT(pmat))  pmat = PETSC_NULL;
 75:   *STGetOperators(*st,mat,pmat);
 76: }

 78: void PETSC_STDCALL stsetoptionsprefix_(ST *st,CHAR prefix PETSC_MIXED_LEN(len),
 79:                                        PetscErrorCode *ierr PETSC_END_LEN(len))
 80: {
 81:   char *t;

 83:   FIXCHAR(prefix,len,t);
 84:   *STSetOptionsPrefix(*st,t);
 85:   FREECHAR(prefix,t);
 86: }

 88: void PETSC_STDCALL stappendoptionsprefix_(ST *st,CHAR prefix PETSC_MIXED_LEN(len),
 89:                                           PetscErrorCode *ierr PETSC_END_LEN(len))
 90: {
 91:   char *t;

 93:   FIXCHAR(prefix,len,t);
 94:   *STAppendOptionsPrefix(*st,t);
 95:   FREECHAR(prefix,t);
 96: }

 98: void PETSC_STDCALL stgetoptionsprefix_(ST *st,CHAR prefix PETSC_MIXED_LEN(len),
 99:                                        PetscErrorCode *ierr PETSC_END_LEN(len))
100: {
101:   char *tname;

103:   *STGetOptionsPrefix(*st,&tname);
104: #if defined(PETSC_USES_CPTOFCD)
105:   {
106:     char *t = _fcdtocp(prefix); int len1 = _fcdlen(prefix);
107:     *PetscStrncpy(t,tname,len1);if (*ierr) return;
108:   }
109: #else
110:   *PetscStrncpy(prefix,tname,len);if (*ierr) return;
111: #endif
112:   FIXRETURNCHAR(prefix,len);
113: }

115: void PETSC_STDCALL stview_(ST *st,PetscViewer *viewer, PetscErrorCode *ierr)
116: {
117:   PetscViewer v;
118:   PetscPatchDefaultViewers_Fortran(viewer,v);
119:   *STView(*st,v);
120: }

122: EXTERN_C_END