Actual source code: zsys.c

 2:  #include src/fortran/custom/zpetsc.h
 3:  #include petscsys.h
 4:  #include petscmatlab.h

  6: #ifdef PETSC_HAVE_FORTRAN_CAPS
  7: #define petscpopsignalhandler_     PETSCPOPSIGNALHANDLER
  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 petscpopsignalhandler_        petscpopsignalhandler
 78: #define petscfopen_                   petscfopen
 79: #define petscfclose_                  petscfclose
 80: #define petscfprintf_                 petscfprintf
 81: #define petscsynchronizedfprintf_     petscsynchronizedfprintf
 82: #define petscprintf_                  petscprintf
 83: #define petscsynchronizedprintf_      petscsynchronizedprintf
 84: #define petscsynchronizedflush_       petscsynchronizedflush
 85: #define petscmatlabenginecreate_      petscmatlabenginecreate
 86: #define petscmatlabenginedestroy_     petscmatlabenginedestroy
 87: #define petscmatlabengineevaluate_    petscmatlabengineevaluate
 88: #define petscmatlabenginegetoutput_   petscmatlabenginegetoutput
 89: #define petscmatlabengineprintoutput_ petscmatlabengineprintoutput
 90: #define petscmatlabengineput_         petscmatlabengineput
 91: #define petscmatlabengineget_         petscmatlabengineget
 92: #define petscmatlabengineputarray_    petscmatlabengineputarray
 93: #define petscmatlabenginegetarray_    petscmatlabenginegetarray
 94: #define petscoffsetfortran_        petscoffsetfortran     
 95: #define chkmemfortran_             chkmemfortran
 96: #define petscobjectgetnewtag_      petscobjectgetnewtag
 97: #define petsccommgetnewtag_        petsccommgetnewtag
 98: #define petscsplitownership_       petscsplitownership
 99: #define petscsplitownershipblock_  petscsplitownershipblock
100: #define petscbarrier_              petscbarrier
101: #define petscstrncpy_              petscstrncpy
102: #define petscfixfilename_          petscfixfilename
103: #define petsctrlog_                petsctrlog
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 petsctrvalid_              petsctrvalid
115: #define petscrealview_             petscrealview
116: #define petscintview_              petscintview
117: #define petscsequentialphasebegin_ petscsequentialphasebegin
118: #define petscsequentialphaseend_   petscsequentialphaseend
119: #define petscmemcpy_               petscmemcpy
120: #define petsctrdump_               petsctrdump
121: #define petsctrlogdump_            petsctlogrdump
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 petscgetresidentsetsize_   petscgetresidentsetsize
132: #define petsctrspace_              petsctrspace
133: #define petscviewerasciiprintf_    petscviewerasciiprintf
134: #define petscviewerasciisynchronizedprintf_    petscviewerasciisynchronizedprintf
135: #define petscviewerasciisettab_ petscviewerasciisettab
136: #define petscviewerasciipushtab_ petscviewerasciipushtab
137: #define petscviewerasciipoptab_ petscviewerasciipoptab
138: #define petscviewerasciiusetabs_ petscviewerasciiusetabs
139: #define petscpusherrorhandler_   petscpusherrorhandler
140: #define petscpoperrorhandler_    petscpoperrorhandler
141: #define petsctracebackerrorhandler_   petsctracebackerrorhandler
142: #define petscaborterrorhandler_       petscaborterrorhandler
143: #define petscignoreerrorhandler_      petscignoreerrorhandler
144: #define petscemacsclienterrorhandler_ petscemacsclienterrorhandler
145: #define petscattachdebuggererrorhandler_   petscattachdebuggererrorhandler
146: #endif

149: 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));

153: static PetscErrorCode ourerrorhandler(int line,const char *fun,const char *file,const char *dir,int n,int p,const char *mess,void *ctx)
154: {
155:   PetscErrorCode 0;
156:   size_t len1,len2,len3,len4;
157:   int l1,l2,l3,l4;

159:   PetscStrlen(fun,&len1); l1 = (int)len1;
160:   PetscStrlen(file,&len2);l2 = (int)len2;
161:   PetscStrlen(dir,&len3);l3 = (int)len3;
162:   PetscStrlen(mess,&len4);l4 = (int)len4;

164: #if defined(PETSC_USES_CPTOFCD)
165:  {
166:    CHAR fun_c,file_c,dir_c,mess_c;

168:    fun_c  = _cptofcd(fun,len1);
169:    file_c = _cptofcd(file,len2);
170:    dir_c  = _cptofcd(dir,len3);
171:    mess_c = _cptofcd(mess,len4);
172:    (*f2)(&line,fun_c,file_c,dir_c,&n,&p,mess_c,ctx,&ierr,len1,len2,len3,len4);

174:  }
175: #elif defined(PETSC_HAVE_FORTRAN_MIXED_STR_ARG)
176:   (*f2)(&line,fun,l1,file,l2,dir,l3,&n,&p,mess,l4,ctx,&ierr);
177: #else
178:   (*f2)(&line,fun,file,dir,&n,&p,mess,ctx,&ierr,l1,l2,l3,l4);
179: #endif
180:   return ierr;
181: }

184: /*
185:     integer i_x,i_y,shift
186:     Vec     x,y
187:     PetscScalar  v_x(1),v_y(1)

189:     call VecGetArray(x,v_x,i_x,ierr)
190:     if (x .eq. y) then
191:       call PetscOffsetFortran(y_v,x_v,shift,ierr)
192:       i_y = i_x + shift
193:     else 
194:       call VecGetArray(y,v_y,i_y,ierr)
195:     endif
196: */

198: /*
199:         These are not usually called from Fortran but allow Fortran users 
200:    to transparently set these monitors from .F code
201:    
202:    functions, hence no STDCALL
203: */
204: void petsctracebackerrorhandler_(int *line,const char *fun,const char *file,const char *dir,int *n,int *p,const char *mess,void *ctx,PetscErrorCode *ierr)
205: {
206:   *PetscTraceBackErrorHandler(*line,fun,file,dir,*n,*p,mess,ctx);
207: }

209: void petscaborterrorhandler_(int *line,const char *fun,const char *file,const char *dir,int *n,int *p,const char *mess,void *ctx,PetscErrorCode *ierr)
210: {
211:   *PetscAbortErrorHandler(*line,fun,file,dir,*n,*p,mess,ctx);
212: }

214: void petscattachdebuggererrorhandler_(int *line,const char *fun,const char *file,const char *dir,int *n,int *p,const char *mess,void *ctx,PetscErrorCode *ierr)
215: {
216:   *PetscAttachDebuggerErrorHandler(*line,fun,file,dir,*n,*p,mess,ctx);
217: }

219: void petscemacsclienterrorhandler_(int *line,const char *fun,const char *file,const char *dir,int *n,int *p,const char *mess,void *ctx,PetscErrorCode *ierr)
220: {
221:   *PetscEmacsClientErrorHandler(*line,fun,file,dir,*n,*p,mess,ctx);
222: }

224: void petscignoreerrorhandler_(int *line,const char *fun,const char *file,const char *dir,int *n,int *p,const char *mess,void *ctx,PetscErrorCode *ierr)
225: {
226:   *PetscIgnoreErrorHandler(*line,fun,file,dir,*n,*p,mess,ctx);
227: }

229: 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)
230: {
231:   if ((void(*)(void))handler == (void(*)(void))petsctracebackerrorhandler_) {
232:     *PetscPushErrorHandler(PetscTraceBackErrorHandler,0);
233:   } else {
234:     f2    = handler;
235:     *PetscPushErrorHandler(ourerrorhandler,ctx);
236:   }
237: }

239: void PETSC_STDCALL petscpopsignalhandler_(PetscErrorCode *ierr)
240: {
241:   *PetscPopSignalHandler();
242: }

244: void PETSC_STDCALL petscpoperrorhandler_(PetscErrorCode *ierr)
245: {
246:   *PetscPopErrorHandler();
247: }

249: void PETSC_STDCALL petscviewerasciisettab_(PetscViewer *viewer,PetscInt *tabs,PetscErrorCode *ierr)
250: {
251:   *PetscViewerASCIISetTab(*viewer,*tabs);
252: }

254: void PETSC_STDCALL petscviewerasciipushtab_(PetscViewer *viewer,PetscErrorCode *ierr)
255: {
256:   *PetscViewerASCIIPushTab(*viewer);
257: }

259: void PETSC_STDCALL petscviewerasciipoptab_(PetscViewer *viewer,PetscErrorCode *ierr)
260: {
261:   *PetscViewerASCIIPopTab(*viewer);
262: }

264: void PETSC_STDCALL petscviewerasciiusetabs_(PetscViewer *viewer,PetscTruth *flg,PetscErrorCode *ierr)
265: {
266:   *PetscViewerASCIIUseTabs(*viewer,*flg);
267: }

269: void PETSC_STDCALL petscviewerasciiprintf_(PetscViewer *viewer,CHAR str PETSC_MIXED_LEN(len1),PetscErrorCode *ierr PETSC_END_LEN(len1))
270: {
271:   char *c1;

273:   FIXCHAR(str,len1,c1);
274:   *PetscViewerASCIIPrintf(*viewer,c1);
275:   FREECHAR(str,c1);
276: }

278: void PETSC_STDCALL petscviewerasciisynchronizedprintf_(PetscViewer *viewer,CHAR str PETSC_MIXED_LEN(len1),PetscErrorCode *ierr PETSC_END_LEN(len1))
279: {
280:   char *c1;

282:   FIXCHAR(str,len1,c1);
283:   *PetscViewerASCIISynchronizedPrintf(*viewer,c1);
284:   FREECHAR(str,c1);
285: }

287: void PETSC_STDCALL petsctrspace_(PetscLogDouble *space,PetscLogDouble *fr,PetscLogDouble *maxs, PetscErrorCode *ierr)
288: {
289:   *PetscTrSpace(space,fr,maxs);
290: }

292: void PETSC_STDCALL petscgetresidentsetsize_(PetscLogDouble *foo, PetscErrorCode *ierr)
293: {
294:   *PetscGetResidentSetSize(foo);
295: }

297: void PETSC_STDCALL petscoffsetfortran_(PetscScalar *x,PetscScalar *y,PetscInt *shift,PetscErrorCode *ierr)
298: {
299:   *0;
300:   *shift = y - x;
301: }

303: void PETSC_STDCALL petscgetcputime_(PetscLogDouble *t, PetscErrorCode *ierr)
304: {
305:   *PetscGetCPUTime(t);
306: }

308: void PETSC_STDCALL petscfopen_(MPI_Comm *comm,CHAR fname PETSC_MIXED_LEN(len1),CHAR fmode PETSC_MIXED_LEN(len2),
309:                                FILE **file,PetscErrorCode *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2))
310: {
311:   char *c1,*c2;

313:   FIXCHAR(fname,len1,c1);
314:   FIXCHAR(fmode,len2,c2);
315:   *PetscFOpen((MPI_Comm)PetscToPointerComm(*comm),c1,c2,file);
316:   FREECHAR(fname,c1);
317:   FREECHAR(fmode,c2);
318: }
319: 
320: void PETSC_STDCALL petscfclose_(MPI_Comm *comm,FILE **file,PetscErrorCode *ierr)
321: {
322:   *PetscFClose((MPI_Comm)PetscToPointerComm(*comm),*file);
323: }

325: void PETSC_STDCALL petscsynchronizedflush_(MPI_Comm *comm,PetscErrorCode *ierr)
326: {
327:   *PetscSynchronizedFlush((MPI_Comm)PetscToPointerComm(*comm));
328: }

330: void PETSC_STDCALL petscfprintf_(MPI_Comm *comm,FILE **file,CHAR fname PETSC_MIXED_LEN(len1),PetscErrorCode *ierr PETSC_END_LEN(len1))
331: {
332:   char *c1;

334:   FIXCHAR(fname,len1,c1);
335:   *PetscFPrintf((MPI_Comm)PetscToPointerComm(*comm),*file,c1);
336:   FREECHAR(fname,c1);
337: }

339: void PETSC_STDCALL petscprintf_(MPI_Comm *comm,CHAR fname PETSC_MIXED_LEN(len1),PetscErrorCode *ierr PETSC_END_LEN(len1))
340: {
341:   char *c1;

343:   FIXCHAR(fname,len1,c1);
344:   *PetscPrintf((MPI_Comm)PetscToPointerComm(*comm),c1);
345:   FREECHAR(fname,c1);
346: }

348: void PETSC_STDCALL petscsynchronizedfprintf_(MPI_Comm *comm,FILE **file,CHAR fname PETSC_MIXED_LEN(len1),PetscErrorCode *ierr PETSC_END_LEN(len1))
349: {
350:   char *c1;

352:   FIXCHAR(fname,len1,c1);
353:   *PetscSynchronizedFPrintf((MPI_Comm)PetscToPointerComm(*comm),*file,c1);
354:   FREECHAR(fname,c1);
355: }

357: void PETSC_STDCALL petscsynchronizedprintf_(MPI_Comm *comm,CHAR fname PETSC_MIXED_LEN(len1),PetscErrorCode *ierr PETSC_END_LEN(len1))
358: {
359:   char *c1;

361:   FIXCHAR(fname,len1,c1);
362:   *PetscSynchronizedPrintf((MPI_Comm)PetscToPointerComm(*comm),c1);
363:   FREECHAR(fname,c1);
364: }

366: void PETSC_STDCALL petscsetfptrap_(PetscFPTrap *flag,PetscErrorCode *ierr)
367: {
368:   *PetscSetFPTrap(*flag);
369: }

371: void PETSC_STDCALL petscobjectgetnewtag_(PetscObject *obj,PetscMPIInt *tag,PetscErrorCode *ierr)
372: {
373:   *PetscObjectGetNewTag(*obj,tag);
374: }

376: void PETSC_STDCALL petsccommgetnewtag_(MPI_Comm *comm,PetscMPIInt *tag,PetscErrorCode *ierr)
377: {
378:   *PetscCommGetNewTag((MPI_Comm)PetscToPointerComm(*comm),tag);
379: }

381: void PETSC_STDCALL petscsplitownershipblock_(MPI_Comm *comm,PetscInt *bs,PetscInt *n,PetscInt *N,PetscErrorCode *ierr)
382: {
383:   *PetscSplitOwnershipBlock((MPI_Comm)PetscToPointerComm(*comm),*bs,n,N);
384: }
385: void PETSC_STDCALL petscsplitownership_(MPI_Comm *comm,PetscInt *n,PetscInt *N,PetscErrorCode *ierr)
386: {
387:   *PetscSplitOwnership((MPI_Comm)PetscToPointerComm(*comm),n,N);
388: }

390: void PETSC_STDCALL petscbarrier_(PetscObject *obj,PetscErrorCode *ierr)
391: {
392:   *PetscBarrier(*obj);
393: }

395: void PETSC_STDCALL petscstrncpy_(CHAR s1 PETSC_MIXED_LEN(len1),CHAR s2 PETSC_MIXED_LEN(len2),int *n,
396:                                  PetscErrorCode *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2))
397: {
398:   char *t1,*t2;
399:   int  m;

401: #if defined(PETSC_USES_CPTOFCD)
402:   t1 = _fcdtocp(s1);
403:   t2 = _fcdtocp(s2);
404:   m = *n; if (_fcdlen(s1) < m) m = _fcdlen(s1); if (_fcdlen(s2) < m) m = _fcdlen(s2);
405: #else
406:   t1 = s1;
407:   t2 = s2;
408:   m = *n; if (len1 < m) m = len1; if (len2 < m) m = len2;
409: #endif
410:   *PetscStrncpy(t1,t2,m);
411: }

413: void PETSC_STDCALL petscfixfilename_(CHAR filein PETSC_MIXED_LEN(len1),CHAR fileout PETSC_MIXED_LEN(len2),
414:                                      PetscErrorCode *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2))
415: {
416:   PetscInt  i,n;
417:   char *in,*out;

419: #if defined(PETSC_USES_CPTOFCD)
420:   in  = _fcdtocp(filein);
421:   out = _fcdtocp(fileout);
422:   n   = _fcdlen (filein);
423: #else
424:   in  = filein;
425:   out = fileout;
426:   n   = len1;
427: #endif

429:   for (i=0; i<n; i++) {
430:     if (in[i] == PETSC_REPLACE_DIR_SEPARATOR) out[i] = PETSC_DIR_SEPARATOR;
431:     else out[i] = in[i];
432:   }
433:   out[i] = 0;
434: }

436: void PETSC_STDCALL petscbinaryopen_(CHAR name PETSC_MIXED_LEN(len),PetscViewerFileType *type,int *fd,
437:                                     PetscErrorCode *ierr PETSC_END_LEN(len))
438: {
439:   char *c1;

441:   FIXCHAR(name,len,c1);
442:   *PetscBinaryOpen(c1,*type,fd);
443:   FREECHAR(name,c1);
444: }

446: void PETSC_STDCALL petscbinarywrite_(int *fd,void *p,PetscInt *n,PetscDataType *type,PetscTruth *istemp,PetscErrorCode *ierr)
447: {
448:   *PetscBinaryWrite(*fd,p,*n,*type,*istemp);
449: }

451: void PETSC_STDCALL petscbinaryread_(int *fd,void *p,PetscInt *n,PetscDataType *type,PetscErrorCode *ierr)
452: {
453:   *PetscBinaryRead(*fd,p,*n,*type);
454: }

456: void PETSC_STDCALL petscbinaryseek_(int *fd,PetscInt *size,PetscBinarySeekType *whence,off_t *offset,PetscErrorCode *ierr)
457: {
458:   *PetscBinarySeek(*fd,*size,*whence,offset);
459: }

461: void PETSC_STDCALL petscbinaryclose_(int *fd,PetscErrorCode *ierr)
462: {
463:   *PetscBinaryClose(*fd);
464: }

466: /* ---------------------------------------------------------------------------------*/
467: void PETSC_STDCALL petscmemzero_(void *a,PetscInt *n,PetscErrorCode *ierr)
468: {
469:   *PetscMemzero(a,*n);
470: }

472: void PETSC_STDCALL petsctrdump_(PetscErrorCode *ierr)
473: {
474:   *PetscTrDump(stdout);
475: }
476: void PETSC_STDCALL petsctrlogdump_(PetscErrorCode *ierr)
477: {
478:   *PetscTrLogDump(stdout);
479: }

481: void PETSC_STDCALL petscmemcpy_(int *out,int *in,int *length,PetscErrorCode *ierr)
482: {
483:   *PetscMemcpy(out,in,*length);
484: }

486: void PETSC_STDCALL petsctrlog_(PetscErrorCode *ierr)
487: {
488:   *PetscTrLog();
489: }

491: /*
492:         This version does not do a malloc 
493: */
494: static char FIXCHARSTRING[1024];
495: #if defined(PETSC_USES_CPTOFCD)
496: #include <fortran.h>

498: #define CHAR _fcd
499: #define FIXCHARNOMALLOC(a,n,b) \
500: { \
501:   b = _fcdtocp(a); \
502:   n = _fcdlen (a); \
503:   if (b == PETSC_NULL_CHARACTER_Fortran) { \
504:       b = 0; \
505:   } else {  \
506:     while((n > 0) && (b[n-1] == ' ')) n--; \
507:     b = FIXCHARSTRING; \
508:     *PetscStrncpy(b,_fcdtocp(a),n); \
509:     if (*ierr) return; \
510:     b[n] = 0; \
511:   } \
512: }

514: #else

516: #define CHAR char*
517: #define FIXCHARNOMALLOC(a,n,b) \
518: {\
519:   if (a == PETSC_NULL_CHARACTER_Fortran) { \
520:     b = a = 0; \
521:   } else { \
522:     while((n > 0) && (a[n-1] == ' ')) n--; \
523:     if (a[n] != 0) { \
524:       b = FIXCHARSTRING; \
525:       *PetscStrncpy(b,a,n); \
526:       if (*ierr) return; \
527:       b[n] = 0; \
528:     } else b = a;\
529:   } \
530: }

532: #endif

534: void PETSC_STDCALL chkmemfortran_(int *line,CHAR file PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len))
535: {
536:   char *c1;

538:   FIXCHARNOMALLOC(file,len,c1);
539:   *PetscTrValid(*line,"Userfunction",c1," ");
540: }

542: void PETSC_STDCALL petsctrvalid_(PetscErrorCode *ierr)
543: {
544:   *PetscTrValid(0,"Unknown Fortran",0,0);
545: }

547: void PETSC_STDCALL petscrandomgetvalue_(PetscRandom *r,PetscScalar *val,PetscErrorCode *ierr)
548: {
549:   *PetscRandomGetValue(*r,val);
550: }


553: void PETSC_STDCALL petscobjectgetname_(PetscObject *obj,CHAR name PETSC_MIXED_LEN(len),
554:                                        PetscErrorCode *ierr PETSC_END_LEN(len))
555: {
556:   char *tmp;
557:   *PetscObjectGetName(*obj,&tmp);
558: #if defined(PETSC_USES_CPTOFCD)
559:   {
560:   char *t = _fcdtocp(name);
561:   int  len1 = _fcdlen(name);
562:   *PetscStrncpy(t,tmp,len1);if (*ierr) return;
563:   }
564: #else
565:   *PetscStrncpy(name,tmp,len);if (*ierr) return;
566: #endif
567: }

569: void PETSC_STDCALL petscobjectdestroy_(PetscObject *obj,PetscErrorCode *ierr)
570: {
571:   *PetscObjectDestroy(*obj);
572: }

574: void PETSC_STDCALL petscobjectgetcomm_(PetscObject *obj,int *comm,PetscErrorCode *ierr)
575: {
576:   MPI_Comm c;
577:   *PetscObjectGetComm(*obj,&c);
578:   *(int*)comm = PetscFromPointerComm(c);
579: }

581: void PETSC_STDCALL petscattachdebugger_(PetscErrorCode *ierr)
582: {
583:   *PetscAttachDebugger();
584: }

586: void PETSC_STDCALL petscobjectsetname_(PetscObject *obj,CHAR name PETSC_MIXED_LEN(len),
587:                                        PetscErrorCode *ierr PETSC_END_LEN(len))
588: {
589:   char *t1;

591:   FIXCHAR(name,len,t1);
592:   *PetscObjectSetName(*obj,t1);
593:   FREECHAR(name,t1);
594: }

596: void PETSC_STDCALL petscerror_(int *number,int *p,CHAR message PETSC_MIXED_LEN(len),
597:                                PetscErrorCode *ierr PETSC_END_LEN(len))
598: {
599:   char *t1;
600:   FIXCHAR(message,len,t1);
601:   *PetscError(-1,0,0,0,*number,*p,t1);
602:   FREECHAR(message,t1);
603: }

605: void PETSC_STDCALL petscgetflops_(PetscLogDouble *d,PetscErrorCode *ierr)
606: {
607: #if defined(PETSC_USE_LOG)
608:   *PetscGetFlops(d);
609: #else
610:   0;
611:   *d     = 0.0;
612: #endif
613: }

615: void PETSC_STDCALL petscrandomcreate_(MPI_Comm *comm,PetscRandomType *type,PetscRandom *r,PetscErrorCode *ierr)
616: {
617:   *PetscRandomCreate((MPI_Comm)PetscToPointerComm(*comm),*type,r);
618: }

620: void PETSC_STDCALL petscrandomdestroy_(PetscRandom *r,PetscErrorCode *ierr)
621: {
622:   *PetscRandomDestroy(*r);
623: }

625: void PETSC_STDCALL petscrealview_(PetscInt *n,PetscReal *d,int *viwer,PetscErrorCode *ierr)
626: {
627:   *PetscRealView(*n,d,0);
628: }

630: void PETSC_STDCALL petscintview_(PetscInt *n,PetscInt *d,int *viwer,PetscErrorCode *ierr)
631: {
632:   *PetscIntView(*n,d,0);
633: }

635: void PETSC_STDCALL petscsequentialphasebegin_(MPI_Comm *comm,PetscInt *ng,PetscErrorCode *ierr){
636: *PetscSequentialPhaseBegin(
637:         (MPI_Comm)PetscToPointerComm(*comm),*ng);
638: }
639: void PETSC_STDCALL petscsequentialphaseend_(MPI_Comm *comm,PetscInt *ng,PetscErrorCode *ierr){
640: *PetscSequentialPhaseEnd(
641:         (MPI_Comm)PetscToPointerComm(*comm),*ng);
642: }


645: #if defined(PETSC_HAVE_MATLAB)

647: void PETSC_STDCALL petscmatlabenginecreate_(MPI_Comm *comm,CHAR m PETSC_MIXED_LEN(len),PetscMatlabEngine *e,
648:                                             PetscErrorCode *ierr PETSC_END_LEN(len))
649: {
650:   char *ms;

652:   FIXCHAR(m,len,ms);
653:   *PetscMatlabEngineCreate((MPI_Comm)PetscToPointerComm(*comm),ms,e);
654:   FREECHAR(m,ms);
655: }

657: void PETSC_STDCALL petscmatlabenginedestroy_(PetscMatlabEngine *e,PetscErrorCode *ierr)
658: {
659:   *PetscMatlabEngineDestroy(*e);
660: }

662: void PETSC_STDCALL petscmatlabengineevaluate_(PetscMatlabEngine *e,CHAR m PETSC_MIXED_LEN(len),
663:                                               PetscErrorCode *ierr PETSC_END_LEN(len))
664: {
665:   char *ms;
666:   FIXCHAR(m,len,ms);
667:   *PetscMatlabEngineEvaluate(*e,ms);
668:   FREECHAR(m,ms);
669: }

671: void PETSC_STDCALL petscmatlabengineput_(PetscMatlabEngine *e,PetscObject *o,PetscErrorCode *ierr)
672: {
673:   *PetscMatlabEnginePut(*e,*o);
674: }

676: void PETSC_STDCALL petscmatlabengineget_(PetscMatlabEngine *e,PetscObject *o,PetscErrorCode *ierr)
677: {
678:   *PetscMatlabEngineGet(*e,*o);
679: }

681: void PETSC_STDCALL petscmatlabengineputarray_(PetscMatlabEngine *e,PetscInt *m,PetscInt *n,PetscScalar *a,
682:                                               CHAR s PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len))
683: {
684:   char *ms;
685:   FIXCHAR(s,len,ms);
686:   *PetscMatlabEnginePutArray(*e,*m,*n,a,ms);
687:   FREECHAR(s,ms);
688: }

690: void PETSC_STDCALL petscmatlabenginegetarray_(PetscMatlabEngine *e,PetscInt *m,PetscInt *n,PetscScalar *a,
691:                                               CHAR s PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len))
692: {
693:   char *ms;
694:   FIXCHAR(s,len,ms);
695:   *PetscMatlabEngineGetArray(*e,*m,*n,a,ms);
696:   FREECHAR(s,ms);
697: }

699: #endif
700: /*
701: EXTERN int PetscMatlabEngineGetOutput(PetscMatlabEngine,char **);
702: EXTERN int PetscMatlabEnginePrintOutput(PetscMatlabEngine,FILE*);
703: */