Actual source code: zsys.c
2: #include src/fortran/custom/zpetsc.h
3: #include petscsys.h
4: #include petscmatlab.h
6: void *PETSCNULLPOINTERADDRESS = PETSC_NULL;
8: #ifdef PETSC_HAVE_FORTRAN_CAPS
9: #define petscpopsignalhandler_ PETSCPOPSIGNALHANDLER
10: #define petscgetcputime_ PETSCGETCPUTIME
11: #define petscfopen_ PETSCFOPEN
12: #define petscfclose_ PETSCFCLOSE
13: #define petscfprintf_ PETSCFPRINTF
14: #define petscsynchronizedfprintf_ PETSCSYNCHRONIZEDFPRINTF
15: #define petscprintf_ PETSCPRINTF
16: #define petscsynchronizedprintf_ PETSCSYNCHRONIZEDPRINTF
17: #define petscsynchronizedflush_ PETSCSYNCHRONIZEDFLUSH
18: #define chkmemfortran_ CHKMEMFORTRAN
19: #define petscattachdebugger_ PETSCATTACHDEBUGGER
20: #define petscobjectsetname_ PETSCOBJECTSETNAME
21: #define petscobjectdestroy_ PETSCOBJECTDESTROY
22: #define petscobjectgetcomm_ PETSCOBJECTGETCOMM
23: #define petscobjectgetname_ PETSCOBJECTGETNAME
24: #define petscgetflops_ PETSCGETFLOPS
25: #define petscerror_ PETSCERROR
26: #define petscrandomcreate_ PETSCRANDOMCREATE
27: #define petscrandomdestroy_ PETSCRANDOMDESTROY
28: #define petscrandomgetvalue_ PETSCRANDOMGETVALUE
29: #define petscmallocvalidate_ PETSCMALLOCVALIDATE
30: #define petscrealview_ PETSCREALVIEW
31: #define petscintview_ PETSCINTVIEW
32: #define petscsequentialphasebegin_ PETSCSEQUENTIALPHASEBEGIN
33: #define petscsequentialphaseend_ PETSCSEQUENTIALPHASEEND
34: #define petsctrlog_ PETSCTRLOG
35: #define petscmemcpy_ PETSCMEMCPY
36: #define petscmallocdump_ PETSCMALLOCDUMP
37: #define petscmallocdumplog_ PETSCMALLOCDUMPLOG
38: #define petscmemzero_ PETSCMEMZERO
39: #define petscbinaryopen_ PETSCBINARYOPEN
40: #define petscbinaryread_ PETSCBINARYREAD
41: #define petscbinarywrite_ PETSCBINARYWRITE
42: #define petscbinaryclose_ PETSCBINARYCLOSE
43: #define petscbinaryseek_ PETSCBINARYSEEK
44: #define petscfixfilename_ PETSCFIXFILENAME
45: #define petscstrncpy_ PETSCSTRNCPY
46: #define petscbarrier_ PETSCBARRIER
47: #define petscsynchronizedflush_ PETSCSYNCHRONIZEDFLUSH
48: #define petscsplitownership_ PETSCSPLITOWNERSHIP
49: #define petscsplitownershipblock_ PETSCSPLITOWNERSHIPBLOCK
50: #define petscobjectgetnewtag_ PETSCOBJECTGETNEWTAG
51: #define petsccommgetnewtag_ PETSCCOMMGETNEWTAG
52: #define petscfptrap_ PETSCFPTRAP
53: #define petscoffsetfortran_ PETSCOFFSETFORTRAN
54: #define petscmatlabenginecreate_ PETSCMATLABENGINECREATE
55: #define petscmatlabenginedestroy_ PETSCMATLABENGINEDESTROY
56: #define petscmatlabengineevaluate_ PETSCMATLABENGINEEVALUATE
57: #define petscmatlabenginegetoutput_ PETSCMATLABENGINEGETOUTPUT
58: #define petscmatlabengineprintoutput_ PETSCMATLABENGINEPRINTOUTPUT
59: #define petscmatlabengineput_ PETSCMATLABENGINEPUT
60: #define petscmatlabengineget_ PETSCMATLABENGINEGET
61: #define petscmatlabengineputarray_ PETSCMATLABENGINEPUTARRAY
62: #define petscmatlabenginegetarray_ PETSCMATLABENGINEGETARRAY
63: #define petscgetmemoryusage _ PETSCGETMEMORYUSAGE
64: #define petscviewerasciiprintf_ PETSCVIEWERASCIIPRINTF
65: #define petscviewerasciisynchronizedprintf_ PETSCVIEWERASCIISYNCHRONIZEDPRINTF
66: #define petscviewerasciisettab_ PETSCVIEWERASCIISETTAB
67: #define petscviewerasciipushtab_ PETSCVIEWERASCIIPUSHTAB
68: #define petscviewerasciipoptab_ PETSCVIEWERASCIIPOPTAB
69: #define petscviewerasciiusetabs_ PETSCVIEWERASCIIUSETABS
70: #define petscpusherrorhandler_ PETSCPUSHERRORHANDLER
71: #define petscpoperrorhandler_ PETSCPOPERRORHANDLER
72: #define petsctracebackerrorhandler_ PETSCTRACEBACKERRORHANDLER
73: #define petscaborterrorhandler_ PETSCABORTERRORHANDLER
74: #define petscignoreerrorhandler_ PETSCIGNOREERRORHANDLER
75: #define petscemacsclienterrorhandler_ PETSCEMACSCLIENTERRORHANDLER
76: #define petscattachdebuggererrorhandler_ PETSCATTACHDEBUGGERERRORHANDLER
77: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
78: #define petscpopsignalhandler_ petscpopsignalhandler
79: #define petscfopen_ petscfopen
80: #define petscfclose_ petscfclose
81: #define petscfprintf_ petscfprintf
82: #define petscsynchronizedfprintf_ petscsynchronizedfprintf
83: #define petscprintf_ petscprintf
84: #define petscsynchronizedprintf_ petscsynchronizedprintf
85: #define petscsynchronizedflush_ petscsynchronizedflush
86: #define petscmatlabenginecreate_ petscmatlabenginecreate
87: #define petscmatlabenginedestroy_ petscmatlabenginedestroy
88: #define petscmatlabengineevaluate_ petscmatlabengineevaluate
89: #define petscmatlabenginegetoutput_ petscmatlabenginegetoutput
90: #define petscmatlabengineprintoutput_ petscmatlabengineprintoutput
91: #define petscmatlabengineput_ petscmatlabengineput
92: #define petscmatlabengineget_ petscmatlabengineget
93: #define petscmatlabengineputarray_ petscmatlabengineputarray
94: #define petscmatlabenginegetarray_ petscmatlabenginegetarray
95: #define petscoffsetfortran_ petscoffsetfortran
96: #define chkmemfortran_ chkmemfortran
97: #define petscobjectgetnewtag_ petscobjectgetnewtag
98: #define petsccommgetnewtag_ petsccommgetnewtag
99: #define petscsplitownership_ petscsplitownership
100: #define petscsplitownershipblock_ petscsplitownershipblock
101: #define petscbarrier_ petscbarrier
102: #define petscstrncpy_ petscstrncpy
103: #define petscfixfilename_ petscfixfilename
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 petscmallocvalidate_ petscmallocvalidate
115: #define petscrealview_ petscrealview
116: #define petscintview_ petscintview
117: #define petscsequentialphasebegin_ petscsequentialphasebegin
118: #define petscsequentialphaseend_ petscsequentialphaseend
119: #define petscmemcpy_ petscmemcpy
120: #define petscmallocdump_ petscmallocdump
121: #define petscmallocdumplog_ petscmallocdumplog
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 petscgetmemoryusage_ petscgetmemoryusage
132: #define petscviewerasciiprintf_ petscviewerasciiprintf
133: #define petscviewerasciisynchronizedprintf_ petscviewerasciisynchronizedprintf
134: #define petscviewerasciisettab_ petscviewerasciisettab
135: #define petscviewerasciipushtab_ petscviewerasciipushtab
136: #define petscviewerasciipoptab_ petscviewerasciipoptab
137: #define petscviewerasciiusetabs_ petscviewerasciiusetabs
138: #define petscpusherrorhandler_ petscpusherrorhandler
139: #define petscpoperrorhandler_ petscpoperrorhandler
140: #define petsctracebackerrorhandler_ petsctracebackerrorhandler
141: #define petscaborterrorhandler_ petscaborterrorhandler
142: #define petscignoreerrorhandler_ petscignoreerrorhandler
143: #define petscemacsclienterrorhandler_ petscemacsclienterrorhandler
144: #define petscattachdebuggererrorhandler_ petscattachdebuggererrorhandler
145: #endif
148: 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));
152: static PetscErrorCode ourerrorhandler(int line,const char *fun,const char *file,const char *dir,int n,int p,const char *mess,void *ctx)
153: {
154: PetscErrorCode 0;
155: size_t len1,len2,len3,len4;
156: int l1,l2,l3,l4;
158: PetscStrlen(fun,&len1); l1 = (int)len1;
159: PetscStrlen(file,&len2);l2 = (int)len2;
160: PetscStrlen(dir,&len3);l3 = (int)len3;
161: PetscStrlen(mess,&len4);l4 = (int)len4;
163: #if defined(PETSC_USES_CPTOFCD)
164: {
165: CHAR fun_c,file_c,dir_c,mess_c;
167: fun_c = _cptofcd(fun,len1);
168: file_c = _cptofcd(file,len2);
169: dir_c = _cptofcd(dir,len3);
170: mess_c = _cptofcd(mess,len4);
171: (*f2)(&line,fun_c,file_c,dir_c,&n,&p,mess_c,ctx,&ierr,len1,len2,len3,len4);
173: }
174: #elif defined(PETSC_HAVE_FORTRAN_MIXED_STR_ARG)
175: (*f2)(&line,fun,l1,file,l2,dir,l3,&n,&p,mess,l4,ctx,&ierr);
176: #else
177: (*f2)(&line,fun,file,dir,&n,&p,mess,ctx,&ierr,l1,l2,l3,l4);
178: #endif
179: return ierr;
180: }
183: /*
184: integer i_x,i_y,shift
185: Vec x,y
186: PetscScalar v_x(1),v_y(1)
188: call VecGetArray(x,v_x,i_x,ierr)
189: if (x .eq. y) then
190: call PetscOffsetFortran(y_v,x_v,shift,ierr)
191: i_y = i_x + shift
192: else
193: call VecGetArray(y,v_y,i_y,ierr)
194: endif
195: */
197: /*
198: These are not usually called from Fortran but allow Fortran users
199: to transparently set these monitors from .F code
200:
201: functions, hence no STDCALL
202: */
203: void petsctracebackerrorhandler_(int *line,const char *fun,const char *file,const char *dir,int *n,int *p,const char *mess,void *ctx,PetscErrorCode *ierr)
204: {
205: *PetscTraceBackErrorHandler(*line,fun,file,dir,*n,*p,mess,ctx);
206: }
208: void petscaborterrorhandler_(int *line,const char *fun,const char *file,const char *dir,int *n,int *p,const char *mess,void *ctx,PetscErrorCode *ierr)
209: {
210: *PetscAbortErrorHandler(*line,fun,file,dir,*n,*p,mess,ctx);
211: }
213: void petscattachdebuggererrorhandler_(int *line,const char *fun,const char *file,const char *dir,int *n,int *p,const char *mess,void *ctx,PetscErrorCode *ierr)
214: {
215: *PetscAttachDebuggerErrorHandler(*line,fun,file,dir,*n,*p,mess,ctx);
216: }
218: void petscemacsclienterrorhandler_(int *line,const char *fun,const char *file,const char *dir,int *n,int *p,const char *mess,void *ctx,PetscErrorCode *ierr)
219: {
220: *PetscEmacsClientErrorHandler(*line,fun,file,dir,*n,*p,mess,ctx);
221: }
223: void petscignoreerrorhandler_(int *line,const char *fun,const char *file,const char *dir,int *n,int *p,const char *mess,void *ctx,PetscErrorCode *ierr)
224: {
225: *PetscIgnoreErrorHandler(*line,fun,file,dir,*n,*p,mess,ctx);
226: }
228: 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)
229: {
230: if ((void(*)(void))handler == (void(*)(void))petsctracebackerrorhandler_) {
231: *PetscPushErrorHandler(PetscTraceBackErrorHandler,0);
232: } else {
233: f2 = handler;
234: *PetscPushErrorHandler(ourerrorhandler,ctx);
235: }
236: }
238: void PETSC_STDCALL petscpopsignalhandler_(PetscErrorCode *ierr)
239: {
240: *PetscPopSignalHandler();
241: }
243: void PETSC_STDCALL petscpoperrorhandler_(PetscErrorCode *ierr)
244: {
245: *PetscPopErrorHandler();
246: }
248: void PETSC_STDCALL petscviewerasciisettab_(PetscViewer *viewer,PetscInt *tabs,PetscErrorCode *ierr)
249: {
250: *PetscViewerASCIISetTab(*viewer,*tabs);
251: }
253: void PETSC_STDCALL petscviewerasciipushtab_(PetscViewer *viewer,PetscErrorCode *ierr)
254: {
255: *PetscViewerASCIIPushTab(*viewer);
256: }
258: void PETSC_STDCALL petscviewerasciipoptab_(PetscViewer *viewer,PetscErrorCode *ierr)
259: {
260: *PetscViewerASCIIPopTab(*viewer);
261: }
263: void PETSC_STDCALL petscviewerasciiusetabs_(PetscViewer *viewer,PetscTruth *flg,PetscErrorCode *ierr)
264: {
265: *PetscViewerASCIIUseTabs(*viewer,*flg);
266: }
268: void PETSC_STDCALL petscviewerasciiprintf_(PetscViewer *viewer,CHAR str PETSC_MIXED_LEN(len1),PetscErrorCode *ierr PETSC_END_LEN(len1))
269: {
270: char *c1;
272: FIXCHAR(str,len1,c1);
273: *PetscViewerASCIIPrintf(*viewer,c1);
274: FREECHAR(str,c1);
275: }
277: void PETSC_STDCALL petscviewerasciisynchronizedprintf_(PetscViewer *viewer,CHAR str PETSC_MIXED_LEN(len1),PetscErrorCode *ierr PETSC_END_LEN(len1))
278: {
279: char *c1;
281: FIXCHAR(str,len1,c1);
282: *PetscViewerASCIISynchronizedPrintf(*viewer,c1);
283: FREECHAR(str,c1);
284: }
286: void PETSC_STDCALL petscmemorygetcurrentusage_(PetscLogDouble *foo, PetscErrorCode *ierr)
287: {
288: *PetscMemoryGetCurrentUsage(foo);
289: }
291: void PETSC_STDCALL petscmemorygetmaximumusage_(PetscLogDouble *foo, PetscErrorCode *ierr)
292: {
293: *PetscMemoryGetMaximumUsage(foo);
294: }
296: void PETSC_STDCALL petscoffsetfortran_(PetscScalar *x,PetscScalar *y,size_t *shift,PetscErrorCode *ierr)
297: {
298: *0;
299: *shift = y - x;
300: }
302: void PETSC_STDCALL petscgetcputime_(PetscLogDouble *t, PetscErrorCode *ierr)
303: {
304: *PetscGetCPUTime(t);
305: }
307: void PETSC_STDCALL petscfopen_(MPI_Comm *comm,CHAR fname PETSC_MIXED_LEN(len1),CHAR fmode PETSC_MIXED_LEN(len2),
308: FILE **file,PetscErrorCode *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2))
309: {
310: char *c1,*c2;
312: FIXCHAR(fname,len1,c1);
313: FIXCHAR(fmode,len2,c2);
314: *PetscFOpen((MPI_Comm)PetscToPointerComm(*comm),c1,c2,file);
315: FREECHAR(fname,c1);
316: FREECHAR(fmode,c2);
317: }
318:
319: void PETSC_STDCALL petscfclose_(MPI_Comm *comm,FILE **file,PetscErrorCode *ierr)
320: {
321: *PetscFClose((MPI_Comm)PetscToPointerComm(*comm),*file);
322: }
324: void PETSC_STDCALL petscsynchronizedflush_(MPI_Comm *comm,PetscErrorCode *ierr)
325: {
326: *PetscSynchronizedFlush((MPI_Comm)PetscToPointerComm(*comm));
327: }
329: void PETSC_STDCALL petscfprintf_(MPI_Comm *comm,FILE **file,CHAR fname PETSC_MIXED_LEN(len1),PetscErrorCode *ierr PETSC_END_LEN(len1))
330: {
331: char *c1;
333: FIXCHAR(fname,len1,c1);
334: *PetscFPrintf((MPI_Comm)PetscToPointerComm(*comm),*file,c1);
335: FREECHAR(fname,c1);
336: }
338: void PETSC_STDCALL petscprintf_(MPI_Comm *comm,CHAR fname PETSC_MIXED_LEN(len1),PetscErrorCode *ierr PETSC_END_LEN(len1))
339: {
340: char *c1;
342: FIXCHAR(fname,len1,c1);
343: *PetscPrintf((MPI_Comm)PetscToPointerComm(*comm),c1);
344: FREECHAR(fname,c1);
345: }
347: void PETSC_STDCALL petscsynchronizedfprintf_(MPI_Comm *comm,FILE **file,CHAR fname PETSC_MIXED_LEN(len1),PetscErrorCode *ierr PETSC_END_LEN(len1))
348: {
349: char *c1;
351: FIXCHAR(fname,len1,c1);
352: *PetscSynchronizedFPrintf((MPI_Comm)PetscToPointerComm(*comm),*file,c1);
353: FREECHAR(fname,c1);
354: }
356: void PETSC_STDCALL petscsynchronizedprintf_(MPI_Comm *comm,CHAR fname PETSC_MIXED_LEN(len1),PetscErrorCode *ierr PETSC_END_LEN(len1))
357: {
358: char *c1;
360: FIXCHAR(fname,len1,c1);
361: *PetscSynchronizedPrintf((MPI_Comm)PetscToPointerComm(*comm),c1);
362: FREECHAR(fname,c1);
363: }
365: void PETSC_STDCALL petscsetfptrap_(PetscFPTrap *flag,PetscErrorCode *ierr)
366: {
367: *PetscSetFPTrap(*flag);
368: }
370: void PETSC_STDCALL petscobjectgetnewtag_(PetscObject *obj,PetscMPIInt *tag,PetscErrorCode *ierr)
371: {
372: *PetscObjectGetNewTag(*obj,tag);
373: }
375: void PETSC_STDCALL petsccommgetnewtag_(MPI_Comm *comm,PetscMPIInt *tag,PetscErrorCode *ierr)
376: {
377: *PetscCommGetNewTag((MPI_Comm)PetscToPointerComm(*comm),tag);
378: }
380: void PETSC_STDCALL petscsplitownershipblock_(MPI_Comm *comm,PetscInt *bs,PetscInt *n,PetscInt *N,PetscErrorCode *ierr)
381: {
382: *PetscSplitOwnershipBlock((MPI_Comm)PetscToPointerComm(*comm),*bs,n,N);
383: }
384: void PETSC_STDCALL petscsplitownership_(MPI_Comm *comm,PetscInt *n,PetscInt *N,PetscErrorCode *ierr)
385: {
386: *PetscSplitOwnership((MPI_Comm)PetscToPointerComm(*comm),n,N);
387: }
389: void PETSC_STDCALL petscbarrier_(PetscObject *obj,PetscErrorCode *ierr)
390: {
391: *PetscBarrier(*obj);
392: }
394: void PETSC_STDCALL petscstrncpy_(CHAR s1 PETSC_MIXED_LEN(len1),CHAR s2 PETSC_MIXED_LEN(len2),int *n,
395: PetscErrorCode *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2))
396: {
397: char *t1,*t2;
398: int m;
400: #if defined(PETSC_USES_CPTOFCD)
401: t1 = _fcdtocp(s1);
402: t2 = _fcdtocp(s2);
403: m = *n; if (_fcdlen(s1) < m) m = _fcdlen(s1); if (_fcdlen(s2) < m) m = _fcdlen(s2);
404: #else
405: t1 = s1;
406: t2 = s2;
407: m = *n; if (len1 < m) m = len1; if (len2 < m) m = len2;
408: #endif
409: *PetscStrncpy(t1,t2,m);
410: }
412: void PETSC_STDCALL petscfixfilename_(CHAR filein PETSC_MIXED_LEN(len1),CHAR fileout PETSC_MIXED_LEN(len2),
413: PetscErrorCode *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2))
414: {
415: PetscInt i,n;
416: char *in,*out;
418: #if defined(PETSC_USES_CPTOFCD)
419: in = _fcdtocp(filein);
420: out = _fcdtocp(fileout);
421: n = _fcdlen (filein);
422: #else
423: in = filein;
424: out = fileout;
425: n = len1;
426: #endif
428: for (i=0; i<n; i++) {
429: if (in[i] == PETSC_REPLACE_DIR_SEPARATOR) out[i] = PETSC_DIR_SEPARATOR;
430: else out[i] = in[i];
431: }
432: out[i] = 0;
433: }
435: void PETSC_STDCALL petscbinaryopen_(CHAR name PETSC_MIXED_LEN(len),PetscViewerFileType *type,int *fd,
436: PetscErrorCode *ierr PETSC_END_LEN(len))
437: {
438: char *c1;
440: FIXCHAR(name,len,c1);
441: *PetscBinaryOpen(c1,*type,fd);
442: FREECHAR(name,c1);
443: }
445: void PETSC_STDCALL petscbinarywrite_(int *fd,void *p,PetscInt *n,PetscDataType *type,PetscTruth *istemp,PetscErrorCode *ierr)
446: {
447: *PetscBinaryWrite(*fd,p,*n,*type,*istemp);
448: }
450: void PETSC_STDCALL petscbinaryread_(int *fd,void *p,PetscInt *n,PetscDataType *type,PetscErrorCode *ierr)
451: {
452: *PetscBinaryRead(*fd,p,*n,*type);
453: }
455: void PETSC_STDCALL petscbinaryseek_(int *fd,PetscInt *size,PetscBinarySeekType *whence,off_t *offset,PetscErrorCode *ierr)
456: {
457: *PetscBinarySeek(*fd,*size,*whence,offset);
458: }
460: void PETSC_STDCALL petscbinaryclose_(int *fd,PetscErrorCode *ierr)
461: {
462: *PetscBinaryClose(*fd);
463: }
465: /* ---------------------------------------------------------------------------------*/
466: void PETSC_STDCALL petscmemzero_(void *a,PetscInt *n,PetscErrorCode *ierr)
467: {
468: *PetscMemzero(a,*n);
469: }
471: void PETSC_STDCALL petscmallocdump_(PetscErrorCode *ierr)
472: {
473: *PetscMallocDump(stdout);
474: }
475: void PETSC_STDCALL petscmallocdumplog_(PetscErrorCode *ierr)
476: {
477: *PetscMallocDumpLog(stdout);
478: }
480: void PETSC_STDCALL petscmemcpy_(int *out,int *in,int *length,PetscErrorCode *ierr)
481: {
482: *PetscMemcpy(out,in,*length);
483: }
485: /*
486: This version does not do a malloc
487: */
488: static char FIXCHARSTRING[1024];
489: #if defined(PETSC_USES_CPTOFCD)
490: #include <fortran.h>
492: #define CHAR _fcd
493: #define FIXCHARNOMALLOC(a,n,b) \
494: { \
495: b = _fcdtocp(a); \
496: n = _fcdlen (a); \
497: if (b == PETSC_NULL_CHARACTER_Fortran) { \
498: b = 0; \
499: } else { \
500: while((n > 0) && (b[n-1] == ' ')) n--; \
501: b = FIXCHARSTRING; \
502: *PetscStrncpy(b,_fcdtocp(a),n); \
503: if (*ierr) return; \
504: b[n] = 0; \
505: } \
506: }
508: #else
510: #define CHAR char*
511: #define FIXCHARNOMALLOC(a,n,b) \
512: {\
513: if (a == PETSC_NULL_CHARACTER_Fortran) { \
514: b = a = 0; \
515: } else { \
516: while((n > 0) && (a[n-1] == ' ')) n--; \
517: if (a[n] != 0) { \
518: b = FIXCHARSTRING; \
519: *PetscStrncpy(b,a,n); \
520: if (*ierr) return; \
521: b[n] = 0; \
522: } else b = a;\
523: } \
524: }
526: #endif
528: void PETSC_STDCALL chkmemfortran_(int *line,CHAR file PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len))
529: {
530: char *c1;
532: FIXCHARNOMALLOC(file,len,c1);
533: *PetscMallocValidate(*line,"Userfunction",c1," ");
534: }
536: void PETSC_STDCALL petscmallocvalidate_(PetscErrorCode *ierr)
537: {
538: *PetscMallocValidate(0,"Unknown Fortran",0,0);
539: }
541: void PETSC_STDCALL petscrandomgetvalue_(PetscRandom *r,PetscScalar *val,PetscErrorCode *ierr)
542: {
543: *PetscRandomGetValue(*r,val);
544: }
547: void PETSC_STDCALL petscobjectgetname_(PetscObject *obj,CHAR name PETSC_MIXED_LEN(len),
548: PetscErrorCode *ierr PETSC_END_LEN(len))
549: {
550: const char *tmp;
551: *PetscObjectGetName(*obj,&tmp);
552: #if defined(PETSC_USES_CPTOFCD)
553: {
554: char *t = _fcdtocp(name);
555: int len1 = _fcdlen(name);
556: *PetscStrncpy(t,tmp,len1);if (*ierr) return;
557: }
558: #else
559: *PetscStrncpy(name,tmp,len);if (*ierr) return;
560: #endif
561: }
563: void PETSC_STDCALL petscobjectdestroy_(PetscObject *obj,PetscErrorCode *ierr)
564: {
565: *PetscObjectDestroy(*obj);
566: }
568: void PETSC_STDCALL petscobjectgetcomm_(PetscObject *obj,int *comm,PetscErrorCode *ierr)
569: {
570: MPI_Comm c;
571: *PetscObjectGetComm(*obj,&c);
572: *(int*)comm = PetscFromPointerComm(c);
573: }
575: void PETSC_STDCALL petscattachdebugger_(PetscErrorCode *ierr)
576: {
577: *PetscAttachDebugger();
578: }
580: void PETSC_STDCALL petscobjectsetname_(PetscObject *obj,CHAR name PETSC_MIXED_LEN(len),
581: PetscErrorCode *ierr PETSC_END_LEN(len))
582: {
583: char *t1;
585: FIXCHAR(name,len,t1);
586: *PetscObjectSetName(*obj,t1);
587: FREECHAR(name,t1);
588: }
590: void PETSC_STDCALL petscerror_(int *number,int *p,CHAR message PETSC_MIXED_LEN(len),
591: PetscErrorCode *ierr PETSC_END_LEN(len))
592: {
593: char *t1;
594: FIXCHAR(message,len,t1);
595: *PetscError(-1,0,0,0,*number,*p,t1);
596: FREECHAR(message,t1);
597: }
599: void PETSC_STDCALL petscgetflops_(PetscLogDouble *d,PetscErrorCode *ierr)
600: {
601: #if defined(PETSC_USE_LOG)
602: *PetscGetFlops(d);
603: #else
604: 0;
605: *d = 0.0;
606: #endif
607: }
609: void PETSC_STDCALL petscrandomcreate_(MPI_Comm *comm,PetscRandomType *type,PetscRandom *r,PetscErrorCode *ierr)
610: {
611: *PetscRandomCreate((MPI_Comm)PetscToPointerComm(*comm),*type,r);
612: }
614: void PETSC_STDCALL petscrandomdestroy_(PetscRandom *r,PetscErrorCode *ierr)
615: {
616: *PetscRandomDestroy(*r);
617: }
619: void PETSC_STDCALL petscrealview_(PetscInt *n,PetscReal *d,int *viwer,PetscErrorCode *ierr)
620: {
621: *PetscRealView(*n,d,0);
622: }
624: void PETSC_STDCALL petscintview_(PetscInt *n,PetscInt *d,int *viwer,PetscErrorCode *ierr)
625: {
626: *PetscIntView(*n,d,0);
627: }
629: void PETSC_STDCALL petscsequentialphasebegin_(MPI_Comm *comm,PetscInt *ng,PetscErrorCode *ierr){
630: *PetscSequentialPhaseBegin(
631: (MPI_Comm)PetscToPointerComm(*comm),*ng);
632: }
633: void PETSC_STDCALL petscsequentialphaseend_(MPI_Comm *comm,PetscInt *ng,PetscErrorCode *ierr){
634: *PetscSequentialPhaseEnd(
635: (MPI_Comm)PetscToPointerComm(*comm),*ng);
636: }
639: #if defined(PETSC_HAVE_MATLAB) && !defined(PETSC_USE_COMPLEX) && !defined(PETSC_USE_SINGLE) && !defined(PETSC_USE_MAT_SINGLE)
641: void PETSC_STDCALL petscmatlabenginecreate_(MPI_Comm *comm,CHAR m PETSC_MIXED_LEN(len),PetscMatlabEngine *e,
642: PetscErrorCode *ierr PETSC_END_LEN(len))
643: {
644: char *ms;
646: FIXCHAR(m,len,ms);
647: *PetscMatlabEngineCreate((MPI_Comm)PetscToPointerComm(*comm),ms,e);
648: FREECHAR(m,ms);
649: }
651: void PETSC_STDCALL petscmatlabenginedestroy_(PetscMatlabEngine *e,PetscErrorCode *ierr)
652: {
653: *PetscMatlabEngineDestroy(*e);
654: }
656: void PETSC_STDCALL petscmatlabengineevaluate_(PetscMatlabEngine *e,CHAR m PETSC_MIXED_LEN(len),
657: PetscErrorCode *ierr PETSC_END_LEN(len))
658: {
659: char *ms;
660: FIXCHAR(m,len,ms);
661: *PetscMatlabEngineEvaluate(*e,ms);
662: FREECHAR(m,ms);
663: }
665: void PETSC_STDCALL petscmatlabengineput_(PetscMatlabEngine *e,PetscObject *o,PetscErrorCode *ierr)
666: {
667: *PetscMatlabEnginePut(*e,*o);
668: }
670: void PETSC_STDCALL petscmatlabengineget_(PetscMatlabEngine *e,PetscObject *o,PetscErrorCode *ierr)
671: {
672: *PetscMatlabEngineGet(*e,*o);
673: }
675: void PETSC_STDCALL petscmatlabengineputarray_(PetscMatlabEngine *e,PetscInt *m,PetscInt *n,PetscScalar *a,
676: CHAR s PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len))
677: {
678: char *ms;
679: FIXCHAR(s,len,ms);
680: *PetscMatlabEnginePutArray(*e,*m,*n,a,ms);
681: FREECHAR(s,ms);
682: }
684: void PETSC_STDCALL petscmatlabenginegetarray_(PetscMatlabEngine *e,PetscInt *m,PetscInt *n,PetscScalar *a,
685: CHAR s PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len))
686: {
687: char *ms;
688: FIXCHAR(s,len,ms);
689: *PetscMatlabEngineGetArray(*e,*m,*n,a,ms);
690: FREECHAR(s,ms);
691: }
693: #endif
694: /*
695: EXTERN int PetscMatlabEngineGetOutput(PetscMatlabEngine,char **);
696: EXTERN int PetscMatlabEnginePrintOutput(PetscMatlabEngine,FILE*);
697: */