Date: 2022-03-31T04:46:18+00:00

Actual source code: f90_cwrap.c

      1: #include <petsc/private/f90impl.h>

      3: /*@C

      5:    PetscMPIFortranDatatypeToC - Converts a MPI_Fint that contains a Fortran MPI_Datatype to its C MPI_Datatype equivalent

      7:    Not Collective

      9:    Input Parameter:
     10: .  unit - The Fortran MPI_Datatype

     12:    Output Parameter:
     13: .  dtype - the corresponding C MPI_Datatype

     15:    Level: developer

     17:    Developer Notes:
     18:     The MPI documentation in multiple places says that one can never us
     19:    Fortran MPI_Datatypes in C (or vis-versa) but this is problematic since users could never
     20:    call C routines from Fortran that have MPI_Datatype arguments. Jed states that the Fortran
     21:    MPI_Datatypes will always be available in C if the MPI was built to support Fortran. This function
     22:    relies on this.
     23: @*/
     24: PetscErrorCode PetscMPIFortranDatatypeToC(MPI_Fint unit,MPI_Datatype *dtype)
     25: {
     26:   MPI_Datatype ftype;

     28:   ftype = MPI_Type_f2c(unit);
     29:   if (ftype == MPI_INTEGER || ftype == MPI_INT) *dtype = MPI_INT;
     30:   else if (ftype == MPI_INTEGER8 || ftype == MPIU_INT64) *dtype = MPIU_INT64;
     31:   else if (ftype == MPI_DOUBLE_PRECISION|| ftype == MPI_DOUBLE) *dtype = MPI_DOUBLE;
     32: #if defined(PETSC_HAVE_COMPLEX)
     33:   else if (ftype == MPI_COMPLEX16 || ftype ==  MPI_C_DOUBLE_COMPLEX) *dtype = MPI_C_DOUBLE_COMPLEX;
     34: #endif
     35:   else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Unknown Fortran MPI_Datatype");
     36:   return 0;
     37: }

     39: /*************************************************************************/

     41: #if defined(PETSC_HAVE_FORTRAN_CAPS)
     42: #define f90array1dcreatescalar_           F90ARRAY1DCREATESCALAR
     43: #define f90array1daccessscalar_           F90ARRAY1DACCESSSCALAR
     44: #define f90array1ddestroyscalar_          F90ARRAY1DDESTROYSCALAR
     45: #define f90array1dcreatereal_             F90ARRAY1DCREATEREAL
     46: #define f90array1daccessreal_             F90ARRAY1DACCESSREAL
     47: #define f90array1ddestroyreal_            F90ARRAY1DDESTROYREAL
     48: #define f90array1dcreateint_              F90ARRAY1DCREATEINT
     49: #define f90array1daccessint_              F90ARRAY1DACCESSINT
     50: #define f90array1ddestroyint_             F90ARRAY1DDESTROYINT
     51: #define f90array1dcreatefortranaddr_      F90ARRAY1DCREATEFORTRANADDR
     52: #define f90array1daccessfortranaddr_      F90ARRAY1DACCESSFORTRANADDR
     53: #define f90array1ddestroyfortranaddr_     F90ARRAY1DDESTROYFORTRANADDR
     54: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
     55: #define f90array1dcreatescalar_           f90array1dcreatescalar
     56: #define f90array1daccessscalar_           f90array1daccessscalar
     57: #define f90array1ddestroyscalar_          f90array1ddestroyscalar
     58: #define f90array1dcreatereal_             f90array1dcreatereal
     59: #define f90array1daccessreal_             f90array1daccessreal
     60: #define f90array1ddestroyreal_            f90array1ddestroyreal
     61: #define f90array1dcreateint_              f90array1dcreateint
     62: #define f90array1daccessint_              f90array1daccessint
     63: #define f90array1ddestroyint_             f90array1ddestroyint
     64: #define f90array1dcreatefortranaddr_      f90array1dcreatefortranaddr
     65: #define f90array1daccessfortranaddr_      f90array1daccessfortranaddr
     66: #define f90array1ddestroyfortranaddr_     f90array1ddestroyfortranaddr
     67: #endif

     69: PETSC_EXTERN void f90array1dcreatescalar_(void *,PetscInt *,PetscInt *,F90Array1d * PETSC_F90_2PTR_PROTO_NOVAR);
     70: PETSC_EXTERN void f90array1daccessscalar_(F90Array1d*,void** PETSC_F90_2PTR_PROTO_NOVAR);
     71: PETSC_EXTERN void f90array1ddestroyscalar_(F90Array1d *ptr PETSC_F90_2PTR_PROTO_NOVAR);
     72: PETSC_EXTERN void f90array1dcreatereal_(void *,PetscInt *,PetscInt *,F90Array1d * PETSC_F90_2PTR_PROTO_NOVAR);
     73: PETSC_EXTERN void f90array1daccessreal_(F90Array1d*,void** PETSC_F90_2PTR_PROTO_NOVAR);
     74: PETSC_EXTERN void f90array1ddestroyreal_(F90Array1d *ptr PETSC_F90_2PTR_PROTO_NOVAR);
     75: PETSC_EXTERN void f90array1dcreateint_(void *,PetscInt *,PetscInt *,F90Array1d * PETSC_F90_2PTR_PROTO_NOVAR);
     76: PETSC_EXTERN void f90array1daccessint_(F90Array1d*,void** PETSC_F90_2PTR_PROTO_NOVAR);
     77: PETSC_EXTERN void f90array1ddestroyint_(F90Array1d *ptr PETSC_F90_2PTR_PROTO_NOVAR);
     78: PETSC_EXTERN void f90array1dcreatefortranaddr_(void *,PetscInt *,PetscInt *,F90Array1d * PETSC_F90_2PTR_PROTO_NOVAR);
     79: PETSC_EXTERN void f90array1daccessfortranaddr_(F90Array1d*,void** PETSC_F90_2PTR_PROTO_NOVAR);
     80: PETSC_EXTERN void f90array1ddestroyfortranaddr_(F90Array1d *ptr PETSC_F90_2PTR_PROTO_NOVAR);

     82: PetscErrorCode F90Array1dCreate(void *array,MPI_Datatype type,PetscInt start,PetscInt len,F90Array1d *ptr PETSC_F90_2PTR_PROTO(ptrd))
     83: {
     84:   if (type == MPIU_SCALAR) {
     85:     if (!len) array = PETSC_NULL_SCALAR_Fortran;
     86:     f90array1dcreatescalar_(array,&start,&len,ptr PETSC_F90_2PTR_PARAM(ptrd));
     87:   } else if (type == MPIU_REAL) {
     88:     if (!len) array = PETSC_NULL_REAL_Fortran;
     89:     f90array1dcreatereal_(array,&start,&len,ptr PETSC_F90_2PTR_PARAM(ptrd));
     90:   } else if (type == MPIU_INT) {
     91:     if (!len) array = PETSC_NULL_INTEGER_Fortran;
     92:     f90array1dcreateint_(array,&start,&len,ptr PETSC_F90_2PTR_PARAM(ptrd));
     93:   } else if (type == MPIU_FORTRANADDR) {
     94:     f90array1dcreatefortranaddr_(array,&start,&len,ptr PETSC_F90_2PTR_PARAM(ptrd));
     95:   } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Unsupported MPI_Datatype");
     96:   return 0;
     97: }

     99: PetscErrorCode  F90Array1dAccess(F90Array1d *ptr,MPI_Datatype type,void **array PETSC_F90_2PTR_PROTO(ptrd))
    100: {
    101:   if (type == MPIU_SCALAR) {
    102:     f90array1daccessscalar_(ptr,array PETSC_F90_2PTR_PARAM(ptrd));
    103:     if (*array == PETSC_NULL_SCALAR_Fortran) *array = 0;
    104:   } else if (type == MPIU_REAL) {
    105:     f90array1daccessreal_(ptr,array PETSC_F90_2PTR_PARAM(ptrd));
    106:     if (*array == PETSC_NULL_REAL_Fortran) *array = 0;
    107:   } else if (type == MPIU_INT) {
    108:     f90array1daccessint_(ptr,array PETSC_F90_2PTR_PARAM(ptrd));
    109:     if (*array == PETSC_NULL_INTEGER_Fortran) *array = 0;
    110:   } else if (type == MPIU_FORTRANADDR) {
    111:     f90array1daccessfortranaddr_(ptr,array PETSC_F90_2PTR_PARAM(ptrd));
    112:   } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Unsupported MPI_Datatype");
    113:   return 0;
    114: }

    116: PetscErrorCode  F90Array1dDestroy(F90Array1d *ptr,MPI_Datatype type PETSC_F90_2PTR_PROTO(ptrd))
    117: {
    118:   if (type == MPIU_SCALAR) {
    119:     f90array1ddestroyscalar_(ptr PETSC_F90_2PTR_PARAM(ptrd));
    120:   } else if (type == MPIU_REAL) {
    121:     f90array1ddestroyreal_(ptr PETSC_F90_2PTR_PARAM(ptrd));
    122:   } else if (type == MPIU_INT) {
    123:     f90array1ddestroyint_(ptr PETSC_F90_2PTR_PARAM(ptrd));
    124:   } else if (type == MPIU_FORTRANADDR) {
    125:     f90array1ddestroyfortranaddr_(ptr PETSC_F90_2PTR_PARAM(ptrd));
    126:   } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Unsupported MPI_Datatype");
    127:   return 0;
    128: }

    130: /*************************************************************************/

    132: #if defined(PETSC_HAVE_FORTRAN_CAPS)
    133: #define f90array2dcreatescalar_           F90ARRAY2DCREATESCALAR
    134: #define f90array2daccessscalar_           F90ARRAY2DACCESSSCALAR
    135: #define f90array2ddestroyscalar_          F90ARRAY2DDESTROYSCALAR
    136: #define f90array2dcreatereal_             F90ARRAY2DCREATEREAL
    137: #define f90array2daccessreal_             F90ARRAY2DACCESSREAL
    138: #define f90array2ddestroyreal_            F90ARRAY2DDESTROYREAL
    139: #define f90array2dcreateint_              F90ARRAY2DCREATEINT
    140: #define f90array2daccessint_              F90ARRAY2DACCESSINT
    141: #define f90array2ddestroyint_             F90ARRAY2DDESTROYINT
    142: #define f90array2dcreatefortranaddr_      F90ARRAY2DCREATEFORTRANADDR
    143: #define f90array2daccessfortranaddr_      F90ARRAY2DACCESSFORTRANADDR
    144: #define f90array2ddestroyfortranaddr_     F90ARRAY2DDESTROYFORTRANADDR
    145: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
    146: #define f90array2dcreatescalar_           f90array2dcreatescalar
    147: #define f90array2daccessscalar_           f90array2daccessscalar
    148: #define f90array2ddestroyscalar_          f90array2ddestroyscalar
    149: #define f90array2dcreatereal_             f90array2dcreatereal
    150: #define f90array2daccessreal_             f90array2daccessreal
    151: #define f90array2ddestroyreal_            f90array2ddestroyreal
    152: #define f90array2dcreateint_              f90array2dcreateint
    153: #define f90array2daccessint_              f90array2daccessint
    154: #define f90array2ddestroyint_             f90array2ddestroyint
    155: #define f90array2dcreatefortranaddr_      f90array2dcreatefortranaddr
    156: #define f90array2daccessfortranaddr_      f90array2daccessfortranaddr
    157: #define f90array2ddestroyfortranaddr_     f90array2ddestroyfortranaddr
    158: #endif

    160: PETSC_EXTERN void f90array2dcreatescalar_(void *,PetscInt *,PetscInt *,PetscInt *,PetscInt *,F90Array2d * PETSC_F90_2PTR_PROTO_NOVAR);
    161: PETSC_EXTERN void f90array2daccessscalar_(F90Array2d*,void** PETSC_F90_2PTR_PROTO_NOVAR);
    162: PETSC_EXTERN void f90array2ddestroyscalar_(F90Array2d *ptr PETSC_F90_2PTR_PROTO_NOVAR);
    163: PETSC_EXTERN void f90array2dcreatereal_(void *,PetscInt *,PetscInt *,PetscInt *,PetscInt *,F90Array2d * PETSC_F90_2PTR_PROTO_NOVAR);
    164: PETSC_EXTERN void f90array2daccessreal_(F90Array2d*,void** PETSC_F90_2PTR_PROTO_NOVAR);
    165: PETSC_EXTERN void f90array2ddestroyreal_(F90Array2d *ptr PETSC_F90_2PTR_PROTO_NOVAR);
    166: PETSC_EXTERN void f90array2dcreateint_(void *,PetscInt *,PetscInt *,PetscInt *,PetscInt *,F90Array2d * PETSC_F90_2PTR_PROTO_NOVAR);
    167: PETSC_EXTERN void f90array2daccessint_(F90Array2d*,void** PETSC_F90_2PTR_PROTO_NOVAR);
    168: PETSC_EXTERN void f90array2ddestroyint_(F90Array2d *ptr PETSC_F90_2PTR_PROTO_NOVAR);
    169: PETSC_EXTERN void f90array2dcreatefortranaddr_(void *,PetscInt *,PetscInt *,PetscInt *,PetscInt *,F90Array2d * PETSC_F90_2PTR_PROTO_NOVAR);
    170: PETSC_EXTERN void f90array2daccessfortranaddr_(F90Array2d*,void** PETSC_F90_2PTR_PROTO_NOVAR);
    171: PETSC_EXTERN void f90array2ddestroyfortranaddr_(F90Array2d *ptr PETSC_F90_2PTR_PROTO_NOVAR);

    173: PetscErrorCode F90Array2dCreate(void *array,MPI_Datatype type,PetscInt start1,PetscInt len1,PetscInt start2,PetscInt len2,F90Array2d *ptr PETSC_F90_2PTR_PROTO(ptrd))
    174: {
    175:   if (type == MPIU_SCALAR) {
    176:     f90array2dcreatescalar_(array,&start1,&len1,&start2,&len2,ptr PETSC_F90_2PTR_PARAM(ptrd));
    177:   } else if (type == MPIU_REAL) {
    178:     f90array2dcreatereal_(array,&start1,&len1,&start2,&len2,ptr PETSC_F90_2PTR_PARAM(ptrd));
    179:   } else if (type == MPIU_INT) {
    180:     f90array2dcreateint_(array,&start1,&len1,&start2,&len2,ptr PETSC_F90_2PTR_PARAM(ptrd));
    181:   } else if (type == MPIU_FORTRANADDR) {
    182:     f90array2dcreatefortranaddr_(array,&start1,&len1,&start2,&len2,ptr PETSC_F90_2PTR_PARAM(ptrd));
    183:   } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Unsupported MPI_Datatype");
    184:   return 0;
    185: }

    187: PetscErrorCode  F90Array2dAccess(F90Array2d *ptr,MPI_Datatype type,void **array PETSC_F90_2PTR_PROTO(ptrd))
    188: {
    189:   if (type == MPIU_SCALAR) {
    190:     f90array2daccessscalar_(ptr,array PETSC_F90_2PTR_PARAM(ptrd));
    191:   } else if (type == MPIU_REAL) {
    192:     f90array2daccessreal_(ptr,array PETSC_F90_2PTR_PARAM(ptrd));
    193:   } else if (type == MPIU_INT) {
    194:     f90array2daccessint_(ptr,array PETSC_F90_2PTR_PARAM(ptrd));
    195:   } else if (type == MPIU_FORTRANADDR) {
    196:     f90array2daccessfortranaddr_(ptr,array PETSC_F90_2PTR_PARAM(ptrd));
    197:   } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Unsupported MPI_Datatype");
    198:   return 0;
    199: }

    201: PetscErrorCode  F90Array2dDestroy(F90Array2d *ptr,MPI_Datatype type PETSC_F90_2PTR_PROTO(ptrd))
    202: {
    203:   if (type == MPIU_SCALAR) {
    204:     f90array2ddestroyscalar_(ptr PETSC_F90_2PTR_PARAM(ptrd));
    205:   } else if (type == MPIU_REAL) {
    206:     f90array2ddestroyreal_(ptr PETSC_F90_2PTR_PARAM(ptrd));
    207:   } else if (type == MPIU_INT) {
    208:     f90array2ddestroyint_(ptr PETSC_F90_2PTR_PARAM(ptrd));
    209:   } else if (type == MPIU_FORTRANADDR) {
    210:     f90array2ddestroyfortranaddr_(ptr PETSC_F90_2PTR_PARAM(ptrd));
    211:   } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Unsupported MPI_Datatype");
    212:   return 0;
    213: }

    215: /*************************************************************************/

    217: #if defined(PETSC_HAVE_FORTRAN_CAPS)
    218: #define f90array3dcreatescalar_           F90ARRAY3DCREATESCALAR
    219: #define f90array3daccessscalar_           F90ARRAY3DACCESSSCALAR
    220: #define f90array3ddestroyscalar_          F90ARRAY3DDESTROYSCALAR
    221: #define f90array3dcreatereal_             F90ARRAY3DCREATEREAL
    222: #define f90array3daccessreal_             F90ARRAY3DACCESSREAL
    223: #define f90array3ddestroyreal_            F90ARRAY3DDESTROYREAL
    224: #define f90array3dcreateint_              F90ARRAY3DCREATEINT
    225: #define f90array3daccessint_              F90ARRAY3DACCESSINT
    226: #define f90array3ddestroyint_             F90ARRAY3DDESTROYINT
    227: #define f90array3dcreatefortranaddr_      F90ARRAY3DCREATEFORTRANADDR
    228: #define f90array3daccessfortranaddr_      F90ARRAY3DACCESSFORTRANADDR
    229: #define f90array3ddestroyfortranaddr_     F90ARRAY3DDESTROYFORTRANADDR
    230: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
    231: #define f90array3dcreatescalar_           f90array3dcreatescalar
    232: #define f90array3daccessscalar_           f90array3daccessscalar
    233: #define f90array3ddestroyscalar_          f90array3ddestroyscalar
    234: #define f90array3dcreatereal_             f90array3dcreatereal
    235: #define f90array3daccessreal_             f90array3daccessreal
    236: #define f90array3ddestroyreal_            f90array3ddestroyreal
    237: #define f90array3dcreateint_              f90array3dcreateint
    238: #define f90array3daccessint_              f90array3daccessint
    239: #define f90array3ddestroyint_             f90array3ddestroyint
    240: #define f90array3dcreatefortranaddr_      f90array3dcreatefortranaddr
    241: #define f90array3daccessfortranaddr_      f90array3daccessfortranaddr
    242: #define f90array3ddestroyfortranaddr_     f90array3ddestroyfortranaddr
    243: #endif

    245: PETSC_EXTERN void f90array3dcreatescalar_(void *,PetscInt *,PetscInt *,PetscInt *,PetscInt *,PetscInt *,PetscInt *,F90Array3d * PETSC_F90_2PTR_PROTO_NOVAR);
    246: PETSC_EXTERN void f90array3daccessscalar_(F90Array3d*,void** PETSC_F90_2PTR_PROTO_NOVAR);
    247: PETSC_EXTERN void f90array3ddestroyscalar_(F90Array3d *ptr PETSC_F90_2PTR_PROTO_NOVAR);
    248: PETSC_EXTERN void f90array3dcreatereal_(void *,PetscInt *,PetscInt *,PetscInt *,PetscInt *,PetscInt *,PetscInt *,F90Array3d * PETSC_F90_2PTR_PROTO_NOVAR);
    249: PETSC_EXTERN void f90array3daccessreal_(F90Array3d*,void** PETSC_F90_2PTR_PROTO_NOVAR);
    250: PETSC_EXTERN void f90array3ddestroyreal_(F90Array3d *ptr PETSC_F90_2PTR_PROTO_NOVAR);
    251: PETSC_EXTERN void f90array3dcreateint_(void *,PetscInt *,PetscInt *,PetscInt *,PetscInt *,PetscInt *,PetscInt *,F90Array3d * PETSC_F90_2PTR_PROTO_NOVAR);
    252: PETSC_EXTERN void f90array3daccessint_(F90Array3d*,void** PETSC_F90_2PTR_PROTO_NOVAR);
    253: PETSC_EXTERN void f90array3ddestroyint_(F90Array3d *ptr PETSC_F90_2PTR_PROTO_NOVAR);
    254: PETSC_EXTERN void f90array3dcreatefortranaddr_(void *,PetscInt *,PetscInt *,PetscInt *,PetscInt *,PetscInt *,PetscInt *,F90Array3d * PETSC_F90_2PTR_PROTO_NOVAR);
    255: PETSC_EXTERN void f90array3daccessfortranaddr_(F90Array3d*,void** PETSC_F90_2PTR_PROTO_NOVAR);
    256: PETSC_EXTERN void f90array3ddestroyfortranaddr_(F90Array3d *ptr PETSC_F90_2PTR_PROTO_NOVAR);

    258: PetscErrorCode F90Array3dCreate(void *array,MPI_Datatype type,PetscInt start1,PetscInt len1,PetscInt start2,PetscInt len2,PetscInt start3,PetscInt len3,F90Array3d *ptr PETSC_F90_2PTR_PROTO(ptrd))
    259: {
    260:   if (type == MPIU_SCALAR) {
    261:     f90array3dcreatescalar_(array,&start1,&len1,&start2,&len2,&start3,&len3,ptr PETSC_F90_2PTR_PARAM(ptrd));
    262:   } else if (type == MPIU_REAL) {
    263:     f90array3dcreatereal_(array,&start1,&len1,&start2,&len2,&start3,&len3,ptr PETSC_F90_2PTR_PARAM(ptrd));
    264:   } else if (type == MPIU_INT) {
    265:     f90array3dcreateint_(array,&start1,&len1,&start2,&len2,&start3,&len3,ptr PETSC_F90_2PTR_PARAM(ptrd));
    266:   } else if (type == MPIU_FORTRANADDR) {
    267:     f90array3dcreatefortranaddr_(array,&start1,&len1,&start2,&len2,&start3,&len3,ptr PETSC_F90_2PTR_PARAM(ptrd));
    268:   } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Unsupported MPI_Datatype");
    269:   return 0;
    270: }

    272: PetscErrorCode  F90Array3dAccess(F90Array3d *ptr,MPI_Datatype type,void **array PETSC_F90_2PTR_PROTO(ptrd))
    273: {
    274:   if (type == MPIU_SCALAR) {
    275:     f90array3daccessscalar_(ptr,array PETSC_F90_2PTR_PARAM(ptrd));
    276:   } else if (type == MPIU_REAL) {
    277:     f90array3daccessreal_(ptr,array PETSC_F90_2PTR_PARAM(ptrd));
    278:   } else if (type == MPIU_INT) {
    279:     f90array3daccessint_(ptr,array PETSC_F90_2PTR_PARAM(ptrd));
    280:   } else if (type == MPIU_FORTRANADDR) {
    281:     f90array3daccessfortranaddr_(ptr,array PETSC_F90_2PTR_PARAM(ptrd));
    282:   } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Unsupported MPI_Datatype");
    283:   return 0;
    284: }

    286: PetscErrorCode  F90Array3dDestroy(F90Array3d *ptr,MPI_Datatype type PETSC_F90_2PTR_PROTO(ptrd))
    287: {
    288:   if (type == MPIU_SCALAR) {
    289:     f90array3ddestroyscalar_(ptr PETSC_F90_2PTR_PARAM(ptrd));
    290:   } else if (type == MPIU_REAL) {
    291:     f90array3ddestroyreal_(ptr PETSC_F90_2PTR_PARAM(ptrd));
    292:   } else if (type == MPIU_INT) {
    293:     f90array3ddestroyint_(ptr PETSC_F90_2PTR_PARAM(ptrd));
    294:   } else if (type == MPIU_FORTRANADDR) {
    295:     f90array3ddestroyfortranaddr_(ptr PETSC_F90_2PTR_PARAM(ptrd));
    296:   } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Unsupported MPI_Datatype");
    297:   return 0;
    298: }

    300: /*************************************************************************/
    301: #if defined(PETSC_HAVE_FORTRAN_CAPS)
    302: #define f90array4dcreatescalar_           F90ARRAY4DCREATESCALAR
    303: #define f90array4daccessscalar_           F90ARRAY4DACCESSSCALAR
    304: #define f90array4ddestroyscalar_          F90ARRAY4DDESTROYSCALAR
    305: #define f90array4dcreatereal_             F90ARRAY4DCREATEREAL
    306: #define f90array4daccessreal_             F90ARRAY4DACCESSREAL
    307: #define f90array4ddestroyreal_            F90ARRAY4DDESTROYREAL
    308: #define f90array4dcreateint_              F90ARRAY4DCREATEINT
    309: #define f90array4daccessint_              F90ARRAY4DACCESSINT
    310: #define f90array4ddestroyint_             F90ARRAY4DDESTROYINT
    311: #define f90array4dcreatefortranaddr_      F90ARRAY4DCREATEFORTRANADDR
    312: #define f90array4daccessfortranaddr_      F90ARRAY4DACCESSFORTRANADDR
    313: #define f90array4ddestroyfortranaddr_     F90ARRAY4DDESTROYFORTRANADDR
    314: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
    315: #define f90array4dcreatescalar_           f90array4dcreatescalar
    316: #define f90array4daccessscalar_           f90array4daccessscalar
    317: #define f90array4ddestroyscalar_          f90array4ddestroyscalar
    318: #define f90array4dcreatereal_             f90array4dcreatereal
    319: #define f90array4daccessreal_             f90array4daccessreal
    320: #define f90array4ddestroyreal_            f90array4ddestroyreal
    321: #define f90array4dcreateint_              f90array4dcreateint
    322: #define f90array4daccessint_              f90array4daccessint
    323: #define f90array4ddestroyint_             f90array4ddestroyint
    324: #define f90array4dcreatefortranaddr_      f90array4dcreatefortranaddr
    325: #define f90array4daccessfortranaddr_      f90array4daccessfortranaddr
    326: #define f90array4ddestroyfortranaddr_     f90array4ddestroyfortranaddr
    327: #endif

    329: PETSC_EXTERN void f90array4dcreatescalar_(void *,PetscInt *,PetscInt *,PetscInt *,PetscInt *,PetscInt *,PetscInt *,PetscInt*,PetscInt*,F90Array4d * PETSC_F90_2PTR_PROTO_NOVAR);
    330: PETSC_EXTERN void f90array4daccessscalar_(F90Array4d*,void** PETSC_F90_2PTR_PROTO_NOVAR);
    331: PETSC_EXTERN void f90array4ddestroyscalar_(F90Array4d *ptr PETSC_F90_2PTR_PROTO_NOVAR);
    332: PETSC_EXTERN void f90array4dcreatereal_(void *,PetscInt *,PetscInt *,PetscInt *,PetscInt *,PetscInt *,PetscInt *,PetscInt*,PetscInt*,F90Array4d * PETSC_F90_2PTR_PROTO_NOVAR);
    333: PETSC_EXTERN void f90array4daccessreal_(F90Array4d*,void** PETSC_F90_2PTR_PROTO_NOVAR);
    334: PETSC_EXTERN void f90array4ddestroyreal_(F90Array4d *ptr PETSC_F90_2PTR_PROTO_NOVAR);
    335: PETSC_EXTERN void f90array4dcreateint_(void *,PetscInt *,PetscInt *,PetscInt *,PetscInt *,PetscInt *,PetscInt *,PetscInt*,PetscInt*,F90Array4d * PETSC_F90_2PTR_PROTO_NOVAR);
    336: PETSC_EXTERN void f90array4daccessint_(F90Array4d*,void** PETSC_F90_2PTR_PROTO_NOVAR);
    337: PETSC_EXTERN void f90array4ddestroyint_(F90Array4d *ptr PETSC_F90_2PTR_PROTO_NOVAR);
    338: PETSC_EXTERN void f90array4dcreatefortranaddr_(void *,PetscInt *,PetscInt *,PetscInt *,PetscInt *,PetscInt *,PetscInt *,PetscInt*,PetscInt*,F90Array4d * PETSC_F90_2PTR_PROTO_NOVAR);
    339: PETSC_EXTERN void f90array4daccessfortranaddr_(F90Array4d*,void** PETSC_F90_2PTR_PROTO_NOVAR);
    340: PETSC_EXTERN void f90array4ddestroyfortranaddr_(F90Array4d *ptr PETSC_F90_2PTR_PROTO_NOVAR);

    342: PetscErrorCode F90Array4dCreate(void *array,MPI_Datatype type,PetscInt start1,PetscInt len1,PetscInt start2,PetscInt len2,PetscInt start3,PetscInt len3,PetscInt start4,PetscInt len4,F90Array4d *ptr PETSC_F90_2PTR_PROTO(ptrd))
    343: {
    344:   if (type == MPIU_SCALAR) {
    345:     f90array4dcreatescalar_(array,&start1,&len1,&start2,&len2,&start3,&len3,&start4,&len4,ptr PETSC_F90_2PTR_PARAM(ptrd));
    346:   } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Unsupported MPI_Datatype");
    347:   return 0;
    348: }

    350: PetscErrorCode  F90Array4dAccess(F90Array4d *ptr,MPI_Datatype type,void **array PETSC_F90_2PTR_PROTO(ptrd))
    351: {
    352:   if (type == MPIU_SCALAR) {
    353:     f90array4daccessscalar_(ptr,array PETSC_F90_2PTR_PARAM(ptrd));
    354:   } else if (type == MPIU_REAL) {
    355:     f90array4daccessreal_(ptr,array PETSC_F90_2PTR_PARAM(ptrd));
    356:   } else if (type == MPIU_INT) {
    357:     f90array4daccessint_(ptr,array PETSC_F90_2PTR_PARAM(ptrd));
    358:   } else if (type == MPIU_FORTRANADDR) {
    359:     f90array4daccessfortranaddr_(ptr,array PETSC_F90_2PTR_PARAM(ptrd));
    360:   } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Unsupported MPI_Datatype");
    361:   return 0;
    362: }

    364: PetscErrorCode  F90Array4dDestroy(F90Array4d *ptr,MPI_Datatype type PETSC_F90_2PTR_PROTO(ptrd))
    365: {
    366:   if (type == MPIU_SCALAR) {
    367:     f90array4ddestroyscalar_(ptr PETSC_F90_2PTR_PARAM(ptrd));
    368:   } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Unsupported MPI_Datatype");
    369:   return 0;
    370: }

    372: /*************************************************************************/
    373: #if defined(PETSC_HAVE_FORTRAN_CAPS)
    374: #define f90array1dgetaddrscalar_            F90ARRAY1DGETADDRSCALAR
    375: #define f90array1dgetaddrreal_              F90ARRAY1DGETADDRREAL
    376: #define f90array1dgetaddrint_               F90ARRAY1DGETADDRINT
    377: #define f90array1dgetaddrfortranaddr_       F90ARRAY1DGETADDRFORTRANADDR
    378: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
    379: #define f90array1dgetaddrscalar_            f90array1dgetaddrscalar
    380: #define f90array1dgetaddrreal_              f90array1dgetaddrreal
    381: #define f90array1dgetaddrint_               f90array1dgetaddrint
    382: #define f90array1dgetaddrfortranaddr_       f90array1dgetaddrfortranaddr
    383: #endif

    385: PETSC_EXTERN void f90array1dgetaddrscalar_(void *array, PetscFortranAddr *address)
    386: {
    387:   *address = (PetscFortranAddr)array;
    388: }
    389: PETSC_EXTERN void f90array1dgetaddrreal_(void *array, PetscFortranAddr *address)
    390: {
    391:   *address = (PetscFortranAddr)array;
    392: }
    393: PETSC_EXTERN void f90array1dgetaddrint_(void *array, PetscFortranAddr *address)
    394: {
    395:   *address = (PetscFortranAddr)array;
    396: }
    397: PETSC_EXTERN void f90array1dgetaddrfortranaddr_(void *array, PetscFortranAddr *address)
    398: {
    399:   *address = (PetscFortranAddr)array;
    400: }

    402: /*************************************************************************/
    403: #if defined(PETSC_HAVE_FORTRAN_CAPS)
    404: #define f90array2dgetaddrscalar_            F90ARRAY2DGETADDRSCALAR
    405: #define f90array2dgetaddrreal_              F90ARRAY2DGETADDRREAL
    406: #define f90array2dgetaddrint_               F90ARRAY2DGETADDRINT
    407: #define f90array2dgetaddrfortranaddr_       F90ARRAY2DGETADDRFORTRANADDR
    408: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
    409: #define f90array2dgetaddrscalar_            f90array2dgetaddrscalar
    410: #define f90array2dgetaddrreal_              f90array2dgetaddrreal
    411: #define f90array2dgetaddrint_               f90array2dgetaddrint
    412: #define f90array2dgetaddrfortranaddr_       f90array2dgetaddrfortranaddr
    413: #endif

    415: PETSC_EXTERN void f90array2dgetaddrscalar_(void *array, PetscFortranAddr *address)
    416: {
    417:   *address = (PetscFortranAddr)array;
    418: }
    419: PETSC_EXTERN void f90array2dgetaddrreal_(void *array, PetscFortranAddr *address)
    420: {
    421:   *address = (PetscFortranAddr)array;
    422: }
    423: PETSC_EXTERN void f90array2dgetaddrint_(void *array, PetscFortranAddr *address)
    424: {
    425:   *address = (PetscFortranAddr)array;
    426: }
    427: PETSC_EXTERN void f90array2dgetaddrfortranaddr_(void *array, PetscFortranAddr *address)
    428: {
    429:   *address = (PetscFortranAddr)array;
    430: }

    432: /*************************************************************************/
    433: #if defined(PETSC_HAVE_FORTRAN_CAPS)
    434: #define f90array3dgetaddrscalar_            F90ARRAY3DGETADDRSCALAR
    435: #define f90array3dgetaddrreal_              F90ARRAY3DGETADDRREAL
    436: #define f90array3dgetaddrint_               F90ARRAY3DGETADDRINT
    437: #define f90array3dgetaddrfortranaddr_       F90ARRAY3DGETADDRFORTRANADDR
    438: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
    439: #define f90array3dgetaddrscalar_            f90array3dgetaddrscalar
    440: #define f90array3dgetaddrreal_              f90array3dgetaddrreal
    441: #define f90array3dgetaddrint_               f90array3dgetaddrint
    442: #define f90array3dgetaddrfortranaddr_       f90array3dgetaddrfortranaddr
    443: #endif

    445: PETSC_EXTERN void f90array3dgetaddrscalar_(void *array, PetscFortranAddr *address)
    446: {
    447:   *address = (PetscFortranAddr)array;
    448: }
    449: PETSC_EXTERN void f90array3dgetaddrreal_(void *array, PetscFortranAddr *address)
    450: {
    451:   *address = (PetscFortranAddr)array;
    452: }
    453: PETSC_EXTERN void f90array3dgetaddrint_(void *array, PetscFortranAddr *address)
    454: {
    455:   *address = (PetscFortranAddr)array;
    456: }
    457: PETSC_EXTERN void f90array3dgetaddrfortranaddr_(void *array, PetscFortranAddr *address)
    458: {
    459:   *address = (PetscFortranAddr)array;
    460: }

    462: /*************************************************************************/
    463: #if defined(PETSC_HAVE_FORTRAN_CAPS)
    464: #define f90array4dgetaddrscalar_            F90ARRAY4DGETADDRSCALAR
    465: #define f90array4dgetaddrreal_              F90ARRAY4DGETADDRREAL
    466: #define f90array4dgetaddrint_               F90ARRAY4DGETADDRINT
    467: #define f90array4dgetaddrfortranaddr_       F90ARRAY4DGETADDRFORTRANADDR
    468: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
    469: #define f90array4dgetaddrscalar_            f90array4dgetaddrscalar
    470: #define f90array4dgetaddrreal_              f90array4dgetaddrreal
    471: #define f90array4dgetaddrint_               f90array4dgetaddrint
    472: #define f90array4dgetaddrfortranaddr_       f90array4dgetaddrfortranaddr
    473: #endif

    475: PETSC_EXTERN void f90array4dgetaddrscalar_(void *array, PetscFortranAddr *address)
    476: {
    477:   *address = (PetscFortranAddr)array;
    478: }
    479: PETSC_EXTERN void f90array4dgetaddrreal_(void *array, PetscFortranAddr *address)
    480: {
    481:   *address = (PetscFortranAddr)array;
    482: }
    483: PETSC_EXTERN void f90array4dgetaddrint_(void *array, PetscFortranAddr *address)
    484: {
    485:   *address = (PetscFortranAddr)array;
    486: }
    487: PETSC_EXTERN void f90array4dgetaddrfortranaddr_(void *array, PetscFortranAddr *address)
    488: {
    489:   *address = (PetscFortranAddr)array;
    490: }