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