Actual source code: zpetsc.h

      2: /* This file contains info for the use of PETSc Fortran interface stubs */

     4:  #include petsc.h
      5: #include "petscfix.h"

      7: EXTERN PetscErrorCode PetscScalarAddressToFortran(PetscObject,PetscInt,PetscScalar*,PetscScalar*,PetscInt,size_t*);
      8: EXTERN PetscErrorCode PetscScalarAddressFromFortran(PetscObject,PetscScalar*,size_t,PetscInt,PetscScalar **);
      9: EXTERN size_t         PetscIntAddressToFortran(PetscInt*,PetscInt*);
     10: EXTERN PetscInt       *PetscIntAddressFromFortran(PetscInt*,size_t);
     21: /*  ----------------------------------------------------------------------*/
     22: /*
     23:    We store each PETSc object C pointer directly as a
     24:    Fortran integer*4 or *8 depending on the size of pointers.
     25: */
     26: #define PetscFInt long

     28: #define PetscToPointer(a)     (*(long *)(a))
     29: #define PetscFromPointer(a)        (long)(a)

     31: /*  ----------------------------------------------------------------------*/
     32: #define PetscToPointerComm(a)        MPI_Comm_f2c(*(MPI_Fint *)(&a))
     33: #define PetscFromPointerComm(a)      MPI_Comm_c2f(a)

     35: /* --------------------------------------------------------------------*/
     36: /*
     37:     This lets us map the str-len argument either, immediately following
     38:     the char argument (DVF on Win32) or at the end of the argument list
     39:     (general unix compilers)
     40: */
     41: #if defined(PETSC_HAVE_FORTRAN_MIXED_STR_ARG)
     42: #define PETSC_MIXED_LEN(len) ,int len
     43: #define PETSC_END_LEN(len)
     44: #else
     45: #define PETSC_MIXED_LEN(len)
     46: #define PETSC_END_LEN(len)   ,int len
     47: #endif

     49: /* --------------------------------------------------------------------*/
     50: /*
     51:     This defines the mappings from Fortran character strings
     52:   to C character strings on the Cray T3D.
     53: */
     54: #if defined(PETSC_USES_CPTOFCD)
     55: #include <fortran.h>

     57: #define CHAR _fcd
     58: #define FIXCHAR(a,n,b) \
     59: { \
     60:   b = _fcdtocp(a); \
     61:   n = _fcdlen (a); \
     62:   if (b == PETSC_NULL_CHARACTER_Fortran) { \
     63:       b = 0; \
     64:   } else {  \
     65:     while((n > 0) && (b[n-1] == ' ')) n--; \
     66:     *PetscMalloc((n+1)*sizeof(char),&b); \
     67:     if(*ierr) return; \
     68:     *PetscStrncpy(b,_fcdtocp(a),n); \
     69:     if(*ierr) return; \
     70:     b[n] = 0; \
     71:   } \
     72: }
     73: #define FREECHAR(a,b) if (b) PetscFreeVoid(b);
     74: #define FIXRETURNCHAR(a,n)

     76: #else

     78: #define CHAR char*
     79: #define FIXCHAR(a,n,b) \
     80: {\
     81:   if (a == PETSC_NULL_CHARACTER_Fortran) { \
     82:     b = a = 0; \
     83:   } else { \
     84:     while((n > 0) && (a[n-1] == ' ')) n--; \
     85:     *PetscMalloc((n+1)*sizeof(char),&b); \
     86:     if(*ierr) return; \
     87:     *PetscStrncpy(b,a,n); \
     88:     if(*ierr) return; \
     89:     b[n] = 0; \
     90:   } \
     91: }

     93: #define FREECHAR(a,b) if (a != b) PetscFreeVoid(b);

     95: #define FIXRETURNCHAR(a,n) \
     96: { \
     97:   int __i; \
     98:   for (__i=0; __i<n && a[__i] != 0; __i++) ; \
     99:   for (; __i<n; __i++) a[__i] = ' ' ; \
    100: }

    102: #endif

    104: #define FORTRANNULL(a)         (((void*)a) == PETSC_NULL_Fortran)
    105: #define FORTRANNULLINTEGER(a)  (((void*)a) == PETSC_NULL_INTEGER_Fortran)
    106: #define FORTRANNULLSCALAR(a)   (((void*)a) == PETSC_NULL_SCALAR_Fortran)
    107: #define FORTRANNULLDOUBLE(a)   (((void*)a) == PETSC_NULL_DOUBLE_Fortran)
    108: #define FORTRANNULLREAL(a)     (((void*)a) == PETSC_NULL_REAL_Fortran)
    109: #define FORTRANNULLOBJECT(a)   (((void*)a) == PETSC_NULL_OBJECT_Fortran)
    110: #define FORTRANNULLFUNCTION(a) (((void(*)(void))a) == PETSC_NULL_FUNCTION_Fortran)

    113: #define CHKFORTRANNULLINTEGER(a)  \
    114:   if (FORTRANNULL(a) || FORTRANNULLDOUBLE(a) || FORTRANNULLSCALAR(a) || FORTRANNULLREAL(a) || FORTRANNULLOBJECT(a)) { \
    115:     PetscError(__LINE__,"fortran_interface_unknown_file",__FILE__,__SDIR__,PETSC_ERR_ARG_WRONG,1, \
    116:     "Use PETSC_NULL_INTEGER"); *1; return; } \
    117:   else if (FORTRANNULLINTEGER(a)) { a = PETSC_NULL; }

    119: #define CHKFORTRANNULLSCALAR(a)  \
    120:   if (FORTRANNULL(a) || FORTRANNULLINTEGER(a) || FORTRANNULLDOUBLE(a) || FORTRANNULLREAL(a) || FORTRANNULLOBJECT(a)) { \
    121:     PetscError(__LINE__,"fortran_interface_unknown_file",__FILE__,__SDIR__,PETSC_ERR_ARG_WRONG,1, \
    122:     "Use PETSC_NULL_SCALAR"); *1; return; } \
    123:   else if (FORTRANNULLSCALAR(a)) { a = PETSC_NULL; }

    125: #define CHKFORTRANNULLDOUBLE(a)  \
    126:   if (FORTRANNULL(a) || FORTRANNULLINTEGER(a) || FORTRANNULLSCALAR(a) || FORTRANNULLREAL(a) || FORTRANNULLOBJECT(a)) { \
    127:     PetscError(__LINE__,"fortran_interface_unknown_file",__FILE__,__SDIR__,PETSC_ERR_ARG_WRONG,1, \
    128:     "Use PETSC_NULL_DOUBLE"); *1; return; } \
    129:   else if (FORTRANNULLDOUBLE(a)) { a = PETSC_NULL; }

    131: #define CHKFORTRANNULLREAL(a)  \
    132:   if (FORTRANNULL(a) || FORTRANNULLINTEGER(a) || FORTRANNULLDOUBLE(a) || FORTRANNULLSCALAR(a) || FORTRANNULLOBJECT(a)) { \
    133:     PetscError(__LINE__,"fortran_interface_unknown_file",__FILE__,__SDIR__,PETSC_ERR_ARG_WRONG,1, \
    134:     "Use PETSC_NULL_REAL"); *1; return; } \
    135:   else if (FORTRANNULLREAL(a)) { a = PETSC_NULL; }

    137: #define CHKFORTRANNULLOBJECT(a)  \
    138:   if (FORTRANNULL(a) || FORTRANNULLINTEGER(a) || FORTRANNULLDOUBLE(a) || FORTRANNULLSCALAR(a) || FORTRANNULLREAL(a)) { \
    139:     PetscError(__LINE__,"fortran_interface_unknown_file",__FILE__,__SDIR__,PETSC_ERR_ARG_WRONG,1, \
    140:     "Use PETSC_NULL_OBJECT"); *1; return; } \
    141:   else if (FORTRANNULLOBJECT(a)) { a = PETSC_NULL; }

    145: #define CHKFORTRANNULLOBJECTDEREFERENCE(a)  \
    146:   if (FORTRANNULL(a) || FORTRANNULLSCALAR(a) || FORTRANNULLDOUBLE(a) || FORTRANNULLREAL(a) || FORTRANNULLINTEGER(a)) { \
    147:     PetscError(__LINE__,"fortran_interface_unknown_file",__FILE__,__SDIR__,PETSC_ERR_ARG_WRONG,1, \
    148:     "Use PETSC_NULL_OBJECT"); *1; return; } \
    149:   else if (FORTRANNULLOBJECT(a)) { *((void***)&a) = &PETSCNULLPOINTERADDRESS; }
    150:
    151: /*
    152:     These are used to support the default viewers that are
    153:   created at run time, in C using the , trick.

    155:     The numbers here must match the numbers in include/finclude/petsc.h
    156: */
    157: #define PETSC_VIEWER_DRAW_WORLD_FORTRAN     -4
    158: #define PETSC_VIEWER_DRAW_SELF_FORTRAN      -5
    159: #define PETSC_VIEWER_SOCKET_WORLD_FORTRAN   -6
    160: #define PETSC_VIEWER_SOCKET_SELF_FORTRAN    -7
    161: #define PETSC_VIEWER_STDOUT_WORLD_FORTRAN   -8
    162: #define PETSC_VIEWER_STDOUT_SELF_FORTRAN    -9
    163: #define PETSC_VIEWER_STDERR_WORLD_FORTRAN   -10
    164: #define PETSC_VIEWER_STDERR_SELF_FORTRAN    -11
    165: #define PETSC_VIEWER_BINARY_WORLD_FORTRAN   -12
    166: #define PETSC_VIEWER_BINARY_SELF_FORTRAN    -13
    167: #define PETSC_VIEWER_MATLAB_WORLD_FORTRAN   -14
    168: #define PETSC_VIEWER_MATLAB_SELF_FORTRAN    -15

    170: #if defined (PETSC_USE_SOCKET_VIEWER)
    171: #define PetscPatchDefaultViewers_Fortran_Socket(vin,v) \
    172:     } else if ((*(PetscFortranAddr*)vin) == PETSC_VIEWER_SOCKET_WORLD_FORTRAN) { \
    173:       v = PETSC_VIEWER_SOCKET_WORLD; \
    174:     } else if ((*(PetscFortranAddr*)vin) == PETSC_VIEWER_SOCKET_SELF_FORTRAN) { \
    175:       v = PETSC_VIEWER_SOCKET_SELF
    176: #else
    177: #define PetscPatchDefaultViewers_Fortran_Socket(vin,v)
    178: #endif

    180: #define PetscPatchDefaultViewers_Fortran(vin,v) \
    181: { \
    182:     if ((*(PetscFortranAddr*)vin) == PETSC_VIEWER_DRAW_WORLD_FORTRAN) { \
    183:       v = PETSC_VIEWER_DRAW_WORLD; \
    184:     } else if ((*(PetscFortranAddr*)vin) == PETSC_VIEWER_DRAW_SELF_FORTRAN) { \
    185:       v = PETSC_VIEWER_DRAW_SELF; \
    186:     } else if ((*(PetscFortranAddr*)vin) == PETSC_VIEWER_STDOUT_WORLD_FORTRAN) { \
    187:       v = PETSC_VIEWER_STDOUT_WORLD; \
    188:     } else if ((*(PetscFortranAddr*)vin) == PETSC_VIEWER_STDOUT_SELF_FORTRAN) { \
    189:       v = PETSC_VIEWER_STDOUT_SELF; \
    190:     } else if ((*(PetscFortranAddr*)vin) == PETSC_VIEWER_STDERR_WORLD_FORTRAN) { \
    191:       v = PETSC_VIEWER_STDERR_WORLD; \
    192:     } else if ((*(PetscFortranAddr*)vin) == PETSC_VIEWER_STDERR_SELF_FORTRAN) { \
    193:       v = PETSC_VIEWER_STDERR_SELF; \
    194:     } else if ((*(PetscFortranAddr*)vin) == PETSC_VIEWER_BINARY_WORLD_FORTRAN) { \
    195:       v = PETSC_VIEWER_BINARY_WORLD; \
    196:     } else if ((*(PetscFortranAddr*)vin) == PETSC_VIEWER_BINARY_SELF_FORTRAN) { \
    197:       v = PETSC_VIEWER_BINARY_SELF; \
    198:     } else if ((*(PetscFortranAddr*)vin) == PETSC_VIEWER_MATLAB_WORLD_FORTRAN) { \
    199:       v = PETSC_VIEWER_BINARY_WORLD; \
    200:     } else if ((*(PetscFortranAddr*)vin) == PETSC_VIEWER_MATLAB_SELF_FORTRAN) { \
    201:       v = PETSC_VIEWER_BINARY_SELF; \
    202:     PetscPatchDefaultViewers_Fortran_Socket(vin,v); \
    203:     } else { \
    204:       v = *vin; \
    205:     } \
    206: }