Actual source code: zsys.c

  1: /*$Id: zsys.c,v 1.97 2001/10/04 18:48:06 balay Exp $*/

 3:  #include src/fortran/custom/zpetsc.h
 4:  #include petscsys.h
 5:  #include petscengine.h

  7: #ifdef PETSC_HAVE_FORTRAN_CAPS
  8: #define petscgetcputime_           PETSCGETCPUTIME
  9: #define petscfopen_                PETSCFOPEN
 10: #define petscfclose_               PETSCFCLOSE
 11: #define petscfprintf_              PETSCFPRINTF
 12: #define petscsynchronizedfprintf_  PETSCSYNCHRONIZEDFPRINTF
 13: #define petscprintf_               PETSCPRINTF
 14: #define petscsynchronizedprintf_   PETSCSYNCHRONIZEDPRINTF
 15: #define petscsynchronizedflush_    PETSCSYNCHRONIZEDFLUSH
 16: #define chkmemfortran_             CHKMEMFORTRAN
 17: #define petscattachdebugger_       PETSCATTACHDEBUGGER
 18: #define petscobjectsetname_        PETSCOBJECTSETNAME
 19: #define petscobjectdestroy_        PETSCOBJECTDESTROY
 20: #define petscobjectgetcomm_        PETSCOBJECTGETCOMM
 21: #define petscobjectgetname_        PETSCOBJECTGETNAME
 22: #define petscgetflops_             PETSCGETFLOPS
 23: #define petscerror_                PETSCERROR
 24: #define petscrandomcreate_         PETSCRANDOMCREATE
 25: #define petscrandomdestroy_        PETSCRANDOMDESTROY
 26: #define petscrandomgetvalue_       PETSCRANDOMGETVALUE
 27: #define petsctrvalid_              PETSCTRVALID
 28: #define petscrealview_             PETSCREALVIEW
 29: #define petscintview_              PETSCINTVIEW
 30: #define petscsequentialphasebegin_ PETSCSEQUENTIALPHASEBEGIN
 31: #define petscsequentialphaseend_   PETSCSEQUENTIALPHASEEND
 32: #define petsctrlog_                PETSCTRLOG
 33: #define petscmemcpy_               PETSCMEMCPY
 34: #define petsctrdump_               PETSCTRDUMP
 35: #define petsctrlogdump_            PETSCTRLOGDUMP
 36: #define petscmemzero_              PETSCMEMZERO
 37: #define petscbinaryopen_           PETSCBINARYOPEN
 38: #define petscbinaryread_           PETSCBINARYREAD
 39: #define petscbinarywrite_          PETSCBINARYWRITE
 40: #define petscbinaryclose_          PETSCBINARYCLOSE
 41: #define petscbinaryseek_           PETSCBINARYSEEK
 42: #define petscfixfilename_          PETSCFIXFILENAME
 43: #define petscstrncpy_              PETSCSTRNCPY
 44: #define petscbarrier_              PETSCBARRIER
 45: #define petscsynchronizedflush_    PETSCSYNCHRONIZEDFLUSH
 46: #define petscsplitownership_       PETSCSPLITOWNERSHIP
 47: #define petscsplitownershipblock_  PETSCSPLITOWNERSHIPBLOCK
 48: #define petscobjectgetnewtag_      PETSCOBJECTGETNEWTAG
 49: #define petsccommgetnewtag_        PETSCCOMMGETNEWTAG
 50: #define petscfptrap_               PETSCFPTRAP
 51: #define petscoffsetfortran_        PETSCOFFSETFORTRAN
 52: #define petscmatlabenginecreate_      PETSCMATLABENGINECREATE
 53: #define petscmatlabenginedestroy_     PETSCMATLABENGINEDESTROY
 54: #define petscmatlabengineevaluate_    PETSCMATLABENGINEEVALUATE
 55: #define petscmatlabenginegetoutput_   PETSCMATLABENGINEGETOUTPUT
 56: #define petscmatlabengineprintoutput_ PETSCMATLABENGINEPRINTOUTPUT
 57: #define petscmatlabengineput_         PETSCMATLABENGINEPUT
 58: #define petscmatlabengineget_         PETSCMATLABENGINEGET
 59: #define petscmatlabengineputarray_    PETSCMATLABENGINEPUTARRAY
 60: #define petscmatlabenginegetarray_    PETSCMATLABENGINEGETARRAY
 61: #define petscgetresidentsetsize_      PETSCGETRESIDENTSETSIZE
 62: #define petsctrspace_                 PETSCTRSPACE
 63: #define petscviewerasciiprintf_       PETSCVIEWERASCIIPRINTF
 64: #define petscviewerasciisynchronizedprintf_       PETSCVIEWERASCIISYNCHRONIZEDPRINTF
 65: #define petscviewerasciisettab_       PETSCVIEWERASCIISETTAB
 66: #define petscviewerasciipushtab_      PETSCVIEWERASCIIPUSHTAB
 67: #define petscviewerasciipoptab_       PETSCVIEWERASCIIPOPTAB
 68: #define petscviewerasciiusetabs_      PETSCVIEWERASCIIUSETABS
 69: #define petscpusherrorhandler_        PETSCPUSHERRORHANDLER
 70: #define petscpoperrorhandler_         PETSCPOPERRORHANDLER
 71: #define petsctracebackerrorhandler_   PETSCTRACEBACKERRORHANDLER
 72: #define petscaborterrorhandler_       PETSCABORTERRORHANDLER
 73: #define petscignoreerrorhandler_      PETSCIGNOREERRORHANDLER
 74: #define petscemacsclienterrorhandler_ PETSCEMACSCLIENTERRORHANDLER
 75: #define petscattachdebuggererrorhandler_   PETSCATTACHDEBUGGERERRORHANDLER
 76: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
 77: #define petscfopen_                   petscfopen
 78: #define petscfclose_                  petscfclose
 79: #define petscfprintf_                 petscfprintf
 80: #define petscsynchronizedfprintf_     petscsynchronizedfprintf
 81: #define petscprintf_                  petscprintf
 82: #define petscsynchronizedprintf_      petscsynchronizedprintf
 83: #define petscsynchronizedflush_       petscsynchronizedflush
 84: #define petscmatlabenginecreate_      petscmatlabenginecreate
 85: #define petscmatlabenginedestroy_     petscmatlabenginedestroy
 86: #define petscmatlabengineevaluate_    petscmatlabengineevaluate
 87: #define petscmatlabenginegetoutput_   petscmatlabenginegetoutput
 88: #define petscmatlabengineprintoutput_ petscmatlabengineprintoutput
 89: #define petscmatlabengineput_         petscmatlabengineput
 90: #define petscmatlabengineget_         petscmatlabengineget
 91: #define petscmatlabengineputarray_    petscmatlabengineputarray
 92: #define petscmatlabenginegetarray_    petscmatlabenginegetarray
 93: #define petscoffsetfortran_        petscoffsetfortran     
 94: #define chkmemfortran_             chkmemfortran
 95: #define petscobjectgetnewtag_      petscobjectgetnewtag
 96: #define petsccommgetnewtag_        petsccommgetnewtag
 97: #define petscsplitownership_       petscsplitownership
 98: #define petscsplitownershipblock_  petscsplitownershipblock
 99: #define petscbarrier_              petscbarrier
100: #define petscstrncpy_              petscstrncpy
101: #define petscfixfilename_          petscfixfilename
102: #define petsctrlog_                petsctrlog
103: #define petscattachdebugger_       petscattachdebugger
104: #define petscobjectsetname_        petscobjectsetname
105: #define petscobjectdestroy_        petscobjectdestroy
106: #define petscobjectgetcomm_        petscobjectgetcomm
107: #define petscobjectgetname_        petscobjectgetname
108: #define petscgetflops_             petscgetflops 
109: #define petscerror_                petscerror
110: #define petscrandomcreate_         petscrandomcreate
111: #define petscrandomdestroy_        petscrandomdestroy
112: #define petscrandomgetvalue_       petscrandomgetvalue
113: #define petsctrvalid_              petsctrvalid
114: #define petscrealview_             petscrealview
115: #define petscintview_              petscintview
116: #define petscsequentialphasebegin_ petscsequentialphasebegin
117: #define petscsequentialphaseend_   petscsequentialphaseend
118: #define petscmemcpy_               petscmemcpy
119: #define petsctrdump_               petsctrdump
120: #define petsctrlogdump_            petsctlogrdump
121: #define petscmemzero_              petscmemzero
122: #define petscbinaryopen_           petscbinaryopen
123: #define petscbinaryread_           petscbinaryread
124: #define petscbinarywrite_          petscbinarywrite
125: #define petscbinaryclose_          petscbinaryclose
126: #define petscbinaryseek_           petscbinaryseek
127: #define petscsynchronizedflush_    petscsynchronizedflush
128: #define petscfptrap_               petscfptrap
129: #define petscgetcputime_           petscgetcputime
130: #define petscgetresidentsetsize_   petscgetresidentsetsize
131: #define petsctrspace_              petsctrspace
132: #define petscviewerasciiprintf_    petscviewerasciiprintf
133: #define petscviewerasciisynchronizedprintf_    petscviewerasciisynchronizedprintf
134: #define petscviewerasciisettab_ petscviewerasciisettab
135: #define petscviewerasciipushtab_ petscviewerasciipushtab
136: #define petscviewerasciipoptab_ petscviewerasciipoptab
137: #define petscviewerasciiusetabs_ petscviewerasciiusetabs
138: #define petscpusherrorhandler_   petscpusherrorhandler
139: #define petscpoperrorhandler_    petscpoperrorhandler
140: #define petsctracebackerrorhandler_   petsctracebackerrorhandler
141: #define petscaborterrorhandler_       petscaborterrorhandler
142: #define petscignoreerrorhandler_      petscignoreerrorhandler
143: #define petscemacsclienterrorhandler_ petscemacsclienterrorhandler
144: #define petscattachdebuggererrorhandler_   petscattachdebuggererrorhandler
145: #endif

147: EXTERN_C_BEGIN
148: /*
149:     integer i_x,i_y,shift
150:     Vec     x,y
151:     PetscScalar  v_x(1),v_y(1)

153:     call VecGetArray(x,v_x,i_x,ierr)
154:     if (x .eq. y) then
155:       call PetscOffsetFortran(y_v,x_v,shift,ierr)
156:       i_y = i_x + shift
157:     else 
158:       call VecGetArray(y,v_y,i_y,ierr)
159:     endif
160: */

162: /*
163:         These are not usually called from Fortran but allow Fortran users 
164:    to transparently set these monitors from .F code
165:    
166:    functions, hence no STDCALL
167: */
168: void petsctracebackerrorhandler_(int *line,char *fun,char *file,char *dir,int *n,int *p,char *mess,void *ctx,int *ierr)
169: {
170:   *PetscTraceBackErrorHandler(*line,fun,file,dir,*n,*p,mess,ctx);
171: }

173: void petscaborterrorhandler_(int *line,char *fun,char *file,char *dir,int *n,int *p,char *mess,void *ctx,int *ierr)
174: {
175:   *PetscAbortErrorHandler(*line,fun,file,dir,*n,*p,mess,ctx);
176: }

178: void petscattachdebuggererrorhandler_(int *line,char *fun,char *file,char *dir,int *n,int *p,char *mess,void *ctx,int *ierr)
179: {
180:   *PetscAttachDebuggerErrorHandler(*line,fun,file,dir,*n,*p,mess,ctx);
181: }

183: void petscemacsclienterrorhandler_(int *line,char *fun,char *file,char *dir,int *n,int *p,char *mess,void *ctx,int *ierr)
184: {
185:   *PetscEmacsClientErrorHandler(*line,fun,file,dir,*n,*p,mess,ctx);
186: }

188: void petscignoreerrorhandler_(int *line,char *fun,char *file,char *dir,int *n,int *p,char *mess,void *ctx,int *ierr)
189: {
190:   *PetscIgnoreErrorHandler(*line,fun,file,dir,*n,*p,mess,ctx);
191: }

193: static void (PETSC_STDCALL *f2)(int*,CHAR PETSC_MIXED_LEN(len1),CHAR PETSC_MIXED_LEN(len2),CHAR PETSC_MIXED_LEN(len3),int*,int*,CHAR PETSC_MIXED_LEN(len4),void*,int* PETSC_END_LEN(len1) PETSC_END_LEN(len2) PETSC_END_LEN(len3) PETSC_END_LEN(len4));
194: static int ourerrorhandler(int line,char *fun,char *file,char *dir,int n,int p,char *mess,void *ctx)
195: {
196:   int 0,len1,len2,len3,len4;
197: 
198:   PetscStrlen(fun,&len1);
199:   PetscStrlen(file,&len2);
200:   PetscStrlen(dir,&len3);
201:   PetscStrlen(mess,&len4);

203: #if defined(PETSC_USES_CPTOFCD)
204:  {
205:    CHAR fun_c,file_c,dir_c,ness_c;

207:    fun_c  = _cptofcd(fun,len1);
208:    file_c = _cptofcd(file,len2);
209:    dir_c  = _cptofcd(dir,len3);
210:    mess_c = _cptofcd(mess,len4);
211:    (*f2)(&line_c,fun_c,file_c,dir,&n,&p,mess_c,ctx,&ierr,len1,len2,len3,len4);

213:  }
214: #elif defined(PETSC_USE_FORTRAN_MIXED_STR_ARG)
215:   (*f2)(&line,fun,len1,file,len2,dir,len3,&n,&p,mess,len4,ctx,&ierr);
216: #else
217:   (*f2)(&line,fun,file,dir,&n,&p,mess,ctx,&ierr,len1,len2,len3,len4);
218: #endif
219:   return ierr;
220: }

222: void PETSC_STDCALL petscpusherrorhandler_(void (PETSC_STDCALL *handler)(int*,CHAR PETSC_MIXED_LEN(len1),CHAR PETSC_MIXED_LEN(len2),CHAR PETSC_MIXED_LEN(len3),int*,int*,CHAR PETSC_MIXED_LEN(len4),void*,int* PETSC_END_LEN(len1) PETSC_END_LEN(len2) PETSC_END_LEN(len3) PETSC_END_LEN(len4)),void *ctx,int *ierr)
223: {
224:   if ((void(*)(void))handler == (void(*)(void))petsctracebackerrorhandler_) {
225:     *PetscPushErrorHandler(PetscTraceBackErrorHandler,0);
226:   } else {
227:     f2    = handler;
228:     *PetscPushErrorHandler(ourerrorhandler,ctx);
229:   }
230: }

232: void PETSC_STDCALL petscpoperrorhandler_(int *ierr)
233: {
234:   *PetscPopErrorHandler();
235: }

237: void PETSC_STDCALL petscviewerasciisettab_(PetscViewer *viewer,int *tabs,int *ierr)
238: {
239:   *PetscViewerASCIISetTab(*viewer,*tabs);
240: }

242: void PETSC_STDCALL petscviewerasciipushtab_(PetscViewer *viewer,int *ierr)
243: {
244:   *PetscViewerASCIIPushTab(*viewer);
245: }

247: void PETSC_STDCALL petscviewerasciipoptab_(PetscViewer *viewer,int *ierr)
248: {
249:   *PetscViewerASCIIPopTab(*viewer);
250: }

252: void PETSC_STDCALL petscviewerasciiusetabs_(PetscViewer *viewer,PetscTruth *flg,int *ierr)
253: {
254:   *PetscViewerASCIIUseTabs(*viewer,*flg);
255: }

257: void PETSC_STDCALL petscviewerasciiprintf_(PetscViewer *viewer,CHAR str PETSC_MIXED_LEN(len1),int *ierr PETSC_END_LEN(len1))
258: {
259:   char *c1;

261:   FIXCHAR(str,len1,c1);
262:   *PetscViewerASCIIPrintf(*viewer,c1);
263:   FREECHAR(str,c1);
264: }

266: void PETSC_STDCALL petscviewerasciisynchronizedprintf_(PetscViewer *viewer,CHAR str PETSC_MIXED_LEN(len1),int *ierr PETSC_END_LEN(len1))
267: {
268:   char *c1;

270:   FIXCHAR(str,len1,c1);
271:   *PetscViewerASCIISynchronizedPrintf(*viewer,c1);
272:   FREECHAR(str,c1);
273: }

275: void PETSC_STDCALL petsctrspace_(PetscLogDouble *space,PetscLogDouble *fr,PetscLogDouble *maxs, int *ierr)
276: {
277:   *PetscTrSpace(space,fr,maxs);
278: }

280: void PETSC_STDCALL petscgetresidentsetsize_(PetscLogDouble *foo, int *ierr)
281: {
282:   *PetscGetResidentSetSize(foo);
283: }

285: void PETSC_STDCALL petscoffsetfortran_(PetscScalar *x,PetscScalar *y,int *shift,int *ierr)
286: {
287:   *0;
288:   *shift = y - x;
289: }

291: void PETSC_STDCALL petscgetcputime_(PetscLogDouble *t, int *ierr)
292: {
293:   *PetscGetCPUTime(t);
294: }

296: void PETSC_STDCALL petscfopen_(MPI_Comm *comm,CHAR fname PETSC_MIXED_LEN(len1),CHAR fmode PETSC_MIXED_LEN(len2),
297:                                FILE **file,int *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2))
298: {
299:   char *c1,*c2;

301:   FIXCHAR(fname,len1,c1);
302:   FIXCHAR(fmode,len2,c2);
303:   *PetscFOpen((MPI_Comm)PetscToPointerComm(*comm),c1,c2,file);
304:   FREECHAR(fname,c1);
305:   FREECHAR(fmode,c2);
306: }
307: 
308: void PETSC_STDCALL petscfclose_(MPI_Comm *comm,FILE **file,int *ierr)
309: {
310:   *PetscFClose((MPI_Comm)PetscToPointerComm(*comm),*file);
311: }

313: void PETSC_STDCALL petscsynchronizedflush_(MPI_Comm *comm,int *ierr)
314: {
315:   *PetscSynchronizedFlush((MPI_Comm)PetscToPointerComm(*comm));
316: }

318: void PETSC_STDCALL petscfprintf_(MPI_Comm *comm,FILE **file,CHAR fname PETSC_MIXED_LEN(len1),int *ierr PETSC_END_LEN(len1))
319: {
320:   char *c1;

322:   FIXCHAR(fname,len1,c1);
323:   *PetscFPrintf((MPI_Comm)PetscToPointerComm(*comm),*file,c1);
324:   FREECHAR(fname,c1);
325: }

327: void PETSC_STDCALL petscprintf_(MPI_Comm *comm,CHAR fname PETSC_MIXED_LEN(len1),int *ierr PETSC_END_LEN(len1))
328: {
329:   char *c1;

331:   FIXCHAR(fname,len1,c1);
332:   *PetscPrintf((MPI_Comm)PetscToPointerComm(*comm),c1);
333:   FREECHAR(fname,c1);
334: }

336: void PETSC_STDCALL petscsynchronizedfprintf_(MPI_Comm *comm,FILE **file,CHAR fname PETSC_MIXED_LEN(len1),int *ierr PETSC_END_LEN(len1))
337: {
338:   char *c1;

340:   FIXCHAR(fname,len1,c1);
341:   *PetscSynchronizedFPrintf((MPI_Comm)PetscToPointerComm(*comm),*file,c1);
342:   FREECHAR(fname,c1);
343: }

345: void PETSC_STDCALL petscsynchronizedprintf_(MPI_Comm *comm,CHAR fname PETSC_MIXED_LEN(len1),int *ierr PETSC_END_LEN(len1))
346: {
347:   char *c1;

349:   FIXCHAR(fname,len1,c1);
350:   *PetscSynchronizedPrintf((MPI_Comm)PetscToPointerComm(*comm),c1);
351:   FREECHAR(fname,c1);
352: }

354: void PETSC_STDCALL petscsetfptrap_(PetscFPTrap *flag,int *ierr)
355: {
356:   *PetscSetFPTrap(*flag);
357: }

359: void PETSC_STDCALL petscobjectgetnewtag_(PetscObject *obj,int *tag,int *ierr)
360: {
361:   *PetscObjectGetNewTag(*obj,tag);
362: }

364: void PETSC_STDCALL petsccommgetnewtag_(MPI_Comm *comm,int *tag,int *ierr)
365: {
366:   *PetscCommGetNewTag((MPI_Comm)PetscToPointerComm(*comm),tag);
367: }

369: void PETSC_STDCALL petscsplitownershipblock_(MPI_Comm *comm,int *bs,int *n,int *N,int *ierr)
370: {
371:   *PetscSplitOwnershipBlock((MPI_Comm)PetscToPointerComm(*comm),*bs,n,N);
372: }
373: void PETSC_STDCALL petscsplitownership_(MPI_Comm *comm,int *n,int *N,int *ierr)
374: {
375:   *PetscSplitOwnership((MPI_Comm)PetscToPointerComm(*comm),n,N);
376: }

378: void PETSC_STDCALL petscbarrier_(PetscObject *obj,int *ierr)
379: {
380:   *PetscBarrier(*obj);
381: }

383: void PETSC_STDCALL petscstrncpy_(CHAR s1 PETSC_MIXED_LEN(len1),CHAR s2 PETSC_MIXED_LEN(len2),int *n,
384:                                  int *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2))
385: {
386:   char *t1,*t2;
387:   int  m;

389: #if defined(PETSC_USES_CPTOFCD)
390:   t1 = _fcdtocp(s1);
391:   t2 = _fcdtocp(s2);
392:   m = *n; if (_fcdlen(s1) < m) m = _fcdlen(s1); if (_fcdlen(s2) < m) m = _fcdlen(s2);
393: #else
394:   t1 = s1;
395:   t2 = s2;
396:   m = *n; if (len1 < m) m = len1; if (len2 < m) m = len2;
397: #endif
398:   *PetscStrncpy(t1,t2,m);
399: }

401: void PETSC_STDCALL petscfixfilename_(CHAR filein PETSC_MIXED_LEN(len1),CHAR fileout PETSC_MIXED_LEN(len2),
402:                                      int *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2))
403: {
404:   int  i,n;
405:   char *in,*out;

407: #if defined(PETSC_USES_CPTOFCD)
408:   in  = _fcdtocp(filein);
409:   out = _fcdtocp(fileout);
410:   n   = _fcdlen (filein);
411: #else
412:   in  = filein;
413:   out = fileout;
414:   n   = len1;
415: #endif

417:   for (i=0; i<n; i++) {
418: #if defined(PARCH_win32)
419:     if (in[i] == '/') out[i] = '\\';
420: #else
421:     if (in[i] == '\\') out[i] = '/';
422: #endif
423:     else out[i] = in[i];
424:   }
425:   out[i] = 0;
426: }

428: void PETSC_STDCALL petscbinaryopen_(CHAR name PETSC_MIXED_LEN(len),int *type,int *fd,
429:                                     int *ierr PETSC_END_LEN(len))
430: {
431:   char *c1;

433:   FIXCHAR(name,len,c1);
434:   *PetscBinaryOpen(c1,*type,fd);
435:   FREECHAR(name,c1);
436: }

438: void PETSC_STDCALL petscbinarywrite_(int *fd,void *p,int *n,PetscDataType *type,int *istemp,int *ierr)
439: {
440:   *PetscBinaryWrite(*fd,p,*n,*type,*istemp);
441: }

443: void PETSC_STDCALL petscbinaryread_(int *fd,void *p,int *n,PetscDataType *type,int *ierr)
444: {
445:   *PetscBinaryRead(*fd,p,*n,*type);
446: }

448: void PETSC_STDCALL petscbinaryseek_(int *fd,int *size,PetscBinarySeekType *whence,int *offset,int *ierr)
449: {
450:   *PetscBinarySeek(*fd,*size,*whence,offset);
451: }

453: void PETSC_STDCALL petscbinaryclose_(int *fd,int *ierr)
454: {
455:   *PetscBinaryClose(*fd);
456: }

458: /* ---------------------------------------------------------------------------------*/
459: void PETSC_STDCALL petscmemzero_(void *a,int *n,int *ierr)
460: {
461:   *PetscMemzero(a,*n);
462: }

464: void PETSC_STDCALL petsctrdump_(int *ierr)
465: {
466:   *PetscTrDump(stdout);
467: }
468: void PETSC_STDCALL petsctrlogdump_(int *ierr)
469: {
470:   *PetscTrLogDump(stdout);
471: }

473: void PETSC_STDCALL petscmemcpy_(int *out,int *in,int *length,int *ierr)
474: {
475:   *PetscMemcpy(out,in,*length);
476: }

478: void PETSC_STDCALL petsctrlog_(int *ierr)
479: {
480:   *PetscTrLog();
481: }

483: /*
484:         This version does not do a malloc 
485: */
486: static char FIXCHARSTRING[1024];
487: #if defined(PETSC_USES_CPTOFCD)
488: #include <fortran.h>

490: #define CHAR _fcd
491: #define FIXCHARNOMALLOC(a,n,b) \
492: { \
493:   b = _fcdtocp(a); \
494:   n = _fcdlen (a); \
495:   if (b == PETSC_NULL_CHARACTER_Fortran) { \
496:       b = 0; \
497:   } else {  \
498:     while((n > 0) && (b[n-1] == ' ')) n--; \
499:     b = FIXCHARSTRING; \
500:     *PetscStrncpy(b,_fcdtocp(a),n); \
501:     if (*ierr) return; \
502:     b[n] = 0; \
503:   } \
504: }

506: #else

508: #define CHAR char*
509: #define FIXCHARNOMALLOC(a,n,b) \
510: {\
511:   if (a == PETSC_NULL_CHARACTER_Fortran) { \
512:     b = a = 0; \
513:   } else { \
514:     while((n > 0) && (a[n-1] == ' ')) n--; \
515:     if (a[n] != 0) { \
516:       b = FIXCHARSTRING; \
517:       *PetscStrncpy(b,a,n); \
518:       if (*ierr) return; \
519:       b[n] = 0; \
520:     } else b = a;\
521:   } \
522: }

524: #endif

526: void PETSC_STDCALL chkmemfortran_(int *line,CHAR file PETSC_MIXED_LEN(len),int *ierr PETSC_END_LEN(len))
527: {
528:   char *c1;

530:   FIXCHARNOMALLOC(file,len,c1);
531:   *PetscTrValid(*line,"Userfunction",c1," ");
532: }

534: void PETSC_STDCALL petsctrvalid_(int *ierr)
535: {
536:   *PetscTrValid(0,"Unknown Fortran",0,0);
537: }

539: void PETSC_STDCALL petscrandomgetvalue_(PetscRandom *r,PetscScalar *val,int *ierr)
540: {
541:   *PetscRandomGetValue(*r,val);
542: }


545: void PETSC_STDCALL petscobjectgetname_(PetscObject *obj,CHAR name PETSC_MIXED_LEN(len),
546:                                        int *ierr PETSC_END_LEN(len))
547: {
548:   char *tmp;
549:   *PetscObjectGetName(*obj,&tmp);
550: #if defined(PETSC_USES_CPTOFCD)
551:   {
552:   char *t = _fcdtocp(name);
553:   int  len1 = _fcdlen(name);
554:   *PetscStrncpy(t,tmp,len1);if (*ierr) return;
555:   }
556: #else
557:   *PetscStrncpy(name,tmp,len);if (*ierr) return;
558: #endif
559: }

561: void PETSC_STDCALL petscobjectdestroy_(PetscObject *obj,int *ierr)
562: {
563:   *PetscObjectDestroy(*obj);
564: }

566: void PETSC_STDCALL petscobjectgetcomm_(PetscObject *obj,int *comm,int *ierr)
567: {
568:   MPI_Comm c;
569:   *PetscObjectGetComm(*obj,&c);
570:   *(int*)comm = PetscFromPointerComm(c);
571: }

573: void PETSC_STDCALL petscattachdebugger_(int *ierr)
574: {
575:   *PetscAttachDebugger();
576: }

578: void PETSC_STDCALL petscobjectsetname_(PetscObject *obj,CHAR name PETSC_MIXED_LEN(len),
579:                                        int *ierr PETSC_END_LEN(len))
580: {
581:   char *t1;

583:   FIXCHAR(name,len,t1);
584:   *PetscObjectSetName(*obj,t1);
585:   FREECHAR(name,t1);
586: }

588: void PETSC_STDCALL petscerror_(int *number,int *p,CHAR message PETSC_MIXED_LEN(len),
589:                                int *ierr PETSC_END_LEN(len))
590: {
591:   char *t1;
592:   FIXCHAR(message,len,t1);
593:   *PetscError(-1,0,0,0,*number,*p,t1);
594:   FREECHAR(message,t1);
595: }

597: void PETSC_STDCALL petscgetflops_(PetscLogDouble *d,int *ierr)
598: {
599: #if defined(PETSC_USE_LOG)
600:   *PetscGetFlops(d);
601: #else
602:   0;
603:   *d     = 0.0;
604: #endif
605: }

607: void PETSC_STDCALL petscrandomcreate_(MPI_Comm *comm,PetscRandomType *type,PetscRandom *r,int *ierr)
608: {
609:   *PetscRandomCreate((MPI_Comm)PetscToPointerComm(*comm),*type,r);
610: }

612: void PETSC_STDCALL petscrandomdestroy_(PetscRandom *r,int *ierr)
613: {
614:   *PetscRandomDestroy(*r);
615: }

617: void PETSC_STDCALL petscrealview_(int *n,PetscReal *d,int *viwer,int *ierr)
618: {
619:   *PetscRealView(*n,d,0);
620: }

622: void PETSC_STDCALL petscintview_(int *n,int *d,int *viwer,int *ierr)
623: {
624:   *PetscIntView(*n,d,0);
625: }

627: void PETSC_STDCALL petscsequentialphasebegin_(MPI_Comm *comm,int *ng,int *ierr){
628: *PetscSequentialPhaseBegin(
629:         (MPI_Comm)PetscToPointerComm(*comm),*ng);
630: }
631: void PETSC_STDCALL petscsequentialphaseend_(MPI_Comm *comm,int *ng,int *ierr){
632: *PetscSequentialPhaseEnd(
633:         (MPI_Comm)PetscToPointerComm(*comm),*ng);
634: }


637: #if defined(PETSC_HAVE_MATLAB_ENGINE) && !defined(PETSC_USE_COMPLEX) && !defined(PETSC_USE_SINGLE)

639: void PETSC_STDCALL petscmatlabenginecreate_(MPI_Comm *comm,CHAR m PETSC_MIXED_LEN(len),PetscMatlabEngine *e,
640:                                             int *ierr PETSC_END_LEN(len))
641: {
642:   char *ms;

644:   FIXCHAR(m,len,ms);
645:   *PetscMatlabEngineCreate((MPI_Comm)PetscToPointerComm(*comm),ms,e);
646:   FREECHAR(m,ms);
647: }

649: void PETSC_STDCALL petscmatlabenginedestroy_(PetscMatlabEngine *e,int *ierr)
650: {
651:   *PetscMatlabEngineDestroy(*e);
652: }

654: void PETSC_STDCALL petscmatlabengineevaluate_(PetscMatlabEngine *e,CHAR m PETSC_MIXED_LEN(len),
655:                                               int *ierr PETSC_END_LEN(len))
656: {
657:   char *ms;
658:   FIXCHAR(m,len,ms);
659:   *PetscMatlabEngineEvaluate(*e,ms);
660:   FREECHAR(m,ms);
661: }

663: void PETSC_STDCALL petscmatlabengineput_(PetscMatlabEngine *e,PetscObject *o,int *ierr)
664: {
665:   *PetscMatlabEnginePut(*e,*o);
666: }

668: void PETSC_STDCALL petscmatlabengineget_(PetscMatlabEngine *e,PetscObject *o,int *ierr)
669: {
670:   *PetscMatlabEngineGet(*e,*o);
671: }

673: void PETSC_STDCALL petscmatlabengineputarray_(PetscMatlabEngine *e,int *m,int *n,PetscScalar *a,
674:                                               CHAR s PETSC_MIXED_LEN(len),int *ierr PETSC_END_LEN(len))
675: {
676:   char *ms;
677:   FIXCHAR(s,len,ms);
678:   *PetscMatlabEnginePutArray(*e,*m,*n,a,ms);
679:   FREECHAR(s,ms);
680: }

682: void PETSC_STDCALL petscmatlabenginegetarray_(PetscMatlabEngine *e,int *m,int *n,PetscScalar *a,
683:                                               CHAR s PETSC_MIXED_LEN(len),int *ierr PETSC_END_LEN(len))
684: {
685:   char *ms;
686:   FIXCHAR(s,len,ms);
687:   *PetscMatlabEngineGetArray(*e,*m,*n,a,ms);
688:   FREECHAR(s,ms);
689: }

691: #endif
692: /*
693: EXTERN int PetscMatlabEngineGetOutput(PetscMatlabEngine,char **);
694: EXTERN int PetscMatlabEnginePrintOutput(PetscMatlabEngine,FILE*);
695: */

697: EXTERN_C_END