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 petscengine.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: /*
149: integer i_x,i_y,shift
150: Vec x,y
151: PetscScalar v_x(1),v_y(1)
153: call VecGetArray(x,v_x,i_x,ierr)
154: if (x .eq. y) then
155: call PetscOffsetFortran(y_v,x_v,shift,ierr)
156: i_y = i_x + shift
157: else
158: call VecGetArray(y,v_y,i_y,ierr)
159: endif
160: */
162: /*
163: These are not usually called from Fortran but allow Fortran users
164: to transparently set these monitors from .F code
165:
166: functions, hence no STDCALL
167: */
168: void petsctracebackerrorhandler_(int *line,char *fun,char *file,char *dir,int *n,int *p,char *mess,void *ctx,int *ierr)
169: {
170: *PetscTraceBackErrorHandler(*line,fun,file,dir,*n,*p,mess,ctx);
171: }
173: void petscaborterrorhandler_(int *line,char *fun,char *file,char *dir,int *n,int *p,char *mess,void *ctx,int *ierr)
174: {
175: *PetscAbortErrorHandler(*line,fun,file,dir,*n,*p,mess,ctx);
176: }
178: void petscattachdebuggererrorhandler_(int *line,char *fun,char *file,char *dir,int *n,int *p,char *mess,void *ctx,int *ierr)
179: {
180: *PetscAttachDebuggerErrorHandler(*line,fun,file,dir,*n,*p,mess,ctx);
181: }
183: void petscemacsclienterrorhandler_(int *line,char *fun,char *file,char *dir,int *n,int *p,char *mess,void *ctx,int *ierr)
184: {
185: *PetscEmacsClientErrorHandler(*line,fun,file,dir,*n,*p,mess,ctx);
186: }
188: void petscignoreerrorhandler_(int *line,char *fun,char *file,char *dir,int *n,int *p,char *mess,void *ctx,int *ierr)
189: {
190: *PetscIgnoreErrorHandler(*line,fun,file,dir,*n,*p,mess,ctx);
191: }
193: static void (PETSC_STDCALL *f2)(int*,CHAR PETSC_MIXED_LEN(len1),CHAR PETSC_MIXED_LEN(len2),CHAR PETSC_MIXED_LEN(len3),int*,int*,CHAR PETSC_MIXED_LEN(len4),void*,int* PETSC_END_LEN(len1) PETSC_END_LEN(len2) PETSC_END_LEN(len3) PETSC_END_LEN(len4));
194: static int ourerrorhandler(int line,char *fun,char *file,char *dir,int n,int p,char *mess,void *ctx)
195: {
196: int 0,len1,len2,len3,len4;
197:
198: PetscStrlen(fun,&len1);
199: PetscStrlen(file,&len2);
200: PetscStrlen(dir,&len3);
201: PetscStrlen(mess,&len4);
203: #if defined(PETSC_USES_CPTOFCD)
204: {
205: CHAR fun_c,file_c,dir_c,ness_c;
207: fun_c = _cptofcd(fun,len1);
208: file_c = _cptofcd(file,len2);
209: dir_c = _cptofcd(dir,len3);
210: mess_c = _cptofcd(mess,len4);
211: (*f2)(&line_c,fun_c,file_c,dir,&n,&p,mess_c,ctx,&ierr,len1,len2,len3,len4);
213: }
214: #elif defined(PETSC_USE_FORTRAN_MIXED_STR_ARG)
215: (*f2)(&line,fun,len1,file,len2,dir,len3,&n,&p,mess,len4,ctx,&ierr);
216: #else
217: (*f2)(&line,fun,file,dir,&n,&p,mess,ctx,&ierr,len1,len2,len3,len4);
218: #endif
219: return ierr;
220: }
222: void PETSC_STDCALL petscpusherrorhandler_(void (PETSC_STDCALL *handler)(int*,CHAR PETSC_MIXED_LEN(len1),CHAR PETSC_MIXED_LEN(len2),CHAR PETSC_MIXED_LEN(len3),int*,int*,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)
223: {
224: if ((void(*)(void))handler == (void(*)(void))petsctracebackerrorhandler_) {
225: *PetscPushErrorHandler(PetscTraceBackErrorHandler,0);
226: } else {
227: f2 = handler;
228: *PetscPushErrorHandler(ourerrorhandler,ctx);
229: }
230: }
232: void PETSC_STDCALL petscpoperrorhandler_(int *ierr)
233: {
234: *PetscPopErrorHandler();
235: }
237: void PETSC_STDCALL petscviewerasciisettab_(PetscViewer *viewer,int *tabs,int *ierr)
238: {
239: *PetscViewerASCIISetTab(*viewer,*tabs);
240: }
242: void PETSC_STDCALL petscviewerasciipushtab_(PetscViewer *viewer,int *ierr)
243: {
244: *PetscViewerASCIIPushTab(*viewer);
245: }
247: void PETSC_STDCALL petscviewerasciipoptab_(PetscViewer *viewer,int *ierr)
248: {
249: *PetscViewerASCIIPopTab(*viewer);
250: }
252: void PETSC_STDCALL petscviewerasciiusetabs_(PetscViewer *viewer,PetscTruth *flg,int *ierr)
253: {
254: *PetscViewerASCIIUseTabs(*viewer,*flg);
255: }
257: void PETSC_STDCALL petscviewerasciiprintf_(PetscViewer *viewer,CHAR str PETSC_MIXED_LEN(len1),int *ierr PETSC_END_LEN(len1))
258: {
259: char *c1;
261: FIXCHAR(str,len1,c1);
262: *PetscViewerASCIIPrintf(*viewer,c1);
263: FREECHAR(str,c1);
264: }
266: void PETSC_STDCALL petscviewerasciisynchronizedprintf_(PetscViewer *viewer,CHAR str PETSC_MIXED_LEN(len1),int *ierr PETSC_END_LEN(len1))
267: {
268: char *c1;
270: FIXCHAR(str,len1,c1);
271: *PetscViewerASCIISynchronizedPrintf(*viewer,c1);
272: FREECHAR(str,c1);
273: }
275: void PETSC_STDCALL petsctrspace_(PetscLogDouble *space,PetscLogDouble *fr,PetscLogDouble *maxs, int *ierr)
276: {
277: *PetscTrSpace(space,fr,maxs);
278: }
280: void PETSC_STDCALL petscgetresidentsetsize_(PetscLogDouble *foo, int *ierr)
281: {
282: *PetscGetResidentSetSize(foo);
283: }
285: void PETSC_STDCALL petscoffsetfortran_(PetscScalar *x,PetscScalar *y,int *shift,int *ierr)
286: {
287: *0;
288: *shift = y - x;
289: }
291: void PETSC_STDCALL petscgetcputime_(PetscLogDouble *t, int *ierr)
292: {
293: *PetscGetCPUTime(t);
294: }
296: void PETSC_STDCALL petscfopen_(MPI_Comm *comm,CHAR fname PETSC_MIXED_LEN(len1),CHAR fmode PETSC_MIXED_LEN(len2),
297: FILE **file,int *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2))
298: {
299: char *c1,*c2;
301: FIXCHAR(fname,len1,c1);
302: FIXCHAR(fmode,len2,c2);
303: *PetscFOpen((MPI_Comm)PetscToPointerComm(*comm),c1,c2,file);
304: FREECHAR(fname,c1);
305: FREECHAR(fmode,c2);
306: }
307:
308: void PETSC_STDCALL petscfclose_(MPI_Comm *comm,FILE **file,int *ierr)
309: {
310: *PetscFClose((MPI_Comm)PetscToPointerComm(*comm),*file);
311: }
313: void PETSC_STDCALL petscsynchronizedflush_(MPI_Comm *comm,int *ierr)
314: {
315: *PetscSynchronizedFlush((MPI_Comm)PetscToPointerComm(*comm));
316: }
318: void PETSC_STDCALL petscfprintf_(MPI_Comm *comm,FILE **file,CHAR fname PETSC_MIXED_LEN(len1),int *ierr PETSC_END_LEN(len1))
319: {
320: char *c1;
322: FIXCHAR(fname,len1,c1);
323: *PetscFPrintf((MPI_Comm)PetscToPointerComm(*comm),*file,c1);
324: FREECHAR(fname,c1);
325: }
327: void PETSC_STDCALL petscprintf_(MPI_Comm *comm,CHAR fname PETSC_MIXED_LEN(len1),int *ierr PETSC_END_LEN(len1))
328: {
329: char *c1;
331: FIXCHAR(fname,len1,c1);
332: *PetscPrintf((MPI_Comm)PetscToPointerComm(*comm),c1);
333: FREECHAR(fname,c1);
334: }
336: void PETSC_STDCALL petscsynchronizedfprintf_(MPI_Comm *comm,FILE **file,CHAR fname PETSC_MIXED_LEN(len1),int *ierr PETSC_END_LEN(len1))
337: {
338: char *c1;
340: FIXCHAR(fname,len1,c1);
341: *PetscSynchronizedFPrintf((MPI_Comm)PetscToPointerComm(*comm),*file,c1);
342: FREECHAR(fname,c1);
343: }
345: void PETSC_STDCALL petscsynchronizedprintf_(MPI_Comm *comm,CHAR fname PETSC_MIXED_LEN(len1),int *ierr PETSC_END_LEN(len1))
346: {
347: char *c1;
349: FIXCHAR(fname,len1,c1);
350: *PetscSynchronizedPrintf((MPI_Comm)PetscToPointerComm(*comm),c1);
351: FREECHAR(fname,c1);
352: }
354: void PETSC_STDCALL petscsetfptrap_(PetscFPTrap *flag,int *ierr)
355: {
356: *PetscSetFPTrap(*flag);
357: }
359: void PETSC_STDCALL petscobjectgetnewtag_(PetscObject *obj,int *tag,int *ierr)
360: {
361: *PetscObjectGetNewTag(*obj,tag);
362: }
364: void PETSC_STDCALL petsccommgetnewtag_(MPI_Comm *comm,int *tag,int *ierr)
365: {
366: *PetscCommGetNewTag((MPI_Comm)PetscToPointerComm(*comm),tag);
367: }
369: void PETSC_STDCALL petscsplitownershipblock_(MPI_Comm *comm,int *bs,int *n,int *N,int *ierr)
370: {
371: *PetscSplitOwnershipBlock((MPI_Comm)PetscToPointerComm(*comm),*bs,n,N);
372: }
373: void PETSC_STDCALL petscsplitownership_(MPI_Comm *comm,int *n,int *N,int *ierr)
374: {
375: *PetscSplitOwnership((MPI_Comm)PetscToPointerComm(*comm),n,N);
376: }
378: void PETSC_STDCALL petscbarrier_(PetscObject *obj,int *ierr)
379: {
380: *PetscBarrier(*obj);
381: }
383: void PETSC_STDCALL petscstrncpy_(CHAR s1 PETSC_MIXED_LEN(len1),CHAR s2 PETSC_MIXED_LEN(len2),int *n,
384: int *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2))
385: {
386: char *t1,*t2;
387: int m;
389: #if defined(PETSC_USES_CPTOFCD)
390: t1 = _fcdtocp(s1);
391: t2 = _fcdtocp(s2);
392: m = *n; if (_fcdlen(s1) < m) m = _fcdlen(s1); if (_fcdlen(s2) < m) m = _fcdlen(s2);
393: #else
394: t1 = s1;
395: t2 = s2;
396: m = *n; if (len1 < m) m = len1; if (len2 < m) m = len2;
397: #endif
398: *PetscStrncpy(t1,t2,m);
399: }
401: void PETSC_STDCALL petscfixfilename_(CHAR filein PETSC_MIXED_LEN(len1),CHAR fileout PETSC_MIXED_LEN(len2),
402: int *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2))
403: {
404: int i,n;
405: char *in,*out;
407: #if defined(PETSC_USES_CPTOFCD)
408: in = _fcdtocp(filein);
409: out = _fcdtocp(fileout);
410: n = _fcdlen (filein);
411: #else
412: in = filein;
413: out = fileout;
414: n = len1;
415: #endif
417: for (i=0; i<n; i++) {
418: #if defined(PARCH_win32)
419: if (in[i] == '/') out[i] = '\\';
420: #else
421: if (in[i] == '\\') out[i] = '/';
422: #endif
423: else out[i] = in[i];
424: }
425: out[i] = 0;
426: }
428: void PETSC_STDCALL petscbinaryopen_(CHAR name PETSC_MIXED_LEN(len),int *type,int *fd,
429: int *ierr PETSC_END_LEN(len))
430: {
431: char *c1;
433: FIXCHAR(name,len,c1);
434: *PetscBinaryOpen(c1,*type,fd);
435: FREECHAR(name,c1);
436: }
438: void PETSC_STDCALL petscbinarywrite_(int *fd,void *p,int *n,PetscDataType *type,int *istemp,int *ierr)
439: {
440: *PetscBinaryWrite(*fd,p,*n,*type,*istemp);
441: }
443: void PETSC_STDCALL petscbinaryread_(int *fd,void *p,int *n,PetscDataType *type,int *ierr)
444: {
445: *PetscBinaryRead(*fd,p,*n,*type);
446: }
448: void PETSC_STDCALL petscbinaryseek_(int *fd,int *size,PetscBinarySeekType *whence,int *offset,int *ierr)
449: {
450: *PetscBinarySeek(*fd,*size,*whence,offset);
451: }
453: void PETSC_STDCALL petscbinaryclose_(int *fd,int *ierr)
454: {
455: *PetscBinaryClose(*fd);
456: }
458: /* ---------------------------------------------------------------------------------*/
459: void PETSC_STDCALL petscmemzero_(void *a,int *n,int *ierr)
460: {
461: *PetscMemzero(a,*n);
462: }
464: void PETSC_STDCALL petsctrdump_(int *ierr)
465: {
466: *PetscTrDump(stdout);
467: }
468: void PETSC_STDCALL petsctrlogdump_(int *ierr)
469: {
470: *PetscTrLogDump(stdout);
471: }
473: void PETSC_STDCALL petscmemcpy_(int *out,int *in,int *length,int *ierr)
474: {
475: *PetscMemcpy(out,in,*length);
476: }
478: void PETSC_STDCALL petsctrlog_(int *ierr)
479: {
480: *PetscTrLog();
481: }
483: /*
484: This version does not do a malloc
485: */
486: static char FIXCHARSTRING[1024];
487: #if defined(PETSC_USES_CPTOFCD)
488: #include <fortran.h>
490: #define CHAR _fcd
491: #define FIXCHARNOMALLOC(a,n,b) \
492: { \
493: b = _fcdtocp(a); \
494: n = _fcdlen (a); \
495: if (b == PETSC_NULL_CHARACTER_Fortran) { \
496: b = 0; \
497: } else { \
498: while((n > 0) && (b[n-1] == ' ')) n--; \
499: b = FIXCHARSTRING; \
500: *PetscStrncpy(b,_fcdtocp(a),n); \
501: if (*ierr) return; \
502: b[n] = 0; \
503: } \
504: }
506: #else
508: #define CHAR char*
509: #define FIXCHARNOMALLOC(a,n,b) \
510: {\
511: if (a == PETSC_NULL_CHARACTER_Fortran) { \
512: b = a = 0; \
513: } else { \
514: while((n > 0) && (a[n-1] == ' ')) n--; \
515: if (a[n] != 0) { \
516: b = FIXCHARSTRING; \
517: *PetscStrncpy(b,a,n); \
518: if (*ierr) return; \
519: b[n] = 0; \
520: } else b = a;\
521: } \
522: }
524: #endif
526: void PETSC_STDCALL chkmemfortran_(int *line,CHAR file PETSC_MIXED_LEN(len),int *ierr PETSC_END_LEN(len))
527: {
528: char *c1;
530: FIXCHARNOMALLOC(file,len,c1);
531: *PetscTrValid(*line,"Userfunction",c1," ");
532: }
534: void PETSC_STDCALL petsctrvalid_(int *ierr)
535: {
536: *PetscTrValid(0,"Unknown Fortran",0,0);
537: }
539: void PETSC_STDCALL petscrandomgetvalue_(PetscRandom *r,PetscScalar *val,int *ierr)
540: {
541: *PetscRandomGetValue(*r,val);
542: }
545: void PETSC_STDCALL petscobjectgetname_(PetscObject *obj,CHAR name PETSC_MIXED_LEN(len),
546: int *ierr PETSC_END_LEN(len))
547: {
548: char *tmp;
549: *PetscObjectGetName(*obj,&tmp);
550: #if defined(PETSC_USES_CPTOFCD)
551: {
552: char *t = _fcdtocp(name);
553: int len1 = _fcdlen(name);
554: *PetscStrncpy(t,tmp,len1);if (*ierr) return;
555: }
556: #else
557: *PetscStrncpy(name,tmp,len);if (*ierr) return;
558: #endif
559: }
561: void PETSC_STDCALL petscobjectdestroy_(PetscObject *obj,int *ierr)
562: {
563: *PetscObjectDestroy(*obj);
564: }
566: void PETSC_STDCALL petscobjectgetcomm_(PetscObject *obj,int *comm,int *ierr)
567: {
568: MPI_Comm c;
569: *PetscObjectGetComm(*obj,&c);
570: *(int*)comm = PetscFromPointerComm(c);
571: }
573: void PETSC_STDCALL petscattachdebugger_(int *ierr)
574: {
575: *PetscAttachDebugger();
576: }
578: void PETSC_STDCALL petscobjectsetname_(PetscObject *obj,CHAR name PETSC_MIXED_LEN(len),
579: int *ierr PETSC_END_LEN(len))
580: {
581: char *t1;
583: FIXCHAR(name,len,t1);
584: *PetscObjectSetName(*obj,t1);
585: FREECHAR(name,t1);
586: }
588: void PETSC_STDCALL petscerror_(int *number,int *p,CHAR message PETSC_MIXED_LEN(len),
589: int *ierr PETSC_END_LEN(len))
590: {
591: char *t1;
592: FIXCHAR(message,len,t1);
593: *PetscError(-1,0,0,0,*number,*p,t1);
594: FREECHAR(message,t1);
595: }
597: void PETSC_STDCALL petscgetflops_(PetscLogDouble *d,int *ierr)
598: {
599: #if defined(PETSC_USE_LOG)
600: *PetscGetFlops(d);
601: #else
602: 0;
603: *d = 0.0;
604: #endif
605: }
607: void PETSC_STDCALL petscrandomcreate_(MPI_Comm *comm,PetscRandomType *type,PetscRandom *r,int *ierr)
608: {
609: *PetscRandomCreate((MPI_Comm)PetscToPointerComm(*comm),*type,r);
610: }
612: void PETSC_STDCALL petscrandomdestroy_(PetscRandom *r,int *ierr)
613: {
614: *PetscRandomDestroy(*r);
615: }
617: void PETSC_STDCALL petscrealview_(int *n,PetscReal *d,int *viwer,int *ierr)
618: {
619: *PetscRealView(*n,d,0);
620: }
622: void PETSC_STDCALL petscintview_(int *n,int *d,int *viwer,int *ierr)
623: {
624: *PetscIntView(*n,d,0);
625: }
627: void PETSC_STDCALL petscsequentialphasebegin_(MPI_Comm *comm,int *ng,int *ierr){
628: *PetscSequentialPhaseBegin(
629: (MPI_Comm)PetscToPointerComm(*comm),*ng);
630: }
631: void PETSC_STDCALL petscsequentialphaseend_(MPI_Comm *comm,int *ng,int *ierr){
632: *PetscSequentialPhaseEnd(
633: (MPI_Comm)PetscToPointerComm(*comm),*ng);
634: }
637: #if defined(PETSC_HAVE_MATLAB_ENGINE) && !defined(PETSC_USE_COMPLEX) && !defined(PETSC_USE_SINGLE)
639: void PETSC_STDCALL petscmatlabenginecreate_(MPI_Comm *comm,CHAR m PETSC_MIXED_LEN(len),PetscMatlabEngine *e,
640: int *ierr PETSC_END_LEN(len))
641: {
642: char *ms;
644: FIXCHAR(m,len,ms);
645: *PetscMatlabEngineCreate((MPI_Comm)PetscToPointerComm(*comm),ms,e);
646: FREECHAR(m,ms);
647: }
649: void PETSC_STDCALL petscmatlabenginedestroy_(PetscMatlabEngine *e,int *ierr)
650: {
651: *PetscMatlabEngineDestroy(*e);
652: }
654: void PETSC_STDCALL petscmatlabengineevaluate_(PetscMatlabEngine *e,CHAR m PETSC_MIXED_LEN(len),
655: int *ierr PETSC_END_LEN(len))
656: {
657: char *ms;
658: FIXCHAR(m,len,ms);
659: *PetscMatlabEngineEvaluate(*e,ms);
660: FREECHAR(m,ms);
661: }
663: void PETSC_STDCALL petscmatlabengineput_(PetscMatlabEngine *e,PetscObject *o,int *ierr)
664: {
665: *PetscMatlabEnginePut(*e,*o);
666: }
668: void PETSC_STDCALL petscmatlabengineget_(PetscMatlabEngine *e,PetscObject *o,int *ierr)
669: {
670: *PetscMatlabEngineGet(*e,*o);
671: }
673: void PETSC_STDCALL petscmatlabengineputarray_(PetscMatlabEngine *e,int *m,int *n,PetscScalar *a,
674: CHAR s PETSC_MIXED_LEN(len),int *ierr PETSC_END_LEN(len))
675: {
676: char *ms;
677: FIXCHAR(s,len,ms);
678: *PetscMatlabEnginePutArray(*e,*m,*n,a,ms);
679: FREECHAR(s,ms);
680: }
682: void PETSC_STDCALL petscmatlabenginegetarray_(PetscMatlabEngine *e,int *m,int *n,PetscScalar *a,
683: CHAR s PETSC_MIXED_LEN(len),int *ierr PETSC_END_LEN(len))
684: {
685: char *ms;
686: FIXCHAR(s,len,ms);
687: *PetscMatlabEngineGetArray(*e,*m,*n,a,ms);
688: FREECHAR(s,ms);
689: }
691: #endif
692: /*
693: EXTERN int PetscMatlabEngineGetOutput(PetscMatlabEngine,char **);
694: EXTERN int PetscMatlabEnginePrintOutput(PetscMatlabEngine,FILE*);
695: */
697: EXTERN_C_END