Actual source code: zbagf90.c

      1: #include <petsc/private/f90impl.h>
      2: #include <petsc/private/fortranimpl.h>
      3: #include <petscbag.h>
      4: #include <petsc/private/bagimpl.h>
      5: #include <petscviewer.h>

      7: #if defined(PETSC_HAVE_FORTRAN_CAPS)
      8:   #define petscbaggetdata_           PETSCBAGGETDATA
      9:   #define petscbagregisterint_       PETSCBAGREGISTERINT
     10:   #define petscbagregisterint64_     PETSCBAGREGISTERINT64
     11:   #define petscbagregisterintarray_  PETSCBAGREGISTERINTARRAY
     12:   #define petscbagregisterscalar_    PETSCBAGREGISTERSCALAR
     13:   #define petscbagregisterstring_    PETSCBAGREGISTERSTRING
     14:   #define petscbagregisterreal_      PETSCBAGREGISTERREAL
     15:   #define petscbagregisterrealarray_ PETSCBAGREGISTERREALARRAY
     16:   #define petscbagregisterbool_      PETSCBAGREGISTERBOOL
     17:   #define petscbagregisterboolarray_ PETSCBAGREGISTERBOOLARRAY
     18:   #define petscbagcreate_            PETSCBAGCREATE
     19: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
     20:   #define petscbaggetdata_           petscbaggetdata
     21:   #define petscbagregisterint_       petscbagregisterint
     22:   #define petscbagregisterint64_     petscbagregisterint64
     23:   #define petscbagregisterintarray_  petscbagregisterintarray
     24:   #define petscbagregisterscalar_    petscbagregisterscalar
     25:   #define petscbagregisterstring_    petscbagregisterstring
     26:   #define petscbagregisterreal_      petscbagregisterreal
     27:   #define petscbagregisterrealarray_ petscbagregisterrealarray
     28:   #define petscbagregisterbool_      petscbagregisterbool
     29:   #define petscbagregisterboolarray_ petscbagregisterboolarray
     30:   #define petscbagcreate_            petscbagcreate
     31: #endif

     33: PETSC_EXTERN void petscbagcreate_(MPI_Fint *comm, size_t *bagsize, PetscBag *bag, PetscErrorCode *ierr)
     34: {
     35:   *ierr = PetscBagCreate(MPI_Comm_f2c(*(comm)), *bagsize, bag);
     36: }

     38: PETSC_EXTERN void petscbagregisterint_(PetscBag *bag, void *ptr, PetscInt *def, char *s1, char *s2, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T l1, PETSC_FORTRAN_CHARLEN_T l2)
     39: {
     40:   char *t1, *t2;
     41:   FIXCHAR(s1, l1, t1);
     42:   FIXCHAR(s2, l2, t2);
     43:   *ierr = PetscBagRegisterInt(*bag, ptr, *def, t1, t2);
     44:   if (*ierr) return;
     45:   FREECHAR(s1, t1);
     46:   FREECHAR(s2, t2);
     47: }

     49: PETSC_EXTERN void petscbagregisterint64_(PetscBag *bag, void *ptr, PetscInt64 *def, char *s1, char *s2, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T l1, PETSC_FORTRAN_CHARLEN_T l2)
     50: {
     51:   char *t1, *t2;
     52:   FIXCHAR(s1, l1, t1);
     53:   FIXCHAR(s2, l2, t2);
     54:   *ierr = PetscBagRegisterInt64(*bag, ptr, *def, t1, t2);
     55:   if (*ierr) return;
     56:   FREECHAR(s1, t1);
     57:   FREECHAR(s2, t2);
     58: }

     60: PETSC_EXTERN void petscbagregisterintarray_(PetscBag *bag, void *ptr, PetscInt *msize, char *s1, char *s2, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T l1, PETSC_FORTRAN_CHARLEN_T l2)
     61: {
     62:   char *t1, *t2;
     63:   FIXCHAR(s1, l1, t1);
     64:   FIXCHAR(s2, l2, t2);
     65:   *ierr = PetscBagRegisterIntArray(*bag, ptr, *msize, t1, t2);
     66:   if (*ierr) return;
     67:   FREECHAR(s1, t1);
     68:   FREECHAR(s2, t2);
     69: }

     71: PETSC_EXTERN void petscbagregisterscalar_(PetscBag *bag, void *ptr, PetscScalar *def, char *s1, char *s2, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T l1, PETSC_FORTRAN_CHARLEN_T l2)
     72: {
     73:   char *t1, *t2;
     74:   FIXCHAR(s1, l1, t1);
     75:   FIXCHAR(s2, l2, t2);
     76:   *ierr = PetscBagRegisterScalar(*bag, ptr, *def, t1, t2);
     77:   if (*ierr) return;
     78:   FREECHAR(s1, t1);
     79:   FREECHAR(s2, t2);
     80: }

     82: PETSC_EXTERN void petscbagregisterreal_(PetscBag *bag, void *ptr, PetscReal *def, char *s1, char *s2, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T l1, PETSC_FORTRAN_CHARLEN_T l2)
     83: {
     84:   char *t1, *t2;
     85:   FIXCHAR(s1, l1, t1);
     86:   FIXCHAR(s2, l2, t2);
     87:   *ierr = PetscBagRegisterReal(*bag, ptr, *def, t1, t2);
     88:   if (*ierr) return;
     89:   FREECHAR(s1, t1);
     90:   FREECHAR(s2, t2);
     91: }

     93: PETSC_EXTERN void petscbagregisterrealarray_(PetscBag *bag, void *ptr, PetscInt *msize, char *s1, char *s2, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T l1, PETSC_FORTRAN_CHARLEN_T l2)
     94: {
     95:   char *t1, *t2;
     96:   FIXCHAR(s1, l1, t1);
     97:   FIXCHAR(s2, l2, t2);
     98:   *ierr = PetscBagRegisterRealArray(*bag, ptr, *msize, t1, t2);
     99:   if (*ierr) return;
    100:   FREECHAR(s1, t1);
    101:   FREECHAR(s2, t2);
    102: }

    104: PETSC_EXTERN void petscbagregisterbool_(PetscBag *bag, void *ptr, PetscBool *def, char *s1, char *s2, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T l1, PETSC_FORTRAN_CHARLEN_T l2)
    105: {
    106:   char     *t1, *t2;
    107:   PetscBool flg = PETSC_FALSE;

    109:   /* some Fortran compilers use -1 as boolean */
    110:   if (*def) flg = PETSC_TRUE;
    111:   FIXCHAR(s1, l1, t1);
    112:   FIXCHAR(s2, l2, t2);
    113:   *ierr = PetscBagRegisterBool(*bag, ptr, flg, t1, t2);
    114:   if (*ierr) return;
    115:   FREECHAR(s1, t1);
    116:   FREECHAR(s2, t2);
    117: }

    119: PETSC_EXTERN void petscbagregisterboolarray_(PetscBag *bag, void *ptr, PetscInt *msize, char *s1, char *s2, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T l1, PETSC_FORTRAN_CHARLEN_T l2)
    120: {
    121:   char *t1, *t2;

    123:   /* some Fortran compilers use -1 as boolean */
    124:   FIXCHAR(s1, l1, t1);
    125:   FIXCHAR(s2, l2, t2);
    126:   *ierr = PetscBagRegisterBoolArray(*bag, ptr, *msize, t1, t2);
    127:   if (*ierr) return;
    128:   FREECHAR(s1, t1);
    129:   FREECHAR(s2, t2);
    130: }

    132: PETSC_EXTERN void petscbagregisterstring_(PetscBag *bag, char *p, char *cs1, char *s1, char *s2, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T pl, PETSC_FORTRAN_CHARLEN_T cl1, PETSC_FORTRAN_CHARLEN_T l1, PETSC_FORTRAN_CHARLEN_T l2)
    133: {
    134:   char *t1, *t2, *ct1;
    135:   FIXCHAR(s1, l1, t1);
    136:   FIXCHAR(cs1, cl1, ct1);
    137:   FIXCHAR(s2, l2, t2);
    138:   *ierr = PetscBagRegisterString(*bag, (void *)p, (PetscInt)pl, ct1, t1, t2);
    139:   if (*ierr) return;
    140:   FREECHAR(cs1, ct1);
    141:   FREECHAR(s1, t1);
    142:   FREECHAR(s2, t2);
    143: }

    145: PETSC_EXTERN void petscbaggetdata_(PetscBag *bag, void **data, PetscErrorCode *ierr)
    146: {
    147:   *ierr = PetscBagGetData(*bag, data);
    148: }