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: */