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),int *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_(int *ierr)
 41: {
 42:   *STRegisterDestroy();
 43: }

 45: void PETSC_STDCALL stgettype_(ST *st,CHAR name PETSC_MIXED_LEN(len),int *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: }

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

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

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

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

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

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

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

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

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

113: void PETSC_STDCALL stview_(ST *st,PetscViewer *viewer, int *ierr)
114: {
115:   PetscViewer v;
116:   PetscPatchDefaultViewers_Fortran(viewer,v);
117:   *STView(*st,v);
118: }

120: EXTERN_C_END