Actual source code: zsys.c
2: #include src/fortran/custom/zpetsc.h
3: #include petscsys.h
4: #include petscmatlab.h
6: #ifdef PETSC_HAVE_FORTRAN_CAPS
7: #define petscpopsignalhandler_ PETSCPOPSIGNALHANDLER
8: #define petscgetcputime_ PETSCGETCPUTIME
9: #define petscfopen_ PETSCFOPEN
10: #define petscfclose_ PETSCFCLOSE
11: #define petscfprintf_ PETSCFPRINTF
12: #define petscsynchronizedfprintf_ PETSCSYNCHRONIZEDFPRINTF
13: #define petscprintf_ PETSCPRINTF
14: #define petscsynchronizedprintf_ PETSCSYNCHRONIZEDPRINTF
15: #define petscsynchronizedflush_ PETSCSYNCHRONIZEDFLUSH
16: #define chkmemfortran_ CHKMEMFORTRAN
17: #define petscattachdebugger_ PETSCATTACHDEBUGGER
18: #define petscobjectsetname_ PETSCOBJECTSETNAME
19: #define petscobjectdestroy_ PETSCOBJECTDESTROY
20: #define petscobjectgetcomm_ PETSCOBJECTGETCOMM
21: #define petscobjectgetname_ PETSCOBJECTGETNAME
22: #define petscgetflops_ PETSCGETFLOPS
23: #define petscerror_ PETSCERROR
24: #define petscrandomcreate_ PETSCRANDOMCREATE
25: #define petscrandomdestroy_ PETSCRANDOMDESTROY
26: #define petscrandomgetvalue_ PETSCRANDOMGETVALUE
27: #define petsctrvalid_ PETSCTRVALID
28: #define petscrealview_ PETSCREALVIEW
29: #define petscintview_ PETSCINTVIEW
30: #define petscsequentialphasebegin_ PETSCSEQUENTIALPHASEBEGIN
31: #define petscsequentialphaseend_ PETSCSEQUENTIALPHASEEND
32: #define petsctrlog_ PETSCTRLOG
33: #define petscmemcpy_ PETSCMEMCPY
34: #define petsctrdump_ PETSCTRDUMP
35: #define petsctrlogdump_ PETSCTRLOGDUMP
36: #define petscmemzero_ PETSCMEMZERO
37: #define petscbinaryopen_ PETSCBINARYOPEN
38: #define petscbinaryread_ PETSCBINARYREAD
39: #define petscbinarywrite_ PETSCBINARYWRITE
40: #define petscbinaryclose_ PETSCBINARYCLOSE
41: #define petscbinaryseek_ PETSCBINARYSEEK
42: #define petscfixfilename_ PETSCFIXFILENAME
43: #define petscstrncpy_ PETSCSTRNCPY
44: #define petscbarrier_ PETSCBARRIER
45: #define petscsynchronizedflush_ PETSCSYNCHRONIZEDFLUSH
46: #define petscsplitownership_ PETSCSPLITOWNERSHIP
47: #define petscsplitownershipblock_ PETSCSPLITOWNERSHIPBLOCK
48: #define petscobjectgetnewtag_ PETSCOBJECTGETNEWTAG
49: #define petsccommgetnewtag_ PETSCCOMMGETNEWTAG
50: #define petscfptrap_ PETSCFPTRAP
51: #define petscoffsetfortran_ PETSCOFFSETFORTRAN
52: #define petscmatlabenginecreate_ PETSCMATLABENGINECREATE
53: #define petscmatlabenginedestroy_ PETSCMATLABENGINEDESTROY
54: #define petscmatlabengineevaluate_ PETSCMATLABENGINEEVALUATE
55: #define petscmatlabenginegetoutput_ PETSCMATLABENGINEGETOUTPUT
56: #define petscmatlabengineprintoutput_ PETSCMATLABENGINEPRINTOUTPUT
57: #define petscmatlabengineput_ PETSCMATLABENGINEPUT
58: #define petscmatlabengineget_ PETSCMATLABENGINEGET
59: #define petscmatlabengineputarray_ PETSCMATLABENGINEPUTARRAY
60: #define petscmatlabenginegetarray_ PETSCMATLABENGINEGETARRAY
61: #define petscgetresidentsetsize_ PETSCGETRESIDENTSETSIZE
62: #define petsctrspace_ PETSCTRSPACE
63: #define petscviewerasciiprintf_ PETSCVIEWERASCIIPRINTF
64: #define petscviewerasciisynchronizedprintf_ PETSCVIEWERASCIISYNCHRONIZEDPRINTF
65: #define petscviewerasciisettab_ PETSCVIEWERASCIISETTAB
66: #define petscviewerasciipushtab_ PETSCVIEWERASCIIPUSHTAB
67: #define petscviewerasciipoptab_ PETSCVIEWERASCIIPOPTAB
68: #define petscviewerasciiusetabs_ PETSCVIEWERASCIIUSETABS
69: #define petscpusherrorhandler_ PETSCPUSHERRORHANDLER
70: #define petscpoperrorhandler_ PETSCPOPERRORHANDLER
71: #define petsctracebackerrorhandler_ PETSCTRACEBACKERRORHANDLER
72: #define petscaborterrorhandler_ PETSCABORTERRORHANDLER
73: #define petscignoreerrorhandler_ PETSCIGNOREERRORHANDLER
74: #define petscemacsclienterrorhandler_ PETSCEMACSCLIENTERRORHANDLER
75: #define petscattachdebuggererrorhandler_ PETSCATTACHDEBUGGERERRORHANDLER
76: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
77: #define petscpopsignalhandler_ petscpopsignalhandler
78: #define petscfopen_ petscfopen
79: #define petscfclose_ petscfclose
80: #define petscfprintf_ petscfprintf
81: #define petscsynchronizedfprintf_ petscsynchronizedfprintf
82: #define petscprintf_ petscprintf
83: #define petscsynchronizedprintf_ petscsynchronizedprintf
84: #define petscsynchronizedflush_ petscsynchronizedflush
85: #define petscmatlabenginecreate_ petscmatlabenginecreate
86: #define petscmatlabenginedestroy_ petscmatlabenginedestroy
87: #define petscmatlabengineevaluate_ petscmatlabengineevaluate
88: #define petscmatlabenginegetoutput_ petscmatlabenginegetoutput
89: #define petscmatlabengineprintoutput_ petscmatlabengineprintoutput
90: #define petscmatlabengineput_ petscmatlabengineput
91: #define petscmatlabengineget_ petscmatlabengineget
92: #define petscmatlabengineputarray_ petscmatlabengineputarray
93: #define petscmatlabenginegetarray_ petscmatlabenginegetarray
94: #define petscoffsetfortran_ petscoffsetfortran
95: #define chkmemfortran_ chkmemfortran
96: #define petscobjectgetnewtag_ petscobjectgetnewtag
97: #define petsccommgetnewtag_ petsccommgetnewtag
98: #define petscsplitownership_ petscsplitownership
99: #define petscsplitownershipblock_ petscsplitownershipblock
100: #define petscbarrier_ petscbarrier
101: #define petscstrncpy_ petscstrncpy
102: #define petscfixfilename_ petscfixfilename
103: #define petsctrlog_ petsctrlog
104: #define petscattachdebugger_ petscattachdebugger
105: #define petscobjectsetname_ petscobjectsetname
106: #define petscobjectdestroy_ petscobjectdestroy
107: #define petscobjectgetcomm_ petscobjectgetcomm
108: #define petscobjectgetname_ petscobjectgetname
109: #define petscgetflops_ petscgetflops
110: #define petscerror_ petscerror
111: #define petscrandomcreate_ petscrandomcreate
112: #define petscrandomdestroy_ petscrandomdestroy
113: #define petscrandomgetvalue_ petscrandomgetvalue
114: #define petsctrvalid_ petsctrvalid
115: #define petscrealview_ petscrealview
116: #define petscintview_ petscintview
117: #define petscsequentialphasebegin_ petscsequentialphasebegin
118: #define petscsequentialphaseend_ petscsequentialphaseend
119: #define petscmemcpy_ petscmemcpy
120: #define petsctrdump_ petsctrdump
121: #define petsctrlogdump_ petsctlogrdump
122: #define petscmemzero_ petscmemzero
123: #define petscbinaryopen_ petscbinaryopen
124: #define petscbinaryread_ petscbinaryread
125: #define petscbinarywrite_ petscbinarywrite
126: #define petscbinaryclose_ petscbinaryclose
127: #define petscbinaryseek_ petscbinaryseek
128: #define petscsynchronizedflush_ petscsynchronizedflush
129: #define petscfptrap_ petscfptrap
130: #define petscgetcputime_ petscgetcputime
131: #define petscgetresidentsetsize_ petscgetresidentsetsize
132: #define petsctrspace_ petsctrspace
133: #define petscviewerasciiprintf_ petscviewerasciiprintf
134: #define petscviewerasciisynchronizedprintf_ petscviewerasciisynchronizedprintf
135: #define petscviewerasciisettab_ petscviewerasciisettab
136: #define petscviewerasciipushtab_ petscviewerasciipushtab
137: #define petscviewerasciipoptab_ petscviewerasciipoptab
138: #define petscviewerasciiusetabs_ petscviewerasciiusetabs
139: #define petscpusherrorhandler_ petscpusherrorhandler
140: #define petscpoperrorhandler_ petscpoperrorhandler
141: #define petsctracebackerrorhandler_ petsctracebackerrorhandler
142: #define petscaborterrorhandler_ petscaborterrorhandler
143: #define petscignoreerrorhandler_ petscignoreerrorhandler
144: #define petscemacsclienterrorhandler_ petscemacsclienterrorhandler
145: #define petscattachdebuggererrorhandler_ petscattachdebuggererrorhandler
146: #endif
149: static void (PETSC_STDCALL *f2)(int*,const CHAR PETSC_MIXED_LEN(len1),const CHAR PETSC_MIXED_LEN(len2),const CHAR PETSC_MIXED_LEN(len3),int*,int*,const CHAR PETSC_MIXED_LEN(len4),void*,PetscErrorCode* PETSC_END_LEN(len1) PETSC_END_LEN(len2) PETSC_END_LEN(len3) PETSC_END_LEN(len4));
153: static PetscErrorCode ourerrorhandler(int line,const char *fun,const char *file,const char *dir,int n,int p,const char *mess,void *ctx)
154: {
155: PetscErrorCode 0;
156: size_t len1,len2,len3,len4;
157: int l1,l2,l3,l4;
159: PetscStrlen(fun,&len1); l1 = (int)len1;
160: PetscStrlen(file,&len2);l2 = (int)len2;
161: PetscStrlen(dir,&len3);l3 = (int)len3;
162: PetscStrlen(mess,&len4);l4 = (int)len4;
164: #if defined(PETSC_USES_CPTOFCD)
165: {
166: CHAR fun_c,file_c,dir_c,mess_c;
168: fun_c = _cptofcd(fun,len1);
169: file_c = _cptofcd(file,len2);
170: dir_c = _cptofcd(dir,len3);
171: mess_c = _cptofcd(mess,len4);
172: (*f2)(&line,fun_c,file_c,dir_c,&n,&p,mess_c,ctx,&ierr,len1,len2,len3,len4);
174: }
175: #elif defined(PETSC_HAVE_FORTRAN_MIXED_STR_ARG)
176: (*f2)(&line,fun,l1,file,l2,dir,l3,&n,&p,mess,l4,ctx,&ierr);
177: #else
178: (*f2)(&line,fun,file,dir,&n,&p,mess,ctx,&ierr,l1,l2,l3,l4);
179: #endif
180: return ierr;
181: }
184: /*
185: integer i_x,i_y,shift
186: Vec x,y
187: PetscScalar v_x(1),v_y(1)
189: call VecGetArray(x,v_x,i_x,ierr)
190: if (x .eq. y) then
191: call PetscOffsetFortran(y_v,x_v,shift,ierr)
192: i_y = i_x + shift
193: else
194: call VecGetArray(y,v_y,i_y,ierr)
195: endif
196: */
198: /*
199: These are not usually called from Fortran but allow Fortran users
200: to transparently set these monitors from .F code
201:
202: functions, hence no STDCALL
203: */
204: void petsctracebackerrorhandler_(int *line,const char *fun,const char *file,const char *dir,int *n,int *p,const char *mess,void *ctx,PetscErrorCode *ierr)
205: {
206: *PetscTraceBackErrorHandler(*line,fun,file,dir,*n,*p,mess,ctx);
207: }
209: void petscaborterrorhandler_(int *line,const char *fun,const char *file,const char *dir,int *n,int *p,const char *mess,void *ctx,PetscErrorCode *ierr)
210: {
211: *PetscAbortErrorHandler(*line,fun,file,dir,*n,*p,mess,ctx);
212: }
214: void petscattachdebuggererrorhandler_(int *line,const char *fun,const char *file,const char *dir,int *n,int *p,const char *mess,void *ctx,PetscErrorCode *ierr)
215: {
216: *PetscAttachDebuggerErrorHandler(*line,fun,file,dir,*n,*p,mess,ctx);
217: }
219: void petscemacsclienterrorhandler_(int *line,const char *fun,const char *file,const char *dir,int *n,int *p,const char *mess,void *ctx,PetscErrorCode *ierr)
220: {
221: *PetscEmacsClientErrorHandler(*line,fun,file,dir,*n,*p,mess,ctx);
222: }
224: void petscignoreerrorhandler_(int *line,const char *fun,const char *file,const char *dir,int *n,int *p,const char *mess,void *ctx,PetscErrorCode *ierr)
225: {
226: *PetscIgnoreErrorHandler(*line,fun,file,dir,*n,*p,mess,ctx);
227: }
229: void PETSC_STDCALL petscpusherrorhandler_(void (PETSC_STDCALL *handler)(int*,const CHAR PETSC_MIXED_LEN(len1),const CHAR PETSC_MIXED_LEN(len2),const CHAR PETSC_MIXED_LEN(len3),int*,int*,const CHAR PETSC_MIXED_LEN(len4),void*,PetscErrorCode* PETSC_END_LEN(len1) PETSC_END_LEN(len2) PETSC_END_LEN(len3) PETSC_END_LEN(len4)),void *ctx,PetscErrorCode *ierr)
230: {
231: if ((void(*)(void))handler == (void(*)(void))petsctracebackerrorhandler_) {
232: *PetscPushErrorHandler(PetscTraceBackErrorHandler,0);
233: } else {
234: f2 = handler;
235: *PetscPushErrorHandler(ourerrorhandler,ctx);
236: }
237: }
239: void PETSC_STDCALL petscpopsignalhandler_(PetscErrorCode *ierr)
240: {
241: *PetscPopSignalHandler();
242: }
244: void PETSC_STDCALL petscpoperrorhandler_(PetscErrorCode *ierr)
245: {
246: *PetscPopErrorHandler();
247: }
249: void PETSC_STDCALL petscviewerasciisettab_(PetscViewer *viewer,PetscInt *tabs,PetscErrorCode *ierr)
250: {
251: *PetscViewerASCIISetTab(*viewer,*tabs);
252: }
254: void PETSC_STDCALL petscviewerasciipushtab_(PetscViewer *viewer,PetscErrorCode *ierr)
255: {
256: *PetscViewerASCIIPushTab(*viewer);
257: }
259: void PETSC_STDCALL petscviewerasciipoptab_(PetscViewer *viewer,PetscErrorCode *ierr)
260: {
261: *PetscViewerASCIIPopTab(*viewer);
262: }
264: void PETSC_STDCALL petscviewerasciiusetabs_(PetscViewer *viewer,PetscTruth *flg,PetscErrorCode *ierr)
265: {
266: *PetscViewerASCIIUseTabs(*viewer,*flg);
267: }
269: void PETSC_STDCALL petscviewerasciiprintf_(PetscViewer *viewer,CHAR str PETSC_MIXED_LEN(len1),PetscErrorCode *ierr PETSC_END_LEN(len1))
270: {
271: char *c1;
273: FIXCHAR(str,len1,c1);
274: *PetscViewerASCIIPrintf(*viewer,c1);
275: FREECHAR(str,c1);
276: }
278: void PETSC_STDCALL petscviewerasciisynchronizedprintf_(PetscViewer *viewer,CHAR str PETSC_MIXED_LEN(len1),PetscErrorCode *ierr PETSC_END_LEN(len1))
279: {
280: char *c1;
282: FIXCHAR(str,len1,c1);
283: *PetscViewerASCIISynchronizedPrintf(*viewer,c1);
284: FREECHAR(str,c1);
285: }
287: void PETSC_STDCALL petsctrspace_(PetscLogDouble *space,PetscLogDouble *fr,PetscLogDouble *maxs, PetscErrorCode *ierr)
288: {
289: *PetscTrSpace(space,fr,maxs);
290: }
292: void PETSC_STDCALL petscgetresidentsetsize_(PetscLogDouble *foo, PetscErrorCode *ierr)
293: {
294: *PetscGetResidentSetSize(foo);
295: }
297: void PETSC_STDCALL petscoffsetfortran_(PetscScalar *x,PetscScalar *y,PetscInt *shift,PetscErrorCode *ierr)
298: {
299: *0;
300: *shift = y - x;
301: }
303: void PETSC_STDCALL petscgetcputime_(PetscLogDouble *t, PetscErrorCode *ierr)
304: {
305: *PetscGetCPUTime(t);
306: }
308: void PETSC_STDCALL petscfopen_(MPI_Comm *comm,CHAR fname PETSC_MIXED_LEN(len1),CHAR fmode PETSC_MIXED_LEN(len2),
309: FILE **file,PetscErrorCode *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2))
310: {
311: char *c1,*c2;
313: FIXCHAR(fname,len1,c1);
314: FIXCHAR(fmode,len2,c2);
315: *PetscFOpen((MPI_Comm)PetscToPointerComm(*comm),c1,c2,file);
316: FREECHAR(fname,c1);
317: FREECHAR(fmode,c2);
318: }
319:
320: void PETSC_STDCALL petscfclose_(MPI_Comm *comm,FILE **file,PetscErrorCode *ierr)
321: {
322: *PetscFClose((MPI_Comm)PetscToPointerComm(*comm),*file);
323: }
325: void PETSC_STDCALL petscsynchronizedflush_(MPI_Comm *comm,PetscErrorCode *ierr)
326: {
327: *PetscSynchronizedFlush((MPI_Comm)PetscToPointerComm(*comm));
328: }
330: void PETSC_STDCALL petscfprintf_(MPI_Comm *comm,FILE **file,CHAR fname PETSC_MIXED_LEN(len1),PetscErrorCode *ierr PETSC_END_LEN(len1))
331: {
332: char *c1;
334: FIXCHAR(fname,len1,c1);
335: *PetscFPrintf((MPI_Comm)PetscToPointerComm(*comm),*file,c1);
336: FREECHAR(fname,c1);
337: }
339: void PETSC_STDCALL petscprintf_(MPI_Comm *comm,CHAR fname PETSC_MIXED_LEN(len1),PetscErrorCode *ierr PETSC_END_LEN(len1))
340: {
341: char *c1;
343: FIXCHAR(fname,len1,c1);
344: *PetscPrintf((MPI_Comm)PetscToPointerComm(*comm),c1);
345: FREECHAR(fname,c1);
346: }
348: void PETSC_STDCALL petscsynchronizedfprintf_(MPI_Comm *comm,FILE **file,CHAR fname PETSC_MIXED_LEN(len1),PetscErrorCode *ierr PETSC_END_LEN(len1))
349: {
350: char *c1;
352: FIXCHAR(fname,len1,c1);
353: *PetscSynchronizedFPrintf((MPI_Comm)PetscToPointerComm(*comm),*file,c1);
354: FREECHAR(fname,c1);
355: }
357: void PETSC_STDCALL petscsynchronizedprintf_(MPI_Comm *comm,CHAR fname PETSC_MIXED_LEN(len1),PetscErrorCode *ierr PETSC_END_LEN(len1))
358: {
359: char *c1;
361: FIXCHAR(fname,len1,c1);
362: *PetscSynchronizedPrintf((MPI_Comm)PetscToPointerComm(*comm),c1);
363: FREECHAR(fname,c1);
364: }
366: void PETSC_STDCALL petscsetfptrap_(PetscFPTrap *flag,PetscErrorCode *ierr)
367: {
368: *PetscSetFPTrap(*flag);
369: }
371: void PETSC_STDCALL petscobjectgetnewtag_(PetscObject *obj,PetscMPIInt *tag,PetscErrorCode *ierr)
372: {
373: *PetscObjectGetNewTag(*obj,tag);
374: }
376: void PETSC_STDCALL petsccommgetnewtag_(MPI_Comm *comm,PetscMPIInt *tag,PetscErrorCode *ierr)
377: {
378: *PetscCommGetNewTag((MPI_Comm)PetscToPointerComm(*comm),tag);
379: }
381: void PETSC_STDCALL petscsplitownershipblock_(MPI_Comm *comm,PetscInt *bs,PetscInt *n,PetscInt *N,PetscErrorCode *ierr)
382: {
383: *PetscSplitOwnershipBlock((MPI_Comm)PetscToPointerComm(*comm),*bs,n,N);
384: }
385: void PETSC_STDCALL petscsplitownership_(MPI_Comm *comm,PetscInt *n,PetscInt *N,PetscErrorCode *ierr)
386: {
387: *PetscSplitOwnership((MPI_Comm)PetscToPointerComm(*comm),n,N);
388: }
390: void PETSC_STDCALL petscbarrier_(PetscObject *obj,PetscErrorCode *ierr)
391: {
392: *PetscBarrier(*obj);
393: }
395: void PETSC_STDCALL petscstrncpy_(CHAR s1 PETSC_MIXED_LEN(len1),CHAR s2 PETSC_MIXED_LEN(len2),int *n,
396: PetscErrorCode *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2))
397: {
398: char *t1,*t2;
399: int m;
401: #if defined(PETSC_USES_CPTOFCD)
402: t1 = _fcdtocp(s1);
403: t2 = _fcdtocp(s2);
404: m = *n; if (_fcdlen(s1) < m) m = _fcdlen(s1); if (_fcdlen(s2) < m) m = _fcdlen(s2);
405: #else
406: t1 = s1;
407: t2 = s2;
408: m = *n; if (len1 < m) m = len1; if (len2 < m) m = len2;
409: #endif
410: *PetscStrncpy(t1,t2,m);
411: }
413: void PETSC_STDCALL petscfixfilename_(CHAR filein PETSC_MIXED_LEN(len1),CHAR fileout PETSC_MIXED_LEN(len2),
414: PetscErrorCode *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2))
415: {
416: PetscInt i,n;
417: char *in,*out;
419: #if defined(PETSC_USES_CPTOFCD)
420: in = _fcdtocp(filein);
421: out = _fcdtocp(fileout);
422: n = _fcdlen (filein);
423: #else
424: in = filein;
425: out = fileout;
426: n = len1;
427: #endif
429: for (i=0; i<n; i++) {
430: if (in[i] == PETSC_REPLACE_DIR_SEPARATOR) out[i] = PETSC_DIR_SEPARATOR;
431: else out[i] = in[i];
432: }
433: out[i] = 0;
434: }
436: void PETSC_STDCALL petscbinaryopen_(CHAR name PETSC_MIXED_LEN(len),PetscViewerFileType *type,int *fd,
437: PetscErrorCode *ierr PETSC_END_LEN(len))
438: {
439: char *c1;
441: FIXCHAR(name,len,c1);
442: *PetscBinaryOpen(c1,*type,fd);
443: FREECHAR(name,c1);
444: }
446: void PETSC_STDCALL petscbinarywrite_(int *fd,void *p,PetscInt *n,PetscDataType *type,PetscTruth *istemp,PetscErrorCode *ierr)
447: {
448: *PetscBinaryWrite(*fd,p,*n,*type,*istemp);
449: }
451: void PETSC_STDCALL petscbinaryread_(int *fd,void *p,PetscInt *n,PetscDataType *type,PetscErrorCode *ierr)
452: {
453: *PetscBinaryRead(*fd,p,*n,*type);
454: }
456: void PETSC_STDCALL petscbinaryseek_(int *fd,PetscInt *size,PetscBinarySeekType *whence,off_t *offset,PetscErrorCode *ierr)
457: {
458: *PetscBinarySeek(*fd,*size,*whence,offset);
459: }
461: void PETSC_STDCALL petscbinaryclose_(int *fd,PetscErrorCode *ierr)
462: {
463: *PetscBinaryClose(*fd);
464: }
466: /* ---------------------------------------------------------------------------------*/
467: void PETSC_STDCALL petscmemzero_(void *a,PetscInt *n,PetscErrorCode *ierr)
468: {
469: *PetscMemzero(a,*n);
470: }
472: void PETSC_STDCALL petsctrdump_(PetscErrorCode *ierr)
473: {
474: *PetscTrDump(stdout);
475: }
476: void PETSC_STDCALL petsctrlogdump_(PetscErrorCode *ierr)
477: {
478: *PetscTrLogDump(stdout);
479: }
481: void PETSC_STDCALL petscmemcpy_(int *out,int *in,int *length,PetscErrorCode *ierr)
482: {
483: *PetscMemcpy(out,in,*length);
484: }
486: void PETSC_STDCALL petsctrlog_(PetscErrorCode *ierr)
487: {
488: *PetscTrLog();
489: }
491: /*
492: This version does not do a malloc
493: */
494: static char FIXCHARSTRING[1024];
495: #if defined(PETSC_USES_CPTOFCD)
496: #include <fortran.h>
498: #define CHAR _fcd
499: #define FIXCHARNOMALLOC(a,n,b) \
500: { \
501: b = _fcdtocp(a); \
502: n = _fcdlen (a); \
503: if (b == PETSC_NULL_CHARACTER_Fortran) { \
504: b = 0; \
505: } else { \
506: while((n > 0) && (b[n-1] == ' ')) n--; \
507: b = FIXCHARSTRING; \
508: *PetscStrncpy(b,_fcdtocp(a),n); \
509: if (*ierr) return; \
510: b[n] = 0; \
511: } \
512: }
514: #else
516: #define CHAR char*
517: #define FIXCHARNOMALLOC(a,n,b) \
518: {\
519: if (a == PETSC_NULL_CHARACTER_Fortran) { \
520: b = a = 0; \
521: } else { \
522: while((n > 0) && (a[n-1] == ' ')) n--; \
523: if (a[n] != 0) { \
524: b = FIXCHARSTRING; \
525: *PetscStrncpy(b,a,n); \
526: if (*ierr) return; \
527: b[n] = 0; \
528: } else b = a;\
529: } \
530: }
532: #endif
534: void PETSC_STDCALL chkmemfortran_(int *line,CHAR file PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len))
535: {
536: char *c1;
538: FIXCHARNOMALLOC(file,len,c1);
539: *PetscTrValid(*line,"Userfunction",c1," ");
540: }
542: void PETSC_STDCALL petsctrvalid_(PetscErrorCode *ierr)
543: {
544: *PetscTrValid(0,"Unknown Fortran",0,0);
545: }
547: void PETSC_STDCALL petscrandomgetvalue_(PetscRandom *r,PetscScalar *val,PetscErrorCode *ierr)
548: {
549: *PetscRandomGetValue(*r,val);
550: }
553: void PETSC_STDCALL petscobjectgetname_(PetscObject *obj,CHAR name PETSC_MIXED_LEN(len),
554: PetscErrorCode *ierr PETSC_END_LEN(len))
555: {
556: char *tmp;
557: *PetscObjectGetName(*obj,&tmp);
558: #if defined(PETSC_USES_CPTOFCD)
559: {
560: char *t = _fcdtocp(name);
561: int len1 = _fcdlen(name);
562: *PetscStrncpy(t,tmp,len1);if (*ierr) return;
563: }
564: #else
565: *PetscStrncpy(name,tmp,len);if (*ierr) return;
566: #endif
567: }
569: void PETSC_STDCALL petscobjectdestroy_(PetscObject *obj,PetscErrorCode *ierr)
570: {
571: *PetscObjectDestroy(*obj);
572: }
574: void PETSC_STDCALL petscobjectgetcomm_(PetscObject *obj,int *comm,PetscErrorCode *ierr)
575: {
576: MPI_Comm c;
577: *PetscObjectGetComm(*obj,&c);
578: *(int*)comm = PetscFromPointerComm(c);
579: }
581: void PETSC_STDCALL petscattachdebugger_(PetscErrorCode *ierr)
582: {
583: *PetscAttachDebugger();
584: }
586: void PETSC_STDCALL petscobjectsetname_(PetscObject *obj,CHAR name PETSC_MIXED_LEN(len),
587: PetscErrorCode *ierr PETSC_END_LEN(len))
588: {
589: char *t1;
591: FIXCHAR(name,len,t1);
592: *PetscObjectSetName(*obj,t1);
593: FREECHAR(name,t1);
594: }
596: void PETSC_STDCALL petscerror_(int *number,int *p,CHAR message PETSC_MIXED_LEN(len),
597: PetscErrorCode *ierr PETSC_END_LEN(len))
598: {
599: char *t1;
600: FIXCHAR(message,len,t1);
601: *PetscError(-1,0,0,0,*number,*p,t1);
602: FREECHAR(message,t1);
603: }
605: void PETSC_STDCALL petscgetflops_(PetscLogDouble *d,PetscErrorCode *ierr)
606: {
607: #if defined(PETSC_USE_LOG)
608: *PetscGetFlops(d);
609: #else
610: 0;
611: *d = 0.0;
612: #endif
613: }
615: void PETSC_STDCALL petscrandomcreate_(MPI_Comm *comm,PetscRandomType *type,PetscRandom *r,PetscErrorCode *ierr)
616: {
617: *PetscRandomCreate((MPI_Comm)PetscToPointerComm(*comm),*type,r);
618: }
620: void PETSC_STDCALL petscrandomdestroy_(PetscRandom *r,PetscErrorCode *ierr)
621: {
622: *PetscRandomDestroy(*r);
623: }
625: void PETSC_STDCALL petscrealview_(PetscInt *n,PetscReal *d,int *viwer,PetscErrorCode *ierr)
626: {
627: *PetscRealView(*n,d,0);
628: }
630: void PETSC_STDCALL petscintview_(PetscInt *n,PetscInt *d,int *viwer,PetscErrorCode *ierr)
631: {
632: *PetscIntView(*n,d,0);
633: }
635: void PETSC_STDCALL petscsequentialphasebegin_(MPI_Comm *comm,PetscInt *ng,PetscErrorCode *ierr){
636: *PetscSequentialPhaseBegin(
637: (MPI_Comm)PetscToPointerComm(*comm),*ng);
638: }
639: void PETSC_STDCALL petscsequentialphaseend_(MPI_Comm *comm,PetscInt *ng,PetscErrorCode *ierr){
640: *PetscSequentialPhaseEnd(
641: (MPI_Comm)PetscToPointerComm(*comm),*ng);
642: }
645: #if defined(PETSC_HAVE_MATLAB) && !defined(PETSC_USE_COMPLEX) && !defined(PETSC_USE_SINGLE)
647: void PETSC_STDCALL petscmatlabenginecreate_(MPI_Comm *comm,CHAR m PETSC_MIXED_LEN(len),PetscMatlabEngine *e,
648: PetscErrorCode *ierr PETSC_END_LEN(len))
649: {
650: char *ms;
652: FIXCHAR(m,len,ms);
653: *PetscMatlabEngineCreate((MPI_Comm)PetscToPointerComm(*comm),ms,e);
654: FREECHAR(m,ms);
655: }
657: void PETSC_STDCALL petscmatlabenginedestroy_(PetscMatlabEngine *e,PetscErrorCode *ierr)
658: {
659: *PetscMatlabEngineDestroy(*e);
660: }
662: void PETSC_STDCALL petscmatlabengineevaluate_(PetscMatlabEngine *e,CHAR m PETSC_MIXED_LEN(len),
663: PetscErrorCode *ierr PETSC_END_LEN(len))
664: {
665: char *ms;
666: FIXCHAR(m,len,ms);
667: *PetscMatlabEngineEvaluate(*e,ms);
668: FREECHAR(m,ms);
669: }
671: void PETSC_STDCALL petscmatlabengineput_(PetscMatlabEngine *e,PetscObject *o,PetscErrorCode *ierr)
672: {
673: *PetscMatlabEnginePut(*e,*o);
674: }
676: void PETSC_STDCALL petscmatlabengineget_(PetscMatlabEngine *e,PetscObject *o,PetscErrorCode *ierr)
677: {
678: *PetscMatlabEngineGet(*e,*o);
679: }
681: void PETSC_STDCALL petscmatlabengineputarray_(PetscMatlabEngine *e,PetscInt *m,PetscInt *n,PetscScalar *a,
682: CHAR s PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len))
683: {
684: char *ms;
685: FIXCHAR(s,len,ms);
686: *PetscMatlabEnginePutArray(*e,*m,*n,a,ms);
687: FREECHAR(s,ms);
688: }
690: void PETSC_STDCALL petscmatlabenginegetarray_(PetscMatlabEngine *e,PetscInt *m,PetscInt *n,PetscScalar *a,
691: CHAR s PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len))
692: {
693: char *ms;
694: FIXCHAR(s,len,ms);
695: *PetscMatlabEngineGetArray(*e,*m,*n,a,ms);
696: FREECHAR(s,ms);
697: }
699: #endif
700: /*
701: EXTERN int PetscMatlabEngineGetOutput(PetscMatlabEngine,char **);
702: EXTERN int PetscMatlabEnginePrintOutput(PetscMatlabEngine,FILE*);
703: */