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