Actual source code: zdmshellf.c

      1: #include <petsc/private/fortranimpl.h>
      2: #include <petscdmshell.h>

      4: #if defined(PETSC_HAVE_FORTRAN_CAPS)
      5:   #define dmshellsetcreatematrix_       DMSHELLSETCREATEMATRIX
      6:   #define dmshellsetcreateglobalvector_ DMSHELLSETCREATEGLOBALVECTOR_
      7:   #define dmshellsetcreatelocalvector_  DMSHELLSETCREATELOCALVECTOR_
      8:   #define dmshellsetglobaltolocal_      DMSHELLSETGLOBALTOLOCAL_
      9:   #define dmshellsetlocaltoglobal_      DMSHELLSETLOCALTOGLOBAL_
     10:   #define dmshellsetlocaltolocal_       DMSHELLSETLOCALTOLOCAL_
     11: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
     12:   #define dmshellsetcreatematrix_       dmshellsetcreatematrix
     13:   #define dmshellsetcreateglobalvector_ dmshellsetcreateglobalvector
     14:   #define dmshellsetcreatelocalvector_  dmshellsetcreatelocalvector
     15:   #define dmshellsetglobaltolocal_      dmshellsetglobaltolocal
     16:   #define dmshellsetlocaltoglobal_      dmshellsetlocaltoglobal
     17:   #define dmshellsetlocaltolocal_       dmshellsetlocaltolocal_
     18: #endif

     20: /*
     21:  * C routines are required for matrix and global vector creation.  We define C routines here that call the corresponding
     22:  * Fortran routine (indexed by _cb) that was set by the user.
     23:  */

     25: static struct {
     26:   PetscFortranCallbackId creatematrix;
     27:   PetscFortranCallbackId createglobalvector;
     28:   PetscFortranCallbackId createlocalvector;
     29:   PetscFortranCallbackId globaltolocalbegin;
     30:   PetscFortranCallbackId globaltolocalend;
     31:   PetscFortranCallbackId localtoglobalbegin;
     32:   PetscFortranCallbackId localtoglobalend;
     33:   PetscFortranCallbackId localtolocalbegin;
     34:   PetscFortranCallbackId localtolocalend;
     35: } _cb;

     37: static PetscErrorCode ourcreatematrix(DM dm, Mat *A)
     38: {
     39:   PetscObjectUseFortranCallbackSubType(dm, _cb.creatematrix, (DM *, Mat *, PetscErrorCode *), (&dm, A, &ierr));
     40: }

     42: static PetscErrorCode ourcreateglobalvector(DM dm, Vec *v)
     43: {
     44:   PetscObjectUseFortranCallbackSubType(dm, _cb.createglobalvector, (DM *, Vec *, PetscErrorCode *), (&dm, v, &ierr));
     45: }

     47: static PetscErrorCode ourcreatelocalvector(DM dm, Vec *v)
     48: {
     49:   PetscObjectUseFortranCallbackSubType(dm, _cb.createlocalvector, (DM *, Vec *, PetscErrorCode *), (&dm, v, &ierr));
     50: }

     52: static PetscErrorCode ourglobaltolocalbegin(DM dm, Vec g, InsertMode mode, Vec l)
     53: {
     54:   PetscObjectUseFortranCallbackSubType(dm, _cb.globaltolocalbegin, (DM *, Vec *, InsertMode *, Vec *, PetscErrorCode *), (&dm, &g, &mode, &l, &ierr));
     55: }

     57: static PetscErrorCode ourglobaltolocalend(DM dm, Vec g, InsertMode mode, Vec l)
     58: {
     59:   PetscObjectUseFortranCallbackSubType(dm, _cb.globaltolocalend, (DM *, Vec *, InsertMode *, Vec *, PetscErrorCode *), (&dm, &g, &mode, &l, &ierr));
     60: }

     62: static PetscErrorCode ourlocaltoglobalbegin(DM dm, Vec l, InsertMode mode, Vec g)
     63: {
     64:   PetscObjectUseFortranCallbackSubType(dm, _cb.localtoglobalbegin, (DM *, Vec *, InsertMode *, Vec *, PetscErrorCode *), (&dm, &l, &mode, &g, &ierr));
     65: }

     67: static PetscErrorCode ourlocaltoglobalend(DM dm, Vec l, InsertMode mode, Vec g)
     68: {
     69:   PetscObjectUseFortranCallbackSubType(dm, _cb.localtoglobalend, (DM *, Vec *, InsertMode *, Vec *, PetscErrorCode *), (&dm, &l, &mode, &g, &ierr));
     70: }

     72: static PetscErrorCode ourlocaltolocalbegin(DM dm, Vec g, InsertMode mode, Vec l)
     73: {
     74:   PetscObjectUseFortranCallbackSubType(dm, _cb.localtolocalbegin, (DM *, Vec *, InsertMode *, Vec *, PetscErrorCode *), (&dm, &g, &mode, &l, &ierr));
     75: }

     77: static PetscErrorCode ourlocaltolocalend(DM dm, Vec g, InsertMode mode, Vec l)
     78: {
     79:   PetscObjectUseFortranCallbackSubType(dm, _cb.localtolocalend, (DM *, Vec *, InsertMode *, Vec *, PetscErrorCode *), (&dm, &g, &mode, &l, &ierr));
     80: }

     82: PETSC_EXTERN void dmshellsetcreatematrix_(DM *dm, void (*func)(DM *, Mat *, PetscErrorCode *, PETSC_FORTRAN_CHARLEN_T len), PetscErrorCode *ierr)
     83: {
     84:   *ierr = PetscObjectSetFortranCallback((PetscObject)*dm, PETSC_FORTRAN_CALLBACK_SUBTYPE, &_cb.creatematrix, (PetscVoidFn *)func, NULL);
     85:   if (*ierr) return;
     86:   *ierr = DMShellSetCreateMatrix(*dm, ourcreatematrix);
     87: }

     89: PETSC_EXTERN void dmshellsetcreateglobalvector_(DM *dm, void (*func)(DM *, Vec *, PetscErrorCode *), PetscErrorCode *ierr)
     90: {
     91:   *ierr = PetscObjectSetFortranCallback((PetscObject)*dm, PETSC_FORTRAN_CALLBACK_SUBTYPE, &_cb.createglobalvector, (PetscVoidFn *)func, NULL);
     92:   if (*ierr) return;
     93:   *ierr = DMShellSetCreateGlobalVector(*dm, ourcreateglobalvector);
     94: }

     96: PETSC_EXTERN void dmshellsetcreatelocalvector_(DM *dm, void (*func)(DM *, Vec *, PetscErrorCode *), PetscErrorCode *ierr)
     97: {
     98:   *ierr = PetscObjectSetFortranCallback((PetscObject)*dm, PETSC_FORTRAN_CALLBACK_SUBTYPE, &_cb.createlocalvector, (PetscVoidFn *)func, NULL);
     99:   if (*ierr) return;
    100:   *ierr = DMShellSetCreateLocalVector(*dm, ourcreatelocalvector);
    101: }

    103: PETSC_EXTERN void dmshellsetglobaltolocal_(DM *dm, void (*begin)(DM *, Vec *, InsertMode *, Vec *, PetscErrorCode *), void (*end)(DM *, Vec *, InsertMode *, Vec *, PetscErrorCode *), PetscErrorCode *ierr)
    104: {
    105:   *ierr = PetscObjectSetFortranCallback((PetscObject)*dm, PETSC_FORTRAN_CALLBACK_SUBTYPE, &_cb.globaltolocalbegin, (PetscVoidFn *)begin, NULL);
    106:   if (*ierr) return;
    107:   *ierr = PetscObjectSetFortranCallback((PetscObject)*dm, PETSC_FORTRAN_CALLBACK_SUBTYPE, &_cb.globaltolocalend, (PetscVoidFn *)end, NULL);
    108:   if (*ierr) return;
    109:   *ierr = DMShellSetGlobalToLocal(*dm, ourglobaltolocalbegin, ourglobaltolocalend);
    110: }

    112: PETSC_EXTERN void dmshellsetlocaltoglobal_(DM *dm, void (*begin)(DM *, Vec *, InsertMode *, Vec *, PetscErrorCode *), void (*end)(DM *, Vec *, InsertMode *, Vec *, PetscErrorCode *), PetscErrorCode *ierr)
    113: {
    114:   *ierr = PetscObjectSetFortranCallback((PetscObject)*dm, PETSC_FORTRAN_CALLBACK_SUBTYPE, &_cb.localtoglobalbegin, (PetscVoidFn *)begin, NULL);
    115:   if (*ierr) return;
    116:   *ierr = PetscObjectSetFortranCallback((PetscObject)*dm, PETSC_FORTRAN_CALLBACK_SUBTYPE, &_cb.localtoglobalend, (PetscVoidFn *)end, NULL);
    117:   if (*ierr) return;
    118:   *ierr = DMShellSetLocalToGlobal(*dm, ourlocaltoglobalbegin, ourlocaltoglobalend);
    119: }

    121: PETSC_EXTERN void dmshellsetlocaltolocal_(DM *dm, void (*begin)(DM *, Vec *, InsertMode *, Vec *, PetscErrorCode *), void (*end)(DM *, Vec *, InsertMode *, Vec *, PetscErrorCode *), PetscErrorCode *ierr)
    122: {
    123:   *ierr = PetscObjectSetFortranCallback((PetscObject)*dm, PETSC_FORTRAN_CALLBACK_SUBTYPE, &_cb.localtolocalbegin, (PetscVoidFn *)begin, NULL);
    124:   if (*ierr) return;
    125:   *ierr = PetscObjectSetFortranCallback((PetscObject)*dm, PETSC_FORTRAN_CALLBACK_SUBTYPE, &_cb.localtolocalend, (PetscVoidFn *)end, NULL);
    126:   if (*ierr) return;
    127:   *ierr = DMShellSetLocalToLocal(*dm, ourlocaltolocalbegin, ourlocaltolocalend);
    128: }