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