1 #pragma once 2 3 #include <petsc/private/petscimpl.h> 4 PETSC_INTERN PetscErrorCode PETScParseFortranArgs_Private(int *, char ***); 5 PETSC_EXTERN PetscErrorCode PetscMPIFortranDatatypeToC(MPI_Fint, MPI_Datatype *); 6 7 PETSC_EXTERN PetscErrorCode PetscScalarAddressToFortran(PetscObject, PetscInt, PetscScalar *, PetscScalar *, PetscInt, size_t *); 8 PETSC_EXTERN PetscErrorCode PetscScalarAddressFromFortran(PetscObject, PetscScalar *, size_t, PetscInt, PetscScalar **); 9 PETSC_EXTERN size_t PetscIntAddressToFortran(const PetscInt *, const PetscInt *); 10 PETSC_EXTERN PetscInt *PetscIntAddressFromFortran(const PetscInt *, size_t); 11 PETSC_EXTERN char *PETSC_NULL_CHARACTER_Fortran; 12 PETSC_EXTERN void *PETSC_NULL_INTEGER_Fortran; 13 PETSC_EXTERN void *PETSC_NULL_SCALAR_Fortran; 14 PETSC_EXTERN void *PETSC_NULL_DOUBLE_Fortran; 15 PETSC_EXTERN void *PETSC_NULL_REAL_Fortran; 16 PETSC_EXTERN void *PETSC_NULL_BOOL_Fortran; 17 PETSC_EXTERN void *PETSC_NULL_ENUM_Fortran; 18 PETSC_EXTERN void *PETSC_NULL_INTEGER_ARRAY_Fortran; 19 PETSC_EXTERN void *PETSC_NULL_SCALAR_ARRAY_Fortran; 20 PETSC_EXTERN void *PETSC_NULL_REAL_ARRAY_Fortran; 21 PETSC_EXTERN void *PETSC_NULL_MPI_COMM_Fortran; 22 PETSC_EXTERN void *PETSC_NULL_INTEGER_POINTER_Fortran; 23 PETSC_EXTERN void *PETSC_NULL_SCALAR_POINTER_Fortran; 24 PETSC_EXTERN void *PETSC_NULL_REAL_POINTER_Fortran; 25 PETSC_EXTERN void (*PETSC_NULL_FUNCTION_Fortran)(void); 26 27 PETSC_INTERN PetscErrorCode PetscInitFortran_Private(const char *, PetscInt); 28 29 /* ----------------------------------------------------------------------*/ 30 /* 31 PETSc object C pointers are stored directly as 32 Fortran integer*4 or *8 depending on the size of pointers. 33 */ 34 35 /* --------------------------------------------------------------------*/ 36 /* 37 Since Fortran does not null terminate strings we need to insure the string is null terminated before passing it 38 to C. This may require a memory allocation which is then freed with FREECHAR(). 39 */ 40 #define FIXCHAR(a, n, b) \ 41 do { \ 42 if ((a) == PETSC_NULL_CHARACTER_Fortran) { \ 43 (b) = PETSC_NULLPTR; \ 44 (a) = PETSC_NULLPTR; \ 45 } else { \ 46 while (((n) > 0) && ((a)[(n) - 1] == ' ')) (n)--; \ 47 *ierr = PetscMalloc1((n) + 1, &(b)); \ 48 if (*ierr) return; \ 49 *ierr = PetscMemcpy((b), (a), (n)); \ 50 (b)[n] = '\0'; \ 51 if (*ierr) return; \ 52 } \ 53 } while (0) 54 #define FREECHAR(a, b) \ 55 do { \ 56 if (a != b) *ierr = PetscFree(b); \ 57 } while (0) 58 59 /* 60 Fortran expects any unneeded characters at the end of its strings to be filled with the blank character. 61 */ 62 #define FIXRETURNCHAR(flg, a, n) \ 63 do { \ 64 if (flg) { \ 65 PETSC_FORTRAN_CHARLEN_T __i; \ 66 for (__i = 0; __i < n && a[__i] != 0; __i++) { }; \ 67 for (; __i < n; __i++) a[__i] = ' '; \ 68 } \ 69 } while (0) 70 71 /* 72 The cast through PETSC_UINTPTR_T is so that compilers that warn about casting to/from void * to void(*)(void) 73 will not complain about these comparisons. It is not know if this works for all compilers 74 */ 75 #define FORTRANNULLINTEGER(a) (((void *)(PETSC_UINTPTR_T)a) == PETSC_NULL_INTEGER_Fortran || ((void *)(PETSC_UINTPTR_T)a) == PETSC_NULL_INTEGER_ARRAY_Fortran) 76 #define FORTRANNULLSCALAR(a) (((void *)(PETSC_UINTPTR_T)a) == PETSC_NULL_SCALAR_Fortran || ((void *)(PETSC_UINTPTR_T)a) == PETSC_NULL_SCALAR_ARRAY_Fortran) 77 #define FORTRANNULLREAL(a) (((void *)(PETSC_UINTPTR_T)a) == PETSC_NULL_REAL_Fortran || ((void *)(PETSC_UINTPTR_T)a) == PETSC_NULL_REAL_ARRAY_Fortran) 78 #define FORTRANNULLDOUBLE(a) (((void *)(PETSC_UINTPTR_T)a) == PETSC_NULL_DOUBLE_Fortran) 79 #define FORTRANNULLBOOL(a) (((void *)(PETSC_UINTPTR_T)a) == PETSC_NULL_BOOL_Fortran) 80 #define FORTRANNULLENUM(a) ((((void *)(PETSC_UINTPTR_T)a) == PETSC_NULL_ENUM_Fortran) || (((void *)(PETSC_UINTPTR_T)a) == (void *)-50)) 81 #define FORTRANNULLCHARACTER(a) (((void *)(PETSC_UINTPTR_T)a) == PETSC_NULL_CHARACTER_Fortran) 82 #define FORTRANNULLFUNCTION(a) (((void (*)(void))(PETSC_UINTPTR_T)a) == PETSC_NULL_FUNCTION_Fortran) 83 #define FORTRANNULLOBJECT(a) (*(void **)(PETSC_UINTPTR_T)a == (void *)0) 84 #define FORTRANNULLMPICOMM(a) (((void *)(PETSC_UINTPTR_T)a) == PETSC_NULL_MPI_COMM_Fortran) 85 86 /* 87 A Fortran object with a value of (void*) 0 corresponds to a NULL object in C and is indicated in Fortran by PETSC_NULL_XXXX 88 A Fortran object with a value of (void*) -2 is an object that was never created or was destroyed (see checkFortranTypeInitialize()). 89 A Fortran object with a value of (void*) -3 happens when a PETSc routine returns in one of its arguments a NULL object 90 (it cannot return a value of (void*) 0 because if later the returned variable is passed to a creation routine, 91 it would think one has passed in a PETSC_NULL_XXX and error). 92 93 This is needed because Fortran always uses pass by reference so one cannot pass a NULL address, only an address with special 94 values at the location. 95 */ 96 97 #define CHKFORTRANNULL(a) \ 98 do { \ 99 if (FORTRANNULLINTEGER(a) || FORTRANNULLENUM(a) || FORTRANNULLDOUBLE(a) || FORTRANNULLSCALAR(a) || FORTRANNULLREAL(a) || FORTRANNULLBOOL(a) || FORTRANNULLFUNCTION(a) || FORTRANNULLCHARACTER(a) || FORTRANNULLMPICOMM(a)) { a = PETSC_NULLPTR; } \ 100 } while (0) 101 102 #define CHKFORTRANNULLENUM(a) \ 103 do { \ 104 if (FORTRANNULLENUM(a)) { a = PETSC_NULLPTR; } \ 105 } while (0) 106 107 #define CHKFORTRANNULLINTEGER(a) \ 108 do { \ 109 if (FORTRANNULLINTEGER(a) || FORTRANNULLENUM(a)) { \ 110 a = PETSC_NULLPTR; \ 111 } else if (FORTRANNULLDOUBLE(a) || FORTRANNULLSCALAR(a) || FORTRANNULLREAL(a) || FORTRANNULLBOOL(a) || FORTRANNULLFUNCTION(a) || FORTRANNULLCHARACTER(a) || FORTRANNULLMPICOMM(a)) { \ 112 *ierr = PetscError(PETSC_COMM_SELF, __LINE__, PETSC_FUNCTION_NAME, __FILE__, PETSC_ERR_ARG_WRONG, PETSC_ERROR_INITIAL, "Use PETSC_NULL_INTEGER"); \ 113 *ierr = PETSC_ERR_ARG_BADPTR; \ 114 return; \ 115 } \ 116 } while (0) 117 118 #define CHKFORTRANNULLSCALAR(a) \ 119 do { \ 120 if (FORTRANNULLSCALAR(a)) { \ 121 a = PETSC_NULLPTR; \ 122 } else if (FORTRANNULLINTEGER(a) || FORTRANNULLDOUBLE(a) || FORTRANNULLREAL(a) || FORTRANNULLBOOL(a) || FORTRANNULLFUNCTION(a) || FORTRANNULLCHARACTER(a) || FORTRANNULLMPICOMM(a)) { \ 123 *ierr = PetscError(PETSC_COMM_SELF, __LINE__, PETSC_FUNCTION_NAME, __FILE__, PETSC_ERR_ARG_WRONG, PETSC_ERROR_INITIAL, "Use PETSC_NULL_SCALAR"); \ 124 *ierr = PETSC_ERR_ARG_BADPTR; \ 125 return; \ 126 } \ 127 } while (0) 128 129 #define CHKFORTRANNULLDOUBLE(a) \ 130 do { \ 131 if (FORTRANNULLDOUBLE(a)) { \ 132 a = PETSC_NULLPTR; \ 133 } else if (FORTRANNULLINTEGER(a) || FORTRANNULLSCALAR(a) || FORTRANNULLREAL(a) || FORTRANNULLBOOL(a) || FORTRANNULLFUNCTION(a) || FORTRANNULLCHARACTER(a) || FORTRANNULLMPICOMM(a)) { \ 134 *ierr = PetscError(PETSC_COMM_SELF, __LINE__, PETSC_FUNCTION_NAME, __FILE__, PETSC_ERR_ARG_WRONG, PETSC_ERROR_INITIAL, "Use PETSC_NULL_DOUBLE"); \ 135 *ierr = PETSC_ERR_ARG_BADPTR; \ 136 return; \ 137 } \ 138 } while (0) 139 140 #define CHKFORTRANNULLREAL(a) \ 141 do { \ 142 if (FORTRANNULLREAL(a)) { \ 143 a = PETSC_NULLPTR; \ 144 } else if (FORTRANNULLINTEGER(a) || FORTRANNULLDOUBLE(a) || FORTRANNULLSCALAR(a) || FORTRANNULLBOOL(a) || FORTRANNULLFUNCTION(a) || FORTRANNULLCHARACTER(a) || FORTRANNULLMPICOMM(a)) { \ 145 *ierr = PetscError(PETSC_COMM_SELF, __LINE__, PETSC_FUNCTION_NAME, __FILE__, PETSC_ERR_ARG_WRONG, PETSC_ERROR_INITIAL, "Use PETSC_NULL_REAL"); \ 146 *ierr = PETSC_ERR_ARG_BADPTR; \ 147 return; \ 148 } \ 149 } while (0) 150 151 #define CHKFORTRANNULLOBJECT(a) \ 152 do { \ 153 if (!(*(void **)a)) { \ 154 a = PETSC_NULLPTR; \ 155 } else if (FORTRANNULLINTEGER(a) || FORTRANNULLDOUBLE(a) || FORTRANNULLSCALAR(a) || FORTRANNULLREAL(a) || FORTRANNULLBOOL(a) || FORTRANNULLFUNCTION(a) || FORTRANNULLCHARACTER(a) || FORTRANNULLMPICOMM(a)) { \ 156 *ierr = PetscError(PETSC_COMM_SELF, __LINE__, PETSC_FUNCTION_NAME, __FILE__, PETSC_ERR_ARG_WRONG, PETSC_ERROR_INITIAL, "Use PETSC_NULL_XXX where XXX is the name of a particular object class"); \ 157 *ierr = PETSC_ERR_ARG_BADPTR; \ 158 return; \ 159 } \ 160 } while (0) 161 162 #define CHKFORTRANNULLBOOL(a) \ 163 do { \ 164 if (FORTRANNULLBOOL(a)) { \ 165 a = PETSC_NULLPTR; \ 166 } else if (FORTRANNULLSCALAR(a) || FORTRANNULLINTEGER(a) || FORTRANNULLDOUBLE(a) || FORTRANNULLSCALAR(a) || FORTRANNULLREAL(a) || FORTRANNULLFUNCTION(a) || FORTRANNULLCHARACTER(a) || FORTRANNULLMPICOMM(a)) { \ 167 *ierr = PetscError(PETSC_COMM_SELF, __LINE__, PETSC_FUNCTION_NAME, __FILE__, PETSC_ERR_ARG_WRONG, PETSC_ERROR_INITIAL, "Use PETSC_NULL_BOOL"); \ 168 *ierr = PETSC_ERR_ARG_BADPTR; \ 169 return; \ 170 } \ 171 } while (0) 172 173 #define CHKFORTRANNULLFUNCTION(a) \ 174 do { \ 175 if (FORTRANNULLFUNCTION(a)) { \ 176 a = PETSC_NULLPTR; \ 177 } else if (FORTRANNULLOBJECT(a) || FORTRANNULLSCALAR(a) || FORTRANNULLDOUBLE(a) || FORTRANNULLREAL(a) || FORTRANNULLINTEGER(a) || FORTRANNULLBOOL(a) || FORTRANNULLCHARACTER(a) || FORTRANNULLMPICOMM(a)) { \ 178 *ierr = PetscError(PETSC_COMM_SELF, __LINE__, PETSC_FUNCTION_NAME, __FILE__, PETSC_ERR_ARG_WRONG, PETSC_ERROR_INITIAL, "Use PETSC_NULL_FUNCTION"); \ 179 *ierr = PETSC_ERR_ARG_BADPTR; \ 180 return; \ 181 } \ 182 } while (0) 183 184 #define CHKFORTRANNULLMPICOMM(a) \ 185 do { \ 186 if (FORTRANNULLMPICOMM(a)) { \ 187 a = PETSC_NULLPTR; \ 188 } else if (FORTRANNULLINTEGER(a) || FORTRANNULLDOUBLE(a) || FORTRANNULLSCALAR(a) || FORTRANNULLREAL(a) || FORTRANNULLBOOL(a) || FORTRANNULLFUNCTION(a) || FORTRANNULLCHARACTER(a)) { \ 189 *ierr = PetscError(PETSC_COMM_SELF, __LINE__, PETSC_FUNCTION_NAME, __FILE__, PETSC_ERR_ARG_WRONG, PETSC_ERROR_INITIAL, "Use PETSC_NULL_MPI_COMM"); \ 190 *ierr = PETSC_ERR_ARG_BADPTR; \ 191 return; \ 192 } \ 193 } while (0) 194 195 /* In the beginning of Fortran XxxCreate() ensure object is not NULL or already created */ 196 #define PETSC_FORTRAN_OBJECT_CREATE(a) \ 197 do { \ 198 if (!(*(void **)a)) { \ 199 *ierr = PetscError(PETSC_COMM_SELF, __LINE__, PETSC_FUNCTION_NAME, __FILE__, PETSC_ERR_ARG_WRONG, PETSC_ERROR_INITIAL, "Cannot create PETSC_NULL_XXX object"); \ 200 *ierr = PETSC_ERR_ARG_WRONG; \ 201 return; \ 202 } else if (*((void **)(a)) != (void *)-2 && *((void **)(a)) != (void *)-3) { \ 203 *ierr = PetscError(PETSC_COMM_SELF, __LINE__, PETSC_FUNCTION_NAME, __FILE__, PETSC_ERR_ARG_WRONG, PETSC_ERROR_INITIAL, "Cannot create already existing object"); \ 204 *ierr = PETSC_ERR_ARG_WRONG; \ 205 return; \ 206 } \ 207 } while (0) 208 209 /* 210 In the beginning of Fortran XxxDestroy(a), if the input object was destroyed, change it to a petsc C NULL object so that it won't crash C XxxDestory() 211 If it is PETSC_NULL_XXX just return since these objects cannot be destroyed 212 */ 213 #define PETSC_FORTRAN_OBJECT_F_DESTROYED_TO_C_NULL(a) \ 214 do { \ 215 if (!*(void **)a || *((void **)(a)) == (void *)-2 || *((void **)(a)) == (void *)-3) { \ 216 *ierr = PETSC_SUCCESS; \ 217 return; \ 218 } \ 219 } while (0) 220 221 /* After C XxxDestroy(a) is called, change a's state from NULL to destroyed, so that it can be used/destroyed again by Fortran. 222 E.g., in VecScatterCreateToAll(x,vscat,seq,ierr), if seq = PETSC_NULL_VEC, petsc won't create seq. But if seq is a 223 destroyed object (e.g., as a result of a previous Fortran VecDestroy), petsc will create seq. 224 */ 225 #define PETSC_FORTRAN_OBJECT_C_NULL_TO_F_DESTROYED(a) \ 226 do { \ 227 *((void **)(a)) = (void *)-2; \ 228 } while (0) 229 230 /* 231 Variable type where we stash PETSc object pointers in Fortran. 232 */ 233 typedef PETSC_UINTPTR_T PetscFortranAddr; 234 235 /* 236 These are used to support the default viewers that are 237 created at run time, in C using the , trick. 238 239 The numbers here must match the numbers in include/petsc/finclude/petscsys.h 240 */ 241 #define PETSC_VIEWER_DRAW_WORLD_FORTRAN 4 242 #define PETSC_VIEWER_DRAW_SELF_FORTRAN 5 243 #define PETSC_VIEWER_SOCKET_WORLD_FORTRAN 6 244 #define PETSC_VIEWER_SOCKET_SELF_FORTRAN 7 245 #define PETSC_VIEWER_STDOUT_WORLD_FORTRAN 8 246 #define PETSC_VIEWER_STDOUT_SELF_FORTRAN 9 247 #define PETSC_VIEWER_STDERR_WORLD_FORTRAN 10 248 #define PETSC_VIEWER_STDERR_SELF_FORTRAN 11 249 #define PETSC_VIEWER_BINARY_WORLD_FORTRAN 12 250 #define PETSC_VIEWER_BINARY_SELF_FORTRAN 13 251 #define PETSC_VIEWER_MATLAB_WORLD_FORTRAN 14 252 #define PETSC_VIEWER_MATLAB_SELF_FORTRAN 15 253 254 #include <petscviewer.h> 255 256 static inline PetscViewer PetscPatchDefaultViewers(PetscViewer *v) 257 { 258 if (!v) return PETSC_NULLPTR; 259 if (!(*(void **)v)) return PETSC_NULLPTR; 260 switch (*(PetscFortranAddr *)v) { 261 case PETSC_VIEWER_DRAW_WORLD_FORTRAN: 262 return PETSC_VIEWER_DRAW_WORLD; 263 case PETSC_VIEWER_DRAW_SELF_FORTRAN: 264 return PETSC_VIEWER_DRAW_SELF; 265 266 case PETSC_VIEWER_STDOUT_WORLD_FORTRAN: 267 return PETSC_VIEWER_STDOUT_WORLD; 268 case PETSC_VIEWER_STDOUT_SELF_FORTRAN: 269 return PETSC_VIEWER_STDOUT_SELF; 270 271 case PETSC_VIEWER_STDERR_WORLD_FORTRAN: 272 return PETSC_VIEWER_STDERR_WORLD; 273 case PETSC_VIEWER_STDERR_SELF_FORTRAN: 274 return PETSC_VIEWER_STDERR_SELF; 275 276 case PETSC_VIEWER_BINARY_WORLD_FORTRAN: 277 return PETSC_VIEWER_BINARY_WORLD; 278 case PETSC_VIEWER_BINARY_SELF_FORTRAN: 279 return PETSC_VIEWER_BINARY_SELF; 280 281 #if defined(PETSC_HAVE_MATLAB) 282 case PETSC_VIEWER_MATLAB_SELF_FORTRAN: 283 return PETSC_VIEWER_MATLAB_SELF; 284 case PETSC_VIEWER_MATLAB_WORLD_FORTRAN: 285 return PETSC_VIEWER_MATLAB_WORLD; 286 #endif 287 288 #if defined(PETSC_USE_SOCKET_VIEWER) 289 case PETSC_VIEWER_SOCKET_WORLD_FORTRAN: 290 return PETSC_VIEWER_SOCKET_WORLD; 291 case PETSC_VIEWER_SOCKET_SELF_FORTRAN: 292 return PETSC_VIEWER_SOCKET_SELF; 293 #endif 294 295 default: 296 return *v; 297 } 298 } 299 300 #if defined(PETSC_USE_SOCKET_VIEWER) 301 #define PetscPatchDefaultViewers_Fortran_Socket(vin, v) \ 302 } \ 303 else if ((*(PetscFortranAddr *)vin) == PETSC_VIEWER_SOCKET_WORLD_FORTRAN) \ 304 { \ 305 v = PETSC_VIEWER_SOCKET_WORLD; \ 306 } \ 307 else if ((*(PetscFortranAddr *)vin) == PETSC_VIEWER_SOCKET_SELF_FORTRAN) \ 308 { \ 309 v = PETSC_VIEWER_SOCKET_SELF 310 #else 311 #define PetscPatchDefaultViewers_Fortran_Socket(vin, v) 312 #endif 313 314 #define PetscPatchDefaultViewers_Fortran(vin, v) \ 315 do { \ 316 if ((*(PetscFortranAddr *)vin) == PETSC_VIEWER_DRAW_WORLD_FORTRAN) { \ 317 v = PETSC_VIEWER_DRAW_WORLD; \ 318 } else if ((*(PetscFortranAddr *)vin) == PETSC_VIEWER_DRAW_SELF_FORTRAN) { \ 319 v = PETSC_VIEWER_DRAW_SELF; \ 320 } else if ((*(PetscFortranAddr *)vin) == PETSC_VIEWER_STDOUT_WORLD_FORTRAN) { \ 321 v = PETSC_VIEWER_STDOUT_WORLD; \ 322 } else if ((*(PetscFortranAddr *)vin) == PETSC_VIEWER_STDOUT_SELF_FORTRAN) { \ 323 v = PETSC_VIEWER_STDOUT_SELF; \ 324 } else if ((*(PetscFortranAddr *)vin) == PETSC_VIEWER_STDERR_WORLD_FORTRAN) { \ 325 v = PETSC_VIEWER_STDERR_WORLD; \ 326 } else if ((*(PetscFortranAddr *)vin) == PETSC_VIEWER_STDERR_SELF_FORTRAN) { \ 327 v = PETSC_VIEWER_STDERR_SELF; \ 328 } else if ((*(PetscFortranAddr *)vin) == PETSC_VIEWER_BINARY_WORLD_FORTRAN) { \ 329 v = PETSC_VIEWER_BINARY_WORLD; \ 330 } else if ((*(PetscFortranAddr *)vin) == PETSC_VIEWER_BINARY_SELF_FORTRAN) { \ 331 v = PETSC_VIEWER_BINARY_SELF; \ 332 } else if ((*(PetscFortranAddr *)vin) == PETSC_VIEWER_MATLAB_WORLD_FORTRAN) { \ 333 v = PETSC_VIEWER_BINARY_WORLD; \ 334 } else if ((*(PetscFortranAddr *)vin) == PETSC_VIEWER_MATLAB_SELF_FORTRAN) { \ 335 v = PETSC_VIEWER_BINARY_SELF; \ 336 PetscPatchDefaultViewers_Fortran_Socket(vin, v); \ 337 } else { \ 338 v = *vin; \ 339 } \ 340 } while (0) 341 342 /* 343 Allocates enough space to store Fortran function pointers in PETSc object 344 that are needed by the Fortran interface. 345 */ 346 #define PetscObjectAllocateFortranPointers(obj, N) \ 347 do { \ 348 if (!((PetscObject)(obj))->fortran_func_pointers) { \ 349 *ierr = PetscCalloc((N) * sizeof(void (*)(void)), &((PetscObject)(obj))->fortran_func_pointers); \ 350 if (*ierr) return; \ 351 ((PetscObject)obj)->num_fortran_func_pointers = (N); \ 352 } \ 353 } while (0) 354 355 #define PetscCallFortranVoidFunction(...) \ 356 do { \ 357 PetscErrorCode ierr = PETSC_SUCCESS; \ 358 /* the function may or may not access ierr */ \ 359 __VA_ARGS__; \ 360 PetscCall(ierr); \ 361 } while (0) 362 363 /* Entire function body, _ctx is a "special" variable that can be passed along */ 364 #define PetscObjectUseFortranCallback_Private(obj, cid, types, args, cbclass) \ 365 do { \ 366 void(*func) types, *_ctx; \ 367 PetscFunctionBegin; \ 368 PetscCall(PetscObjectGetFortranCallback((PetscObject)(obj), (cbclass), (cid), (PetscVoidFn **)&func, &_ctx)); \ 369 if (func) PetscCallFortranVoidFunction((*func)args); \ 370 PetscFunctionReturn(PETSC_SUCCESS); \ 371 } while (0) 372 #define PetscObjectUseFortranCallback(obj, cid, types, args) PetscObjectUseFortranCallback_Private(obj, cid, types, args, PETSC_FORTRAN_CALLBACK_CLASS) 373 #define PetscObjectUseFortranCallbackSubType(obj, cid, types, args) PetscObjectUseFortranCallback_Private(obj, cid, types, args, PETSC_FORTRAN_CALLBACK_SUBTYPE) 374 375 /* Disable deprecation warnings while building Fortran wrappers */ 376 #undef PETSC_DEPRECATED_OBJECT 377 #define PETSC_DEPRECATED_OBJECT(...) 378 #undef PETSC_DEPRECATED_FUNCTION 379 #define PETSC_DEPRECATED_FUNCTION(...) 380 #undef PETSC_DEPRECATED_ENUM 381 #define PETSC_DEPRECATED_ENUM(...) 382 #undef PETSC_DEPRECATED_TYPEDEF 383 #define PETSC_DEPRECATED_TYPEDEF(...) 384 #undef PETSC_DEPRECATED_MACRO 385 #define PETSC_DEPRECATED_MACRO(...) 386 387 /* PGI compilers pass in f90 pointers as 2 arguments */ 388 #if defined(PETSC_HAVE_F90_2PTR_ARG) 389 #define PETSC_F90_2PTR_PROTO_NOVAR , void * 390 #define PETSC_F90_2PTR_PROTO(ptr) , void *ptr 391 #define PETSC_F90_2PTR_PARAM(ptr) , ptr 392 #else 393 #define PETSC_F90_2PTR_PROTO_NOVAR 394 #define PETSC_F90_2PTR_PROTO(ptr) 395 #define PETSC_F90_2PTR_PARAM(ptr) 396 #endif 397 398 typedef struct { 399 char dummy; 400 } F90Array1d; 401 typedef struct { 402 char dummy; 403 } F90Array2d; 404 typedef struct { 405 char dummy; 406 } F90Array3d; 407 typedef struct { 408 char dummy; 409 } F90Array4d; 410 411 PETSC_EXTERN PetscErrorCode F90Array1dCreate(void *, MPI_Datatype, PetscInt, PetscInt, F90Array1d *PETSC_F90_2PTR_PROTO_NOVAR); 412 PETSC_EXTERN PetscErrorCode F90Array1dAccess(F90Array1d *, MPI_Datatype, void **PETSC_F90_2PTR_PROTO_NOVAR); 413 PETSC_EXTERN PetscErrorCode F90Array1dDestroy(F90Array1d *, MPI_Datatype PETSC_F90_2PTR_PROTO_NOVAR); 414 415 PETSC_EXTERN PetscErrorCode F90Array2dCreate(void *, MPI_Datatype, PetscInt, PetscInt, PetscInt, PetscInt, F90Array2d *PETSC_F90_2PTR_PROTO_NOVAR); 416 PETSC_EXTERN PetscErrorCode F90Array2dAccess(F90Array2d *, MPI_Datatype, void **PETSC_F90_2PTR_PROTO_NOVAR); 417 PETSC_EXTERN PetscErrorCode F90Array2dDestroy(F90Array2d *, MPI_Datatype PETSC_F90_2PTR_PROTO_NOVAR); 418 419 PETSC_EXTERN PetscErrorCode F90Array3dCreate(void *, MPI_Datatype, PetscInt, PetscInt, PetscInt, PetscInt, PetscInt, PetscInt, F90Array3d *PETSC_F90_2PTR_PROTO_NOVAR); 420 PETSC_EXTERN PetscErrorCode F90Array3dAccess(F90Array3d *, MPI_Datatype, void **PETSC_F90_2PTR_PROTO_NOVAR); 421 PETSC_EXTERN PetscErrorCode F90Array3dDestroy(F90Array3d *, MPI_Datatype PETSC_F90_2PTR_PROTO_NOVAR); 422 423 PETSC_EXTERN PetscErrorCode F90Array4dCreate(void *, MPI_Datatype, PetscInt, PetscInt, PetscInt, PetscInt, PetscInt, PetscInt, PetscInt, PetscInt, F90Array4d *PETSC_F90_2PTR_PROTO_NOVAR); 424 PETSC_EXTERN PetscErrorCode F90Array4dAccess(F90Array4d *, MPI_Datatype, void **PETSC_F90_2PTR_PROTO_NOVAR); 425 PETSC_EXTERN PetscErrorCode F90Array4dDestroy(F90Array4d *, MPI_Datatype PETSC_F90_2PTR_PROTO_NOVAR); 426 427 /* 428 F90Array1dCreate - Given a C pointer to a one dimensional 429 array and its length; this fills in the appropriate Fortran 90 430 pointer data structure. 431 432 Input Parameters: 433 + array - regular C pointer (address) 434 . type - DataType of the array 435 . start - starting index of the array 436 - len - length of array (in items) 437 438 Output Parameter: 439 . ptr - Fortran 90 pointer 440 */ 441