Actual source code: zts.c
1: /*$Id: zts.c,v 1.39 2001/09/25 14:32:39 balay Exp $*/
3: #include src/fortran/custom/zpetsc.h
4: #include petscts.h
6: #ifdef PETSC_HAVE_FORTRAN_CAPS
7: #define tssetproblemtype_ TSSETPROBLEMTYPE
8: #define tssetrhsfunction_ TSSETRHSFUNCTION
9: #define tssetrhsmatrix_ TSSETRHSMATRIX
10: #define tssetrhsjacobian_ TSSETRHSJACOBIAN
11: #define tscreate_ TSCREATE
12: #define tsgetsolution_ TSGETSOLUTION
13: #define tsgetsnes_ TSGETSNES
14: #define tsgetksp_ TSGETKSP
15: #define tsgettype_ TSGETTYPE
16: #define tsdestroy_ TSDESTROY
17: #define tssetmonitor_ TSSETMONITOR
18: #define tssettype_ TSSETTYPE
19: #define tspvodegetiterations_ TSPVODEGETITERATIONS
20: #define tsdefaultcomputejacobian_ TSDEFAULTCOMPUTEJACOBIAN
21: #define tsdefaultcomputejacobiancolor_ TSDEFAULTCOMPUTEJACOBIANCOLOR
22: #define tsgetoptionsprefix_ TSGETOPTIONSPREFIX
23: #define tsdefaultmonitor_ TSDEFAULTMONITOR
24: #define tsview_ TSVIEW
25: #define tsgetrhsjacobian_ TSGETRHSJACOBIAN
26: #define tsgetrhsmatrix_ TSGETRHSMATRIX
27: #define tssetrhsboundaryconditions_ TSSETRHSBOUNDARYCONDITIONS
28: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
29: #define tssetproblemtype_ tssetproblemtype
30: #define tsdefaultcomputejacobian_ tsdefaultcomputejacobian
31: #define tsdefaultcomputejacobiancolor_ tsdefaultcomputejacobiancolor
32: #define tspvodegetiterations_ tspvodegetiterations
33: #define tssetrhsfunction_ tssetrhsfunction
34: #define tssetrhsmatrix_ tssetrhsmatrix
35: #define tssetrhsjacobian_ tssetrhsjacobian
36: #define tscreate_ tscreate
37: #define tsgetsolution_ tsgetsolution
38: #define tsgetsnes_ tsgetsnes
39: #define tsgetksp_ tsgetksp
40: #define tsgettype_ tsgettype
41: #define tsdestroy_ tsdestroy
42: #define tssetmonitor_ tssetmonitor
43: #define tssettype_ tssettype
44: #define tsgetoptionsprefix_ tsgetoptionsprefix
45: #define tsdefaultmonitor_ tsdefaultmonitor
46: #define tsview_ tsview
47: #define tsgetrhsjacobian_ tsgetrhsjacobian
48: #define tsgetrhsmatrix_ tsgetrhsmatrix
49: #define tssetrhsboundaryconditions_ tssetrhsboundaryconditions
50: #endif
53: static int ourtsbcfunction(TS ts,PetscReal d,Vec x,void *ctx)
54: {
55: int 0;
56: (*(void (PETSC_STDCALL *)(TS*,PetscReal*,Vec*,void*,int*))(((PetscObject)ts)->fortran_func_pointers[0]))(&ts,&d,&x,ctx,&ierr);
57: return 0;
58: }
60: static int ourtsfunction(TS ts,PetscReal d,Vec x,Vec f,void *ctx)
61: {
62: int 0;
63: (*(void (PETSC_STDCALL *)(TS*,PetscReal*,Vec*,Vec*,void*,int*))(((PetscObject)ts)->fortran_func_pointers[1]))(&ts,&d,&x,&f,ctx,&ierr);
64: return 0;
65: }
67: static int ourtsmatrix(TS ts,PetscReal d,Mat* m,Mat* p,MatStructure* type,void*ctx)
68: {
69: int 0;
70: (*(void (PETSC_STDCALL *)(TS*,PetscReal*,Mat*,Mat*,MatStructure*,void*,int*))(((PetscObject)ts)->fortran_func_pointers[2]))(&ts,&d,m,p,type,ctx,&ierr);
71: return 0;
72: }
74: static int ourtsjacobian(TS ts,PetscReal d,Vec x,Mat* m,Mat* p,MatStructure* type,void*ctx)
75: {
76: int 0;
77: (*(void (PETSC_STDCALL *)(TS*,PetscReal*,Vec*,Mat*,Mat*,MatStructure*,void*,int*))(((PetscObject)ts)->fortran_func_pointers[3]))(&ts,&d,&x,m,p,type,ctx,&ierr);
78: return 0;
79: }
81: /*
82: Note ctx is the same as ts so we need to get the Fortran context out of the TS
83: */
84: static int ourtsmonitor(TS ts,int i,PetscReal d,Vec v,void*ctx)
85: {
86: int 0;
87: void (*mctx)(void) = ((PetscObject)ts)->fortran_func_pointers[6];
88: (*(void (PETSC_STDCALL *)(TS*,int*,PetscReal*,Vec*,FCNVOID,int*))(((PetscObject)ts)->fortran_func_pointers[4]))(&ts,&i,&d,&v,mctx,&ierr);
89: return 0;
90: }
92: static int ourtsdestroy(void *ctx)
93: {
94: int 0;
95: TS ts = (TS)ctx;
96: void (*mctx)(void) = ((PetscObject)ts)->fortran_func_pointers[6];
97: (*(void (PETSC_STDCALL *)(FCNVOID,int*))(((PetscObject)ts)->fortran_func_pointers[5]))(mctx,&ierr);
98: return 0;
99: }
101: EXTERN_C_BEGIN
103: void PETSC_STDCALL tssetrhsboundaryconditions_(TS *ts,int (PETSC_STDCALL *f)(TS*,PetscReal*,Vec*,void*,int*),void *ctx,int *ierr)
104: {
105: ((PetscObject)*ts)->fortran_func_pointers[0] = (FCNVOID)f;
106: *TSSetRHSBoundaryConditions(*ts,ourtsbcfunction,ctx);
107: }
109: void PETSC_STDCALL tsgetrhsjacobian_(TS *ts,Mat *J,Mat *M,void **ctx,int *ierr)
110: {
111: *TSGetRHSJacobian(*ts,J,M,ctx);
112: }
114: void PETSC_STDCALL tssetproblemtype_(TS *ts,TSProblemType *t,int *ierr)
115: {
116: *TSSetProblemType(*ts,*t);
117: }
119: void PETSC_STDCALL tsgetrhsmatrix_(TS *ts,Mat *J,Mat *M,void **ctx,int *ierr)
120: {
121: *TSGetRHSMatrix(*ts,J,M,ctx);
122: }
124: void PETSC_STDCALL tsview_(TS *ts,PetscViewer *viewer, int *ierr)
125: {
126: PetscViewer v;
127: PetscPatchDefaultViewers_Fortran(viewer,v);
128: *TSView(*ts,v);
129: }
131: /* function */
132: void tsdefaultcomputejacobian_(TS *ts,PetscReal *t,Vec *xx1,Mat *J,Mat *B,MatStructure *flag,void *ctx,int *ierr)
133: {
134: *TSDefaultComputeJacobian(*ts,*t,*xx1,J,B,flag,ctx);
135: }
137: /* function */
138: void tsdefaultcomputejacobiancolor_(TS *ts,PetscReal *t,Vec *xx1,Mat *J,Mat *B,MatStructure *flag,void *ctx,int *ierr)
139: {
140: *TSDefaultComputeJacobianColor(*ts,*t,*xx1,J,B,flag,*(MatFDColoring*)ctx);
141: }
143: void PETSC_STDCALL tssettype_(TS *ts,CHAR type PETSC_MIXED_LEN(len),int *ierr PETSC_END_LEN(len))
144: {
145: char *t;
147: FIXCHAR(type,len,t);
148: *TSSetType(*ts,t);
149: FREECHAR(type,t);
150: }
153: void PETSC_STDCALL tssetrhsfunction_(TS *ts,int (PETSC_STDCALL *f)(TS*,PetscReal*,Vec*,Vec*,void*,int*),void*fP,int *ierr)
154: {
155: ((PetscObject)*ts)->fortran_func_pointers[1] = (FCNVOID)f;
156: *TSSetRHSFunction(*ts,ourtsfunction,fP);
157: }
160: /* ---------------------------------------------------------*/
162: void PETSC_STDCALL tssetrhsmatrix_(TS *ts,Mat *A,Mat *B,int (PETSC_STDCALL *f)(TS*,PetscReal*,Mat*,Mat*,MatStructure*,
163: void*,int *),void*fP,int *ierr)
164: {
165: if (FORTRANNULLFUNCTION(f)) {
166: *TSSetRHSMatrix(*ts,*A,*B,PETSC_NULL,fP);
167: } else {
168: ((PetscObject)*ts)->fortran_func_pointers[2] = (FCNVOID)f;
169: *TSSetRHSMatrix(*ts,*A,*B,ourtsmatrix,fP);
170: }
171: }
173: /* ---------------------------------------------------------*/
175: void PETSC_STDCALL tssetrhsjacobian_(TS *ts,Mat *A,Mat *B,void (PETSC_STDCALL *f)(TS*,PetscReal*,Vec*,Mat*,Mat*,MatStructure*,
176: void*,int*),void*fP,int *ierr)
177: {
178: if (FORTRANNULLFUNCTION(f)) {
179: *TSSetRHSJacobian(*ts,*A,*B,PETSC_NULL,fP);
180: } else if ((FCNVOID)f == (FCNVOID)tsdefaultcomputejacobian_) {
181: *TSSetRHSJacobian(*ts,*A,*B,TSDefaultComputeJacobian,fP);
182: } else if ((FCNVOID)f == (FCNVOID)tsdefaultcomputejacobiancolor_) {
183: *TSSetRHSJacobian(*ts,*A,*B,TSDefaultComputeJacobianColor,*(MatFDColoring*)fP);
184: } else {
185: ((PetscObject)*ts)->fortran_func_pointers[3] = (FCNVOID)f;
186: *TSSetRHSJacobian(*ts,*A,*B,ourtsjacobian,fP);
187: }
188: }
190: void PETSC_STDCALL tsgetsolution_(TS *ts,Vec *v,int *ierr)
191: {
192: *TSGetSolution(*ts,v);
193: }
195: void PETSC_STDCALL tscreate_(MPI_Comm *comm,TS *outts,int *ierr)
196: {
197: *TSCreate((MPI_Comm)PetscToPointerComm(*comm),outts);
198: *PetscMalloc(7*sizeof(void *),&((PetscObject)*outts)->fortran_func_pointers);
199: }
201: void PETSC_STDCALL tsgetsnes_(TS *ts,SNES *snes,int *ierr)
202: {
203: *TSGetSNES(*ts,snes);
204: }
206: void PETSC_STDCALL tsgetksp_(TS *ts,KSP *ksp,int *ierr)
207: {
208: *TSGetKSP(*ts,ksp);
209: }
211: void PETSC_STDCALL tsgettype_(TS *ts,CHAR name PETSC_MIXED_LEN(len),int *ierr PETSC_END_LEN(len))
212: {
213: char *tname;
215: *TSGetType(*ts,(TSType *)&tname);
216: #if defined(PETSC_USES_CPTOFCD)
217: {
218: char *t = _fcdtocp(name); int len1 = _fcdlen(name);
219: *PetscStrncpy(t,tname,len1);
220: }
221: #else
222: *PetscStrncpy(name,tname,len);
223: #endif
224: }
226: #if defined(PETSC_HAVE_PVODE) && !defined(PETSC_USE_COMPLEX) && !defined(PETSC_USE_SINGLE)
227: void PETSC_STDCALL tspvodegetiterations_(TS *ts,int *nonlin,int *lin,int *ierr)
228: {
229: CHKFORTRANNULLINTEGER(nonlin);
230: CHKFORTRANNULLINTEGER(lin);
231: *TSPVodeGetIterations(*ts,nonlin,lin);
232: }
233: #endif
235: void PETSC_STDCALL tsdestroy_(TS *ts,int *ierr){
236: *TSDestroy(*ts);
237: }
239: void PETSC_STDCALL tsdefaultmonitor_(TS *ts,int *step,PetscReal *dt,Vec *x,void *ctx,int *ierr)
240: {
241: *TSDefaultMonitor(*ts,*step,*dt,*x,ctx);
242: }
245: void PETSC_STDCALL tssetmonitor_(TS *ts,void (PETSC_STDCALL *func)(TS*,int*,PetscReal*,Vec*,void*,int*),void (*mctx)(void),void (PETSC_STDCALL *d)(void*,int*),int *ierr)
246: {
247: if ((FCNVOID)func == (FCNVOID)tsdefaultmonitor_) {
248: *TSSetMonitor(*ts,TSDefaultMonitor,0,0);
249: } else {
250: ((PetscObject)*ts)->fortran_func_pointers[4] = (FCNVOID)func;
251: ((PetscObject)*ts)->fortran_func_pointers[5] = (FCNVOID)d;
252: ((PetscObject)*ts)->fortran_func_pointers[6] = (FCNVOID)mctx;
253: if (FORTRANNULLFUNCTION(d)) {
254: *TSSetMonitor(*ts,ourtsmonitor,*ts,0);
255: } else {
256: *TSSetMonitor(*ts,ourtsmonitor,*ts,ourtsdestroy);
257: }
258: }
259: }
261: void PETSC_STDCALL tsgetoptionsprefix_(TS *ts,CHAR prefix PETSC_MIXED_LEN(len),int *ierr PETSC_END_LEN(len))
262: {
263: char *tname;
265: *TSGetOptionsPrefix(*ts,&tname);
266: #if defined(PETSC_USES_CPTOFCD)
267: {
268: char *t = _fcdtocp(prefix); int len1 = _fcdlen(prefix);
269: *PetscStrncpy(t,tname,len1);
270: }
271: #else
272: *PetscStrncpy(prefix,tname,len);
273: #endif
274: }
277: EXTERN_C_END