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 petscsynchronizedflush_ PETSCSYNCHRONIZEDFLUSH
14: #define chkmemfortran_ CHKMEMFORTRAN
15: #define petscattachdebugger_ PETSCATTACHDEBUGGER
16: #define petscobjectsetname_ PETSCOBJECTSETNAME
17: #define petscobjectdestroy_ PETSCOBJECTDESTROY
18: #define petscobjectgetcomm_ PETSCOBJECTGETCOMM
19: #define petscobjectgetname_ PETSCOBJECTGETNAME
20: #define petscgetflops_ PETSCGETFLOPS
21: #define petscerror_ PETSCERROR
22: #define petscrandomcreate_ PETSCRANDOMCREATE
23: #define petscrandomdestroy_ PETSCRANDOMDESTROY
24: #define petscrandomgetvalue_ PETSCRANDOMGETVALUE
25: #define petsctrvalid_ PETSCTRVALID
26: #define petscrealview_ PETSCREALVIEW
27: #define petscintview_ PETSCINTVIEW
28: #define petscsequentialphasebegin_ PETSCSEQUENTIALPHASEBEGIN
29: #define petscsequentialphaseend_ PETSCSEQUENTIALPHASEEND
30: #define petsctrlog_ PETSCTRLOG
31: #define petscmemcpy_ PETSCMEMCPY
32: #define petsctrdump_ PETSCTRDUMP
33: #define petsctrlogdump_ PETSCTRLOGDUMP
34: #define petscmemzero_ PETSCMEMZERO
35: #define petscbinaryopen_ PETSCBINARYOPEN
36: #define petscbinaryread_ PETSCBINARYREAD
37: #define petscbinarywrite_ PETSCBINARYWRITE
38: #define petscbinaryclose_ PETSCBINARYCLOSE
39: #define petscbinaryseek_ PETSCBINARYSEEK
40: #define petscfixfilename_ PETSCFIXFILENAME
41: #define petscstrncpy_ PETSCSTRNCPY
42: #define petscbarrier_ PETSCBARRIER
43: #define petscsynchronizedflush_ PETSCSYNCHRONIZEDFLUSH
44: #define petscsplitownership_ PETSCSPLITOWNERSHIP
45: #define petscsplitownershipblock_ PETSCSPLITOWNERSHIPBLOCK
46: #define petscobjectgetnewtag_ PETSCOBJECTGETNEWTAG
47: #define petsccommgetnewtag_ PETSCCOMMGETNEWTAG
48: #define petscfptrap_ PETSCFPTRAP
49: #define petscoffsetfortran_ PETSCOFFSETFORTRAN
50: #define petscmatlabenginecreate_ PETSCMATLABENGINECREATE
51: #define petscmatlabenginedestroy_ PETSCMATLABENGINEDESTROY
52: #define petscmatlabengineevaluate_ PETSCMATLABENGINEEVALUATE
53: #define petscmatlabenginegetoutput_ PETSCMATLABENGINEGETOUTPUT
54: #define petscmatlabengineprintoutput_ PETSCMATLABENGINEPRINTOUTPUT
55: #define petscmatlabengineput_ PETSCMATLABENGINEPUT
56: #define petscmatlabengineget_ PETSCMATLABENGINEGET
57: #define petscmatlabengineputarray_ PETSCMATLABENGINEPUTARRAY
58: #define petscmatlabenginegetarray_ PETSCMATLABENGINEGETARRAY
59: #define petscgetresidentsetsize_ PETSCGETRESIDENTSETSIZE
60: #define petsctrspace_ PETSCTRSPACE
61: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
62: #define petscfopen_ petscfopen
63: #define petscfclose_ petscfclose
64: #define petscfprintf_ petscfprintf
65: #define petscsynchronizedfprintf_ petscsynchronizedfprintf
66: #define petscsynchronizedflush_ petscsynchronizedflush
67: #define petscmatlabenginecreate_ petscmatlabenginecreate
68: #define petscmatlabenginedestroy_ petscmatlabenginedestroy
69: #define petscmatlabengineevaluate_ petscmatlabengineevaluate
70: #define petscmatlabenginegetoutput_ petscmatlabenginegetoutput
71: #define petscmatlabengineprintoutput_ petscmatlabengineprintoutput
72: #define petscmatlabengineput_ petscmatlabengineput
73: #define petscmatlabengineget_ petscmatlabengineget
74: #define petscmatlabengineputarray_ petscmatlabengineputarray
75: #define petscmatlabenginegetarray_ petscmatlabenginegetarray
76: #define petscoffsetfortran_ petscoffsetfortran
77: #define chkmemfortran_ chkmemfortran
78: #define petscobjectgetnewtag_ petscobjectgetnewtag
79: #define petsccommgetnewtag_ petsccommgetnewtag
80: #define petscsplitownership_ petscsplitownership
81: #define petscsplitownershipblock_ petscsplitownershipblock
82: #define petscbarrier_ petscbarrier
83: #define petscstrncpy_ petscstrncpy
84: #define petscfixfilename_ petscfixfilename
85: #define petsctrlog_ petsctrlog
86: #define petscattachdebugger_ petscattachdebugger
87: #define petscobjectsetname_ petscobjectsetname
88: #define petscobjectdestroy_ petscobjectdestroy
89: #define petscobjectgetcomm_ petscobjectgetcomm
90: #define petscobjectgetname_ petscobjectgetname
91: #define petscgetflops_ petscgetflops
92: #define petscerror_ petscerror
93: #define petscrandomcreate_ petscrandomcreate
94: #define petscrandomdestroy_ petscrandomdestroy
95: #define petscrandomgetvalue_ petscrandomgetvalue
96: #define petsctrvalid_ petsctrvalid
97: #define petscrealview_ petscrealview
98: #define petscintview_ petscintview
99: #define petscsequentialphasebegin_ petscsequentialphasebegin
100: #define petscsequentialphaseend_ petscsequentialphaseend
101: #define petscmemcpy_ petscmemcpy
102: #define petsctrdump_ petsctrdump
103: #define petsctrlogdump_ petsctlogrdump
104: #define petscmemzero_ petscmemzero
105: #define petscbinaryopen_ petscbinaryopen
106: #define petscbinaryread_ petscbinaryread
107: #define petscbinarywrite_ petscbinarywrite
108: #define petscbinaryclose_ petscbinaryclose
109: #define petscbinaryseek_ petscbinaryseek
110: #define petscsynchronizedflush_ petscsynchronizedflush
111: #define petscfptrap_ petscfptrap
112: #define petscgetcputime_ petscgetcputime
113: #define petscgetresidentsetsize_ petscgetresidentsetsize
114: #define petsctrspace_ petsctrspace
115: #endif
117: EXTERN_C_BEGIN
118: /*
119: integer i_x,i_y,shift
120: Vec x,y
121: PetscScalar v_x(1),v_y(1)
123: call VecGetArray(x,v_x,i_x,ierr)
124: if (x .eq. y) then
125: call PetscOffsetFortran(y_v,x_v,shift,ierr)
126: i_y = i_x + shift
127: else
128: call VecGetArray(y,v_y,i_y,ierr)
129: endif
130: */
132: void PETSC_STDCALL petsctrspace_(PetscLogDouble *space,PetscLogDouble *fr,PetscLogDouble *maxs, int *ierr)
133: {
134: *PetscTrSpace(space,fr,maxs);
135: }
137: void PETSC_STDCALL petscgetresidentsetsize_(PetscLogDouble *foo, int *ierr)
138: {
139: *PetscGetResidentSetSize(foo);
140: }
142: void PETSC_STDCALL petscoffsetfortran_(PetscScalar *x,PetscScalar *y,int *shift,int *ierr)
143: {
144: *0;
145: *shift = y - x;
146: }
148: void PETSC_STDCALL petscgetcputime_(PetscLogDouble *t, int *ierr)
149: {
150: *PetscGetCPUTime(t);
151: }
153: void PETSC_STDCALL petscfopen_(MPI_Comm *comm,CHAR fname PETSC_MIXED_LEN(len1),CHAR fmode PETSC_MIXED_LEN(len2),
154: FILE **file,int *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2))
155: {
156: char *c1,*c2;
158: FIXCHAR(fname,len1,c1);
159: FIXCHAR(fmode,len2,c2);
160: *PetscFOpen((MPI_Comm)PetscToPointerComm(*comm),c1,c2,file);
161: FREECHAR(fname,c1);
162: FREECHAR(fmode,c2);
163: }
164:
165: void PETSC_STDCALL petscfclose_(MPI_Comm *comm,FILE **file,int *ierr)
166: {
167: *PetscFClose((MPI_Comm)PetscToPointerComm(*comm),*file);
168: }
170: void PETSC_STDCALL petscsynchronizedflush_(MPI_Comm *comm,int *ierr)
171: {
172: *PetscSynchronizedFlush((MPI_Comm)PetscToPointerComm(*comm));
173: }
175: void PETSC_STDCALL petscfprintf_(MPI_Comm *comm,FILE **file,CHAR fname PETSC_MIXED_LEN(len1),int *ierr PETSC_END_LEN(len1))
176: {
177: char *c1;
179: FIXCHAR(fname,len1,c1);
180: *PetscFPrintf((MPI_Comm)PetscToPointerComm(*comm),*file,c1);
181: FREECHAR(fname,c1);
182: }
184: void PETSC_STDCALL petscsynchronizedfprintf_(MPI_Comm *comm,FILE **file,CHAR fname PETSC_MIXED_LEN(len1),int *ierr PETSC_END_LEN(len1))
185: {
186: char *c1;
188: FIXCHAR(fname,len1,c1);
189: *PetscSynchronizedFPrintf((MPI_Comm)PetscToPointerComm(*comm),*file,c1);
190: FREECHAR(fname,c1);
191: }
193: void PETSC_STDCALL petscsetfptrap_(PetscFPTrap *flag,int *ierr)
194: {
195: *PetscSetFPTrap(*flag);
196: }
198: void PETSC_STDCALL petscobjectgetnewtag_(PetscObject *obj,int *tag,int *ierr)
199: {
200: *PetscObjectGetNewTag(*obj,tag);
201: }
203: void PETSC_STDCALL petsccommgetnewtag_(MPI_Comm *comm,int *tag,int *ierr)
204: {
205: *PetscCommGetNewTag((MPI_Comm)PetscToPointerComm(*comm),tag);
206: }
208: void PETSC_STDCALL petscsplitownershipblock_(MPI_Comm *comm,int *bs,int *n,int *N,int *ierr)
209: {
210: *PetscSplitOwnershipBlock((MPI_Comm)PetscToPointerComm(*comm),*bs,n,N);
211: }
212: void PETSC_STDCALL petscsplitownership_(MPI_Comm *comm,int *n,int *N,int *ierr)
213: {
214: *PetscSplitOwnership((MPI_Comm)PetscToPointerComm(*comm),n,N);
215: }
217: void PETSC_STDCALL petscbarrier_(PetscObject *obj,int *ierr)
218: {
219: *PetscBarrier(*obj);
220: }
222: void PETSC_STDCALL petscstrncpy_(CHAR s1 PETSC_MIXED_LEN(len1),CHAR s2 PETSC_MIXED_LEN(len2),int *n,
223: int *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2))
224: {
225: char *t1,*t2;
226: int m;
228: #if defined(PETSC_USES_CPTOFCD)
229: t1 = _fcdtocp(s1);
230: t2 = _fcdtocp(s2);
231: m = *n; if (_fcdlen(s1) < m) m = _fcdlen(s1); if (_fcdlen(s2) < m) m = _fcdlen(s2);
232: #else
233: t1 = s1;
234: t2 = s2;
235: m = *n; if (len1 < m) m = len1; if (len2 < m) m = len2;
236: #endif
237: *PetscStrncpy(t1,t2,m);
238: }
240: void PETSC_STDCALL petscfixfilename_(CHAR filein PETSC_MIXED_LEN(len1),CHAR fileout PETSC_MIXED_LEN(len2),
241: int *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2))
242: {
243: int i,n;
244: char *in,*out;
246: #if defined(PETSC_USES_CPTOFCD)
247: in = _fcdtocp(filein);
248: out = _fcdtocp(fileout);
249: n = _fcdlen (filein);
250: #else
251: in = filein;
252: out = fileout;
253: n = len1;
254: #endif
256: for (i=0; i<n; i++) {
257: #if defined(PARCH_win32)
258: if (in[i] == '/') out[i] = '\';
259: #else
260: if (in[i] == '\') out[i] = '/';
261: #endif
262: else out[i] = in[i];
263: }
264: out[i] = 0;
265: }
267: void PETSC_STDCALL petscbinaryopen_(CHAR name PETSC_MIXED_LEN(len),int *type,int *fd,
268: int *ierr PETSC_END_LEN(len))
269: {
270: char *c1;
272: FIXCHAR(name,len,c1);
273: *PetscBinaryOpen(c1,*type,fd);
274: FREECHAR(name,c1);
275: }
277: void PETSC_STDCALL petscbinarywrite_(int *fd,void *p,int *n,PetscDataType *type,int *istemp,int *ierr)
278: {
279: *PetscBinaryWrite(*fd,p,*n,*type,*istemp);
280: }
282: void PETSC_STDCALL petscbinaryread_(int *fd,void *p,int *n,PetscDataType *type,int *ierr)
283: {
284: *PetscBinaryRead(*fd,p,*n,*type);
285: }
287: void PETSC_STDCALL petscbinaryseek_(int *fd,int *size,PetscBinarySeekType *whence,int *offset,int *ierr)
288: {
289: *PetscBinarySeek(*fd,*size,*whence,offset);
290: }
292: void PETSC_STDCALL petscbinaryclose_(int *fd,int *ierr)
293: {
294: *PetscBinaryClose(*fd);
295: }
297: /* ---------------------------------------------------------------------------------*/
298: void PETSC_STDCALL petscmemzero_(void *a,int *n,int *ierr)
299: {
300: *PetscMemzero(a,*n);
301: }
303: void PETSC_STDCALL petsctrdump_(int *ierr)
304: {
305: *PetscTrDump(stdout);
306: }
307: void PETSC_STDCALL petsctrlogdump_(int *ierr)
308: {
309: *PetscTrLogDump(stdout);
310: }
312: void PETSC_STDCALL petscmemcpy_(int *out,int *in,int *length,int *ierr)
313: {
314: *PetscMemcpy(out,in,*length);
315: }
317: void PETSC_STDCALL petsctrlog_(int *ierr)
318: {
319: *PetscTrLog();
320: }
322: /*
323: This version does not do a malloc
324: */
325: static char FIXCHARSTRING[1024];
326: #if defined(PETSC_USES_CPTOFCD)
327: #include <fortran.h>
329: #define CHAR _fcd
330: #define FIXCHARNOMALLOC(a,n,b)
331: {
332: b = _fcdtocp(a);
333: n = _fcdlen (a);
334: if (b == PETSC_NULL_CHARACTER_Fortran) {
335: b = 0;
336: } else {
337: while((n > 0) && (b[n-1] == ' ')) n--;
338: b = FIXCHARSTRING;
339: *PetscStrncpy(b,_fcdtocp(a),n);
340: if (*ierr) return;
341: b[n] = 0;
342: }
343: }
345: #else
347: #define CHAR char*
348: #define FIXCHARNOMALLOC(a,n,b)
349: {
350: if (a == PETSC_NULL_CHARACTER_Fortran) {
351: b = a = 0;
352: } else {
353: while((n > 0) && (a[n-1] == ' ')) n--;
354: if (a[n] != 0) {
355: b = FIXCHARSTRING;
356: *PetscStrncpy(b,a,n);
357: if (*ierr) return;
358: b[n] = 0;
359: } else b = a;
360: }
361: }
363: #endif
365: void PETSC_STDCALL chkmemfortran_(int *line,CHAR file PETSC_MIXED_LEN(len),int *ierr PETSC_END_LEN(len))
366: {
367: char *c1;
369: FIXCHARNOMALLOC(file,len,c1);
370: *PetscTrValid(*line,"Userfunction",c1," ");
371: }
373: void PETSC_STDCALL petsctrvalid_(int *ierr)
374: {
375: *PetscTrValid(0,"Unknown Fortran",0,0);
376: }
378: void PETSC_STDCALL petscrandomgetvalue_(PetscRandom *r,PetscScalar *val,int *ierr)
379: {
380: *PetscRandomGetValue(*r,val);
381: }
384: void PETSC_STDCALL petscobjectgetname_(PetscObject *obj,CHAR name PETSC_MIXED_LEN(len),
385: int *ierr PETSC_END_LEN(len))
386: {
387: char *tmp;
388: *PetscObjectGetName(*obj,&tmp);
389: #if defined(PETSC_USES_CPTOFCD)
390: {
391: char *t = _fcdtocp(name);
392: int len1 = _fcdlen(name);
393: *PetscStrncpy(t,tmp,len1);if (*ierr) return;
394: }
395: #else
396: *PetscStrncpy(name,tmp,len);if (*ierr) return;
397: #endif
398: }
400: void PETSC_STDCALL petscobjectdestroy_(PetscObject *obj,int *ierr)
401: {
402: *PetscObjectDestroy(*obj);
403: }
405: void PETSC_STDCALL petscobjectgetcomm_(PetscObject *obj,int *comm,int *ierr)
406: {
407: MPI_Comm c;
408: *PetscObjectGetComm(*obj,&c);
409: *(int*)comm = PetscFromPointerComm(c);
410: }
412: void PETSC_STDCALL petscattachdebugger_(int *ierr)
413: {
414: *PetscAttachDebugger();
415: }
417: void PETSC_STDCALL petscobjectsetname_(PetscObject *obj,CHAR name PETSC_MIXED_LEN(len),
418: int *ierr PETSC_END_LEN(len))
419: {
420: char *t1;
422: FIXCHAR(name,len,t1);
423: *PetscObjectSetName(*obj,t1);
424: FREECHAR(name,t1);
425: }
427: void PETSC_STDCALL petscerror_(int *number,int *p,CHAR message PETSC_MIXED_LEN(len),
428: int *ierr PETSC_END_LEN(len))
429: {
430: char *t1;
431: FIXCHAR(message,len,t1);
432: *PetscError(-1,"fortran_interface_unknown_file",0,0,*number,*p,t1);
433: FREECHAR(message,t1);
434: }
436: void PETSC_STDCALL petscgetflops_(PetscLogDouble *d,int *ierr)
437: {
438: #if defined(PETSC_USE_LOG)
439: *PetscGetFlops(d);
440: #else
441: 0;
442: *d = 0.0;
443: #endif
444: }
446: void PETSC_STDCALL petscrandomcreate_(MPI_Comm *comm,PetscRandomType *type,PetscRandom *r,int *ierr)
447: {
448: *PetscRandomCreate((MPI_Comm)PetscToPointerComm(*comm),*type,r);
449: }
451: void PETSC_STDCALL petscrandomdestroy_(PetscRandom *r,int *ierr)
452: {
453: *PetscRandomDestroy(*r);
454: }
456: void PETSC_STDCALL petscrealview_(int *n,PetscReal *d,int *viwer,int *ierr)
457: {
458: *PetscRealView(*n,d,0);
459: }
461: void PETSC_STDCALL petscintview_(int *n,int *d,int *viwer,int *ierr)
462: {
463: *PetscIntView(*n,d,0);
464: }
466: void PETSC_STDCALL petscsequentialphasebegin_(MPI_Comm *comm,int *ng,int *ierr){
467: *PetscSequentialPhaseBegin(
468: (MPI_Comm)PetscToPointerComm(*comm),*ng);
469: }
470: void PETSC_STDCALL petscsequentialphaseend_(MPI_Comm *comm,int *ng,int *ierr){
471: *PetscSequentialPhaseEnd(
472: (MPI_Comm)PetscToPointerComm(*comm),*ng);
473: }
476: #if defined(PETSC_HAVE_MATLAB_ENGINE) && !defined(PETSC_USE_COMPLEX) && !defined(PETSC_USE_SINGLE)
478: void PETSC_STDCALL petscmatlabenginecreate_(MPI_Comm *comm,CHAR m PETSC_MIXED_LEN(len),PetscMatlabEngine *e,
479: int *ierr PETSC_END_LEN(len))
480: {
481: char *ms;
483: FIXCHAR(m,len,ms);
484: *PetscMatlabEngineCreate((MPI_Comm)PetscToPointerComm(*comm),ms,e);
485: FREECHAR(m,ms);
486: }
488: void PETSC_STDCALL petscmatlabenginedestroy_(PetscMatlabEngine *e,int *ierr)
489: {
490: *PetscMatlabEngineDestroy(*e);
491: }
493: void PETSC_STDCALL petscmatlabengineevaluate_(PetscMatlabEngine *e,CHAR m PETSC_MIXED_LEN(len),
494: int *ierr PETSC_END_LEN(len))
495: {
496: char *ms;
497: FIXCHAR(m,len,ms);
498: *PetscMatlabEngineEvaluate(*e,ms);
499: FREECHAR(m,ms);
500: }
502: void PETSC_STDCALL petscmatlabengineput_(PetscMatlabEngine *e,PetscObject *o,int *ierr)
503: {
504: *PetscMatlabEnginePut(*e,*o);
505: }
507: void PETSC_STDCALL petscmatlabengineget_(PetscMatlabEngine *e,PetscObject *o,int *ierr)
508: {
509: *PetscMatlabEngineGet(*e,*o);
510: }
512: void PETSC_STDCALL petscmatlabengineputarray_(PetscMatlabEngine *e,int *m,int *n,PetscScalar *a,
513: CHAR s PETSC_MIXED_LEN(len),int *ierr PETSC_END_LEN(len))
514: {
515: char *ms;
516: FIXCHAR(s,len,ms);
517: *PetscMatlabEnginePutArray(*e,*m,*n,a,ms);
518: FREECHAR(s,ms);
519: }
521: void PETSC_STDCALL petscmatlabenginegetarray_(PetscMatlabEngine *e,int *m,int *n,PetscScalar *a,
522: CHAR s PETSC_MIXED_LEN(len),int *ierr PETSC_END_LEN(len))
523: {
524: char *ms;
525: FIXCHAR(s,len,ms);
526: *PetscMatlabEngineGetArray(*e,*m,*n,a,ms);
527: FREECHAR(s,ms);
528: }
530: #endif
531: /*
532: EXTERN int PetscMatlabEngineGetOutput(PetscMatlabEngine,char **);
533: EXTERN int PetscMatlabEnginePrintOutput(PetscMatlabEngine,FILE*);
534: */
536: EXTERN_C_END