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,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)
     30: #define PetscRmPointer(a)

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

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

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

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

     77: #else

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

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

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

    105: #endif

    107: #define FORTRANNULL(a)         (((void*)a) == PETSC_NULL_Fortran)
    108: #define FORTRANNULLINTEGER(a)  (((void*)a) == PETSC_NULL_INTEGER_Fortran)
    109: #define FORTRANNULLSCALAR(a)   (((void*)a) == PETSC_NULL_SCALAR_Fortran)
    110: #define FORTRANNULLDOUBLE(a)   (((void*)a) == PETSC_NULL_DOUBLE_Fortran)
    111: #define FORTRANNULLREAL(a)     (((void*)a) == PETSC_NULL_REAL_Fortran)

    113: #define FORTRANNULLOBJECT FORTRANNULLINTEGER

    115: #define FORTRANNULLFUNCTION(a) (((void(*)(void))a) == PETSC_NULL_FUNCTION_Fortran)

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

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

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

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

    143: #define CHKFORTRANNULLOBJECT(a)  \
    144:   if (FORTRANNULL(a) || FORTRANNULLSCALAR(a) || FORTRANNULLDOUBLE(a) || FORTRANNULLREAL(a) || FORTRANNULLINTEGER(a)) { \
    145:     PetscError(__LINE__,"fortran_interface_unknown_file",__FILE__,__SDIR__,PETSC_ERR_ARG_WRONG,1, \
    146:     "Use PETSC_NULL_OBJECT"); *1; return; } \
    147:   else if (FORTRANNULLOBJECT(a)) { a = PETSC_NULL; }

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

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

    176: #if defined (PETSC_USE_SOCKET_VIEWER)
    177: #define PetscPatchDefaultViewers_Fortran_Socket(vin,v) \
    178:     } else if ((*(PetscFortranAddr*)vin) == PETSC_VIEWER_SOCKET_WORLD_FORTRAN) { \
    179:       v = PETSC_VIEWER_SOCKET_WORLD; \
    180:     } else if ((*(PetscFortranAddr*)vin) == PETSC_VIEWER_SOCKET_SELF_FORTRAN) { \
    181:       v = PETSC_VIEWER_SOCKET_SELF
    182: #else
    183: #define PetscPatchDefaultViewers_Fortran_Socket(vin,v)
    184: #endif

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