Actual source code: zsys.c
1: /*$Id: zsys.c,v 1.97 2001/10/04 18:48:06 balay Exp $*/
3: #include src/fortran/custom/zpetsc.h
4: #include petscsys.h
5: #include petscmatlab.h
7: #ifdef PETSC_HAVE_FORTRAN_CAPS
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 petscfopen_ petscfopen
78: #define petscfclose_ petscfclose
79: #define petscfprintf_ petscfprintf
80: #define petscsynchronizedfprintf_ petscsynchronizedfprintf
81: #define petscprintf_ petscprintf
82: #define petscsynchronizedprintf_ petscsynchronizedprintf
83: #define petscsynchronizedflush_ petscsynchronizedflush
84: #define petscmatlabenginecreate_ petscmatlabenginecreate
85: #define petscmatlabenginedestroy_ petscmatlabenginedestroy
86: #define petscmatlabengineevaluate_ petscmatlabengineevaluate
87: #define petscmatlabenginegetoutput_ petscmatlabenginegetoutput
88: #define petscmatlabengineprintoutput_ petscmatlabengineprintoutput
89: #define petscmatlabengineput_ petscmatlabengineput
90: #define petscmatlabengineget_ petscmatlabengineget
91: #define petscmatlabengineputarray_ petscmatlabengineputarray
92: #define petscmatlabenginegetarray_ petscmatlabenginegetarray
93: #define petscoffsetfortran_ petscoffsetfortran
94: #define chkmemfortran_ chkmemfortran
95: #define petscobjectgetnewtag_ petscobjectgetnewtag
96: #define petsccommgetnewtag_ petsccommgetnewtag
97: #define petscsplitownership_ petscsplitownership
98: #define petscsplitownershipblock_ petscsplitownershipblock
99: #define petscbarrier_ petscbarrier
100: #define petscstrncpy_ petscstrncpy
101: #define petscfixfilename_ petscfixfilename
102: #define petsctrlog_ petsctrlog
103: #define petscattachdebugger_ petscattachdebugger
104: #define petscobjectsetname_ petscobjectsetname
105: #define petscobjectdestroy_ petscobjectdestroy
106: #define petscobjectgetcomm_ petscobjectgetcomm
107: #define petscobjectgetname_ petscobjectgetname
108: #define petscgetflops_ petscgetflops
109: #define petscerror_ petscerror
110: #define petscrandomcreate_ petscrandomcreate
111: #define petscrandomdestroy_ petscrandomdestroy
112: #define petscrandomgetvalue_ petscrandomgetvalue
113: #define petsctrvalid_ petsctrvalid
114: #define petscrealview_ petscrealview
115: #define petscintview_ petscintview
116: #define petscsequentialphasebegin_ petscsequentialphasebegin
117: #define petscsequentialphaseend_ petscsequentialphaseend
118: #define petscmemcpy_ petscmemcpy
119: #define petsctrdump_ petsctrdump
120: #define petsctrlogdump_ petsctlogrdump
121: #define petscmemzero_ petscmemzero
122: #define petscbinaryopen_ petscbinaryopen
123: #define petscbinaryread_ petscbinaryread
124: #define petscbinarywrite_ petscbinarywrite
125: #define petscbinaryclose_ petscbinaryclose
126: #define petscbinaryseek_ petscbinaryseek
127: #define petscsynchronizedflush_ petscsynchronizedflush
128: #define petscfptrap_ petscfptrap
129: #define petscgetcputime_ petscgetcputime
130: #define petscgetresidentsetsize_ petscgetresidentsetsize
131: #define petsctrspace_ petsctrspace
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
147: EXTERN_C_BEGIN
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*,int* PETSC_END_LEN(len1) PETSC_END_LEN(len2) PETSC_END_LEN(len3) PETSC_END_LEN(len4));
149: EXTERN_C_END
151: /* These are not extern C because they are passed into non-extern C user level functions */
152: static int ourerrorhandler(int line,const char *fun,const char *file,const char *dir,int n,int p,const char *mess,void *ctx)
153: {
154: int 0,len1,len2,len3,len4;
155:
156: PetscStrlen(fun,&len1);
157: PetscStrlen(file,&len2);
158: PetscStrlen(dir,&len3);
159: PetscStrlen(mess,&len4);
161: #if defined(PETSC_USES_CPTOFCD)
162: {
163: CHAR fun_c,file_c,dir_c,mess_c;
165: fun_c = _cptofcd(fun,len1);
166: file_c = _cptofcd(file,len2);
167: dir_c = _cptofcd(dir,len3);
168: mess_c = _cptofcd(mess,len4);
169: (*f2)(&line,fun_c,file_c,dir_c,&n,&p,mess_c,ctx,&ierr,len1,len2,len3,len4);
171: }
172: #elif defined(PETSC_HAVE_FORTRAN_MIXED_STR_ARG)
173: (*f2)(&line,fun,len1,file,len2,dir,len3,&n,&p,mess,len4,ctx,&ierr);
174: #else
175: (*f2)(&line,fun,file,dir,&n,&p,mess,ctx,&ierr,len1,len2,len3,len4);
176: #endif
177: return ierr;
178: }
180: EXTERN_C_BEGIN
181: /*
182: integer i_x,i_y,shift
183: Vec x,y
184: PetscScalar v_x(1),v_y(1)
186: call VecGetArray(x,v_x,i_x,ierr)
187: if (x .eq. y) then
188: call PetscOffsetFortran(y_v,x_v,shift,ierr)
189: i_y = i_x + shift
190: else
191: call VecGetArray(y,v_y,i_y,ierr)
192: endif
193: */
195: /*
196: These are not usually called from Fortran but allow Fortran users
197: to transparently set these monitors from .F code
198:
199: functions, hence no STDCALL
200: */
201: void petsctracebackerrorhandler_(int *line,const char *fun,const char *file,const char *dir,int *n,int *p,const char *mess,void *ctx,int *ierr)
202: {
203: *PetscTraceBackErrorHandler(*line,fun,file,dir,*n,*p,mess,ctx);
204: }
206: void petscaborterrorhandler_(int *line,const char *fun,const char *file,const char *dir,int *n,int *p,const char *mess,void *ctx,int *ierr)
207: {
208: *PetscAbortErrorHandler(*line,fun,file,dir,*n,*p,mess,ctx);
209: }
211: void petscattachdebuggererrorhandler_(int *line,const char *fun,const char *file,const char *dir,int *n,int *p,const char *mess,void *ctx,int *ierr)
212: {
213: *PetscAttachDebuggerErrorHandler(*line,fun,file,dir,*n,*p,mess,ctx);
214: }
216: void petscemacsclienterrorhandler_(int *line,const char *fun,const char *file,const char *dir,int *n,int *p,const char *mess,void *ctx,int *ierr)
217: {
218: *PetscEmacsClientErrorHandler(*line,fun,file,dir,*n,*p,mess,ctx);
219: }
221: void petscignoreerrorhandler_(int *line,const char *fun,const char *file,const char *dir,int *n,int *p,const char *mess,void *ctx,int *ierr)
222: {
223: *PetscIgnoreErrorHandler(*line,fun,file,dir,*n,*p,mess,ctx);
224: }
226: 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*,int* PETSC_END_LEN(len1) PETSC_END_LEN(len2) PETSC_END_LEN(len3) PETSC_END_LEN(len4)),void *ctx,int *ierr)
227: {
228: if ((void(*)(void))handler == (void(*)(void))petsctracebackerrorhandler_) {
229: *PetscPushErrorHandler(PetscTraceBackErrorHandler,0);
230: } else {
231: f2 = handler;
232: *PetscPushErrorHandler(ourerrorhandler,ctx);
233: }
234: }
236: void PETSC_STDCALL petscpoperrorhandler_(int *ierr)
237: {
238: *PetscPopErrorHandler();
239: }
241: void PETSC_STDCALL petscviewerasciisettab_(PetscViewer *viewer,int *tabs,int *ierr)
242: {
243: *PetscViewerASCIISetTab(*viewer,*tabs);
244: }
246: void PETSC_STDCALL petscviewerasciipushtab_(PetscViewer *viewer,int *ierr)
247: {
248: *PetscViewerASCIIPushTab(*viewer);
249: }
251: void PETSC_STDCALL petscviewerasciipoptab_(PetscViewer *viewer,int *ierr)
252: {
253: *PetscViewerASCIIPopTab(*viewer);
254: }
256: void PETSC_STDCALL petscviewerasciiusetabs_(PetscViewer *viewer,PetscTruth *flg,int *ierr)
257: {
258: *PetscViewerASCIIUseTabs(*viewer,*flg);
259: }
261: void PETSC_STDCALL petscviewerasciiprintf_(PetscViewer *viewer,CHAR str PETSC_MIXED_LEN(len1),int *ierr PETSC_END_LEN(len1))
262: {
263: char *c1;
265: FIXCHAR(str,len1,c1);
266: *PetscViewerASCIIPrintf(*viewer,c1);
267: FREECHAR(str,c1);
268: }
270: void PETSC_STDCALL petscviewerasciisynchronizedprintf_(PetscViewer *viewer,CHAR str PETSC_MIXED_LEN(len1),int *ierr PETSC_END_LEN(len1))
271: {
272: char *c1;
274: FIXCHAR(str,len1,c1);
275: *PetscViewerASCIISynchronizedPrintf(*viewer,c1);
276: FREECHAR(str,c1);
277: }
279: void PETSC_STDCALL petsctrspace_(PetscLogDouble *space,PetscLogDouble *fr,PetscLogDouble *maxs, int *ierr)
280: {
281: *PetscTrSpace(space,fr,maxs);
282: }
284: void PETSC_STDCALL petscgetresidentsetsize_(PetscLogDouble *foo, int *ierr)
285: {
286: *PetscGetResidentSetSize(foo);
287: }
289: void PETSC_STDCALL petscoffsetfortran_(PetscScalar *x,PetscScalar *y,int *shift,int *ierr)
290: {
291: *0;
292: *shift = y - x;
293: }
295: void PETSC_STDCALL petscgetcputime_(PetscLogDouble *t, int *ierr)
296: {
297: *PetscGetCPUTime(t);
298: }
300: void PETSC_STDCALL petscfopen_(MPI_Comm *comm,CHAR fname PETSC_MIXED_LEN(len1),CHAR fmode PETSC_MIXED_LEN(len2),
301: FILE **file,int *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2))
302: {
303: char *c1,*c2;
305: FIXCHAR(fname,len1,c1);
306: FIXCHAR(fmode,len2,c2);
307: *PetscFOpen((MPI_Comm)PetscToPointerComm(*comm),c1,c2,file);
308: FREECHAR(fname,c1);
309: FREECHAR(fmode,c2);
310: }
311:
312: void PETSC_STDCALL petscfclose_(MPI_Comm *comm,FILE **file,int *ierr)
313: {
314: *PetscFClose((MPI_Comm)PetscToPointerComm(*comm),*file);
315: }
317: void PETSC_STDCALL petscsynchronizedflush_(MPI_Comm *comm,int *ierr)
318: {
319: *PetscSynchronizedFlush((MPI_Comm)PetscToPointerComm(*comm));
320: }
322: void PETSC_STDCALL petscfprintf_(MPI_Comm *comm,FILE **file,CHAR fname PETSC_MIXED_LEN(len1),int *ierr PETSC_END_LEN(len1))
323: {
324: char *c1;
326: FIXCHAR(fname,len1,c1);
327: *PetscFPrintf((MPI_Comm)PetscToPointerComm(*comm),*file,c1);
328: FREECHAR(fname,c1);
329: }
331: void PETSC_STDCALL petscprintf_(MPI_Comm *comm,CHAR fname PETSC_MIXED_LEN(len1),int *ierr PETSC_END_LEN(len1))
332: {
333: char *c1;
335: FIXCHAR(fname,len1,c1);
336: *PetscPrintf((MPI_Comm)PetscToPointerComm(*comm),c1);
337: FREECHAR(fname,c1);
338: }
340: void PETSC_STDCALL petscsynchronizedfprintf_(MPI_Comm *comm,FILE **file,CHAR fname PETSC_MIXED_LEN(len1),int *ierr PETSC_END_LEN(len1))
341: {
342: char *c1;
344: FIXCHAR(fname,len1,c1);
345: *PetscSynchronizedFPrintf((MPI_Comm)PetscToPointerComm(*comm),*file,c1);
346: FREECHAR(fname,c1);
347: }
349: void PETSC_STDCALL petscsynchronizedprintf_(MPI_Comm *comm,CHAR fname PETSC_MIXED_LEN(len1),int *ierr PETSC_END_LEN(len1))
350: {
351: char *c1;
353: FIXCHAR(fname,len1,c1);
354: *PetscSynchronizedPrintf((MPI_Comm)PetscToPointerComm(*comm),c1);
355: FREECHAR(fname,c1);
356: }
358: void PETSC_STDCALL petscsetfptrap_(PetscFPTrap *flag,int *ierr)
359: {
360: *PetscSetFPTrap(*flag);
361: }
363: void PETSC_STDCALL petscobjectgetnewtag_(PetscObject *obj,int *tag,int *ierr)
364: {
365: *PetscObjectGetNewTag(*obj,tag);
366: }
368: void PETSC_STDCALL petsccommgetnewtag_(MPI_Comm *comm,int *tag,int *ierr)
369: {
370: *PetscCommGetNewTag((MPI_Comm)PetscToPointerComm(*comm),tag);
371: }
373: void PETSC_STDCALL petscsplitownershipblock_(MPI_Comm *comm,int *bs,int *n,int *N,int *ierr)
374: {
375: *PetscSplitOwnershipBlock((MPI_Comm)PetscToPointerComm(*comm),*bs,n,N);
376: }
377: void PETSC_STDCALL petscsplitownership_(MPI_Comm *comm,int *n,int *N,int *ierr)
378: {
379: *PetscSplitOwnership((MPI_Comm)PetscToPointerComm(*comm),n,N);
380: }
382: void PETSC_STDCALL petscbarrier_(PetscObject *obj,int *ierr)
383: {
384: *PetscBarrier(*obj);
385: }
387: void PETSC_STDCALL petscstrncpy_(CHAR s1 PETSC_MIXED_LEN(len1),CHAR s2 PETSC_MIXED_LEN(len2),int *n,
388: int *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2))
389: {
390: char *t1,*t2;
391: int m;
393: #if defined(PETSC_USES_CPTOFCD)
394: t1 = _fcdtocp(s1);
395: t2 = _fcdtocp(s2);
396: m = *n; if (_fcdlen(s1) < m) m = _fcdlen(s1); if (_fcdlen(s2) < m) m = _fcdlen(s2);
397: #else
398: t1 = s1;
399: t2 = s2;
400: m = *n; if (len1 < m) m = len1; if (len2 < m) m = len2;
401: #endif
402: *PetscStrncpy(t1,t2,m);
403: }
405: void PETSC_STDCALL petscfixfilename_(CHAR filein PETSC_MIXED_LEN(len1),CHAR fileout PETSC_MIXED_LEN(len2),
406: int *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2))
407: {
408: int i,n;
409: char *in,*out;
411: #if defined(PETSC_USES_CPTOFCD)
412: in = _fcdtocp(filein);
413: out = _fcdtocp(fileout);
414: n = _fcdlen (filein);
415: #else
416: in = filein;
417: out = fileout;
418: n = len1;
419: #endif
421: for (i=0; i<n; i++) {
422: #if defined(PARCH_win32)
423: if (in[i] == '/') out[i] = '\\';
424: #else
425: if (in[i] == '\\') out[i] = '/';
426: #endif
427: else out[i] = in[i];
428: }
429: out[i] = 0;
430: }
432: void PETSC_STDCALL petscbinaryopen_(CHAR name PETSC_MIXED_LEN(len),int *type,int *fd,
433: int *ierr PETSC_END_LEN(len))
434: {
435: char *c1;
437: FIXCHAR(name,len,c1);
438: *PetscBinaryOpen(c1,*type,fd);
439: FREECHAR(name,c1);
440: }
442: void PETSC_STDCALL petscbinarywrite_(int *fd,void *p,int *n,PetscDataType *type,int *istemp,int *ierr)
443: {
444: *PetscBinaryWrite(*fd,p,*n,*type,*istemp);
445: }
447: void PETSC_STDCALL petscbinaryread_(int *fd,void *p,int *n,PetscDataType *type,int *ierr)
448: {
449: *PetscBinaryRead(*fd,p,*n,*type);
450: }
452: void PETSC_STDCALL petscbinaryseek_(int *fd,int *size,PetscBinarySeekType *whence,int *offset,int *ierr)
453: {
454: *PetscBinarySeek(*fd,*size,*whence,offset);
455: }
457: void PETSC_STDCALL petscbinaryclose_(int *fd,int *ierr)
458: {
459: *PetscBinaryClose(*fd);
460: }
462: /* ---------------------------------------------------------------------------------*/
463: void PETSC_STDCALL petscmemzero_(void *a,int *n,int *ierr)
464: {
465: *PetscMemzero(a,*n);
466: }
468: void PETSC_STDCALL petsctrdump_(int *ierr)
469: {
470: *PetscTrDump(stdout);
471: }
472: void PETSC_STDCALL petsctrlogdump_(int *ierr)
473: {
474: *PetscTrLogDump(stdout);
475: }
477: void PETSC_STDCALL petscmemcpy_(int *out,int *in,int *length,int *ierr)
478: {
479: *PetscMemcpy(out,in,*length);
480: }
482: void PETSC_STDCALL petsctrlog_(int *ierr)
483: {
484: *PetscTrLog();
485: }
487: /*
488: This version does not do a malloc
489: */
490: static char FIXCHARSTRING[1024];
491: #if defined(PETSC_USES_CPTOFCD)
492: #include <fortran.h>
494: #define CHAR _fcd
495: #define FIXCHARNOMALLOC(a,n,b) \
496: { \
497: b = _fcdtocp(a); \
498: n = _fcdlen (a); \
499: if (b == PETSC_NULL_CHARACTER_Fortran) { \
500: b = 0; \
501: } else { \
502: while((n > 0) && (b[n-1] == ' ')) n--; \
503: b = FIXCHARSTRING; \
504: *PetscStrncpy(b,_fcdtocp(a),n); \
505: if (*ierr) return; \
506: b[n] = 0; \
507: } \
508: }
510: #else
512: #define CHAR char*
513: #define FIXCHARNOMALLOC(a,n,b) \
514: {\
515: if (a == PETSC_NULL_CHARACTER_Fortran) { \
516: b = a = 0; \
517: } else { \
518: while((n > 0) && (a[n-1] == ' ')) n--; \
519: if (a[n] != 0) { \
520: b = FIXCHARSTRING; \
521: *PetscStrncpy(b,a,n); \
522: if (*ierr) return; \
523: b[n] = 0; \
524: } else b = a;\
525: } \
526: }
528: #endif
530: void PETSC_STDCALL chkmemfortran_(int *line,CHAR file PETSC_MIXED_LEN(len),int *ierr PETSC_END_LEN(len))
531: {
532: char *c1;
534: FIXCHARNOMALLOC(file,len,c1);
535: *PetscTrValid(*line,"Userfunction",c1," ");
536: }
538: void PETSC_STDCALL petsctrvalid_(int *ierr)
539: {
540: *PetscTrValid(0,"Unknown Fortran",0,0);
541: }
543: void PETSC_STDCALL petscrandomgetvalue_(PetscRandom *r,PetscScalar *val,int *ierr)
544: {
545: *PetscRandomGetValue(*r,val);
546: }
549: void PETSC_STDCALL petscobjectgetname_(PetscObject *obj,CHAR name PETSC_MIXED_LEN(len),
550: int *ierr PETSC_END_LEN(len))
551: {
552: char *tmp;
553: *PetscObjectGetName(*obj,&tmp);
554: #if defined(PETSC_USES_CPTOFCD)
555: {
556: char *t = _fcdtocp(name);
557: int len1 = _fcdlen(name);
558: *PetscStrncpy(t,tmp,len1);if (*ierr) return;
559: }
560: #else
561: *PetscStrncpy(name,tmp,len);if (*ierr) return;
562: #endif
563: }
565: void PETSC_STDCALL petscobjectdestroy_(PetscObject *obj,int *ierr)
566: {
567: *PetscObjectDestroy(*obj);
568: }
570: void PETSC_STDCALL petscobjectgetcomm_(PetscObject *obj,int *comm,int *ierr)
571: {
572: MPI_Comm c;
573: *PetscObjectGetComm(*obj,&c);
574: *(int*)comm = PetscFromPointerComm(c);
575: }
577: void PETSC_STDCALL petscattachdebugger_(int *ierr)
578: {
579: *PetscAttachDebugger();
580: }
582: void PETSC_STDCALL petscobjectsetname_(PetscObject *obj,CHAR name PETSC_MIXED_LEN(len),
583: int *ierr PETSC_END_LEN(len))
584: {
585: char *t1;
587: FIXCHAR(name,len,t1);
588: *PetscObjectSetName(*obj,t1);
589: FREECHAR(name,t1);
590: }
592: void PETSC_STDCALL petscerror_(int *number,int *p,CHAR message PETSC_MIXED_LEN(len),
593: int *ierr PETSC_END_LEN(len))
594: {
595: char *t1;
596: FIXCHAR(message,len,t1);
597: *PetscError(-1,0,0,0,*number,*p,t1);
598: FREECHAR(message,t1);
599: }
601: void PETSC_STDCALL petscgetflops_(PetscLogDouble *d,int *ierr)
602: {
603: #if defined(PETSC_USE_LOG)
604: *PetscGetFlops(d);
605: #else
606: 0;
607: *d = 0.0;
608: #endif
609: }
611: void PETSC_STDCALL petscrandomcreate_(MPI_Comm *comm,PetscRandomType *type,PetscRandom *r,int *ierr)
612: {
613: *PetscRandomCreate((MPI_Comm)PetscToPointerComm(*comm),*type,r);
614: }
616: void PETSC_STDCALL petscrandomdestroy_(PetscRandom *r,int *ierr)
617: {
618: *PetscRandomDestroy(*r);
619: }
621: void PETSC_STDCALL petscrealview_(int *n,PetscReal *d,int *viwer,int *ierr)
622: {
623: *PetscRealView(*n,d,0);
624: }
626: void PETSC_STDCALL petscintview_(int *n,int *d,int *viwer,int *ierr)
627: {
628: *PetscIntView(*n,d,0);
629: }
631: void PETSC_STDCALL petscsequentialphasebegin_(MPI_Comm *comm,int *ng,int *ierr){
632: *PetscSequentialPhaseBegin(
633: (MPI_Comm)PetscToPointerComm(*comm),*ng);
634: }
635: void PETSC_STDCALL petscsequentialphaseend_(MPI_Comm *comm,int *ng,int *ierr){
636: *PetscSequentialPhaseEnd(
637: (MPI_Comm)PetscToPointerComm(*comm),*ng);
638: }
641: #if defined(PETSC_HAVE_MATLAB) && !defined(PETSC_USE_COMPLEX) && !defined(PETSC_USE_SINGLE)
643: void PETSC_STDCALL petscmatlabenginecreate_(MPI_Comm *comm,CHAR m PETSC_MIXED_LEN(len),PetscMatlabEngine *e,
644: int *ierr PETSC_END_LEN(len))
645: {
646: char *ms;
648: FIXCHAR(m,len,ms);
649: *PetscMatlabEngineCreate((MPI_Comm)PetscToPointerComm(*comm),ms,e);
650: FREECHAR(m,ms);
651: }
653: void PETSC_STDCALL petscmatlabenginedestroy_(PetscMatlabEngine *e,int *ierr)
654: {
655: *PetscMatlabEngineDestroy(*e);
656: }
658: void PETSC_STDCALL petscmatlabengineevaluate_(PetscMatlabEngine *e,CHAR m PETSC_MIXED_LEN(len),
659: int *ierr PETSC_END_LEN(len))
660: {
661: char *ms;
662: FIXCHAR(m,len,ms);
663: *PetscMatlabEngineEvaluate(*e,ms);
664: FREECHAR(m,ms);
665: }
667: void PETSC_STDCALL petscmatlabengineput_(PetscMatlabEngine *e,PetscObject *o,int *ierr)
668: {
669: *PetscMatlabEnginePut(*e,*o);
670: }
672: void PETSC_STDCALL petscmatlabengineget_(PetscMatlabEngine *e,PetscObject *o,int *ierr)
673: {
674: *PetscMatlabEngineGet(*e,*o);
675: }
677: void PETSC_STDCALL petscmatlabengineputarray_(PetscMatlabEngine *e,int *m,int *n,PetscScalar *a,
678: CHAR s PETSC_MIXED_LEN(len),int *ierr PETSC_END_LEN(len))
679: {
680: char *ms;
681: FIXCHAR(s,len,ms);
682: *PetscMatlabEnginePutArray(*e,*m,*n,a,ms);
683: FREECHAR(s,ms);
684: }
686: void PETSC_STDCALL petscmatlabenginegetarray_(PetscMatlabEngine *e,int *m,int *n,PetscScalar *a,
687: CHAR s PETSC_MIXED_LEN(len),int *ierr PETSC_END_LEN(len))
688: {
689: char *ms;
690: FIXCHAR(s,len,ms);
691: *PetscMatlabEngineGetArray(*e,*m,*n,a,ms);
692: FREECHAR(s,ms);
693: }
695: #endif
696: /*
697: EXTERN int PetscMatlabEngineGetOutput(PetscMatlabEngine,char **);
698: EXTERN int PetscMatlabEnginePrintOutput(PetscMatlabEngine,FILE*);
699: */
701: EXTERN_C_END