1 #include <petsc-private/fortranimpl.h> 2 #include <petsc-private/daimpl.h> 3 #include <petscsnes.h> 4 #if defined(PETSC_HAVE_FORTRAN_CAPS) 5 #define dmdasnessetjacobianlocal_ DMDASNESSETJACOBIANLOCAL 6 #define dmdasnessetfunctionlocal_ DMDASNESSETFUNCTIONLOCAL 7 #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE) 8 #define dmdasnessetjacobianlocal_ dmdasnessetjacobianlocal 9 #define dmdasnessetfunctionlocal_ dmdasnessetfunctionlocal 10 #endif 11 12 EXTERN_C_BEGIN 13 /************************************************/ 14 static PetscErrorCode sourlj1d(DMDALocalInfo *info,PetscScalar *in,Mat A,Mat m,MatStructure *str,void *ptr) 15 { 16 PetscErrorCode ierr = 0; 17 (*(void (PETSC_STDCALL *)(DMDALocalInfo*,PetscScalar*,Mat*,Mat*,MatStructure*,void*,PetscErrorCode*))(((PetscObject)info->da)->fortran_func_pointers[0]))(info,&in[info->dof*info->gxs],&A,&m,str,ptr,&ierr);CHKERRQ(ierr); 18 return 0; 19 } 20 21 static PetscErrorCode sourlj2d(DMDALocalInfo *info,PetscScalar **in,Mat A,Mat m,MatStructure *str,void *ptr) 22 { 23 PetscErrorCode ierr = 0; 24 (*(void (PETSC_STDCALL *)(DMDALocalInfo*,PetscScalar*,Mat*,Mat*,MatStructure*,void*,PetscErrorCode*))(((PetscObject)info->da)->fortran_func_pointers[1]))(info,&in[info->gys][info->dof*info->gxs],&A,&m,str,ptr,&ierr);CHKERRQ(ierr); 25 return 0; 26 } 27 28 static PetscErrorCode sourlj3d(DMDALocalInfo *info,PetscScalar ***in,Mat A,Mat m,MatStructure *str,void *ptr) 29 { 30 PetscErrorCode ierr = 0; 31 (*(void (PETSC_STDCALL *)(DMDALocalInfo*,PetscScalar*,Mat*,Mat*,MatStructure*,void*,PetscErrorCode*))(((PetscObject)info->da)->fortran_func_pointers[2]))(info,&in[info->gzs][info->gys][info->dof*info->gxs],&A,&m,str,ptr,&ierr);CHKERRQ(ierr); 32 return 0; 33 } 34 35 /* 36 This is buggy, the function pointers should really be attached to the DMSNES object 37 */ 38 void PETSC_STDCALL dmdasnessetjacobianlocal_(DM *da,void (PETSC_STDCALL *jac)(DMDALocalInfo*,void*,void*,void*,void*,void*,PetscErrorCode*),void *ctx,PetscErrorCode *ierr) 39 { 40 PetscInt dim; 41 42 PetscObjectAllocateFortranPointers(*da,6); 43 *ierr = DMDAGetInfo(*da,&dim,0,0,0,0,0,0,0,0,0,0,0,0); if (*ierr) return; 44 if (dim == 2) { 45 ((PetscObject)*da)->fortran_func_pointers[1] = (PetscVoidFunction)jac; 46 *ierr = DMDASNESSetJacobianLocal(*da,(PetscErrorCode (*)(DMDALocalInfo*,void*,Mat,Mat,MatStructure*,void*))sourlj2d,ctx); 47 } else if (dim == 3) { 48 ((PetscObject)*da)->fortran_func_pointers[2] = (PetscVoidFunction)jac; 49 *ierr = DMDASNESSetJacobianLocal(*da,(PetscErrorCode (*)(DMDALocalInfo*,void*,Mat,Mat,MatStructure*,void*))sourlj3d,ctx); 50 } else if (dim == 1) { 51 ((PetscObject)*da)->fortran_func_pointers[0] = (PetscVoidFunction)jac; 52 *ierr = DMDASNESSetJacobianLocal(*da,(PetscErrorCode (*)(DMDALocalInfo*,void*,Mat,Mat,MatStructure*,void*))sourlj1d,ctx); 53 } else *ierr = 1; 54 } 55 56 /************************************************/ 57 58 static PetscErrorCode sourlf1d(DMDALocalInfo *info,PetscScalar *in,PetscScalar *out,void *ptr) 59 { 60 PetscErrorCode ierr = 0; 61 (*(void (PETSC_STDCALL *)(DMDALocalInfo*,PetscScalar*,PetscScalar*,void*,PetscErrorCode*))(((PetscObject)info->da)->fortran_func_pointers[3]))(info,&in[info->dof*info->gxs],&out[info->dof*info->xs],ptr,&ierr);CHKERRQ(ierr); 62 return 0; 63 } 64 65 static PetscErrorCode sourlf2d(DMDALocalInfo *info,PetscScalar **in,PetscScalar **out,void *ptr) 66 { 67 PetscErrorCode ierr = 0; 68 (*(void (PETSC_STDCALL *)(DMDALocalInfo*,PetscScalar*,PetscScalar*,void*,PetscErrorCode*))(((PetscObject)info->da)->fortran_func_pointers[4]))(info,&in[info->gys][info->dof*info->gxs],&out[info->ys][info->dof*info->xs],ptr,&ierr);CHKERRQ(ierr); 69 return 0; 70 } 71 72 static PetscErrorCode sourlf3d(DMDALocalInfo *info,PetscScalar ***in,PetscScalar ***out,void *ptr) 73 { 74 PetscErrorCode ierr = 0; 75 (*(void (PETSC_STDCALL *)(DMDALocalInfo*,PetscScalar*,PetscScalar*,void*,PetscErrorCode*))(((PetscObject)info->da)->fortran_func_pointers[5]))(info,&in[info->gzs][info->gys][info->dof*info->gxs],&out[info->zs][info->ys][info->dof*info->xs],ptr,&ierr);CHKERRQ(ierr); 76 return 0; 77 } 78 79 /* 80 This is buggy, the function pointers should really be attached to the DMSNES object 81 */ 82 void PETSC_STDCALL dmdasnessetfunctionlocal_(DM *da,InsertMode *mode,void (PETSC_STDCALL *func)(DMDALocalInfo*,void*,void*,void*,PetscErrorCode*),void *ctx,PetscErrorCode *ierr) 83 { 84 PetscInt dim; 85 86 PetscObjectAllocateFortranPointers(*da,6); 87 *ierr = DMDAGetInfo(*da,&dim,0,0,0,0,0,0,0,0,0,0,0,0); if (*ierr) return; 88 if (dim == 2) { 89 ((PetscObject)*da)->fortran_func_pointers[4] = (PetscVoidFunction)func; 90 *ierr = DMDASNESSetFunctionLocal(*da,*mode,(PetscErrorCode (*)(DMDALocalInfo*,void*,void*,void*))sourlf2d,ctx); 91 } else if (dim == 3) { 92 ((PetscObject)*da)->fortran_func_pointers[5] = (PetscVoidFunction)func; 93 *ierr = DMDASNESSetFunctionLocal(*da,*mode,(PetscErrorCode (*)(DMDALocalInfo*,void*,void*,void*))sourlf3d,ctx); 94 } else if (dim == 1) { 95 ((PetscObject)*da)->fortran_func_pointers[3] = (PetscVoidFunction)func; 96 *ierr = DMDASNESSetFunctionLocal(*da,*mode,(PetscErrorCode (*)(DMDALocalInfo*,void*,void*,void*))sourlf1d,ctx); 97 } else *ierr = 1; 98 } 99 100 EXTERN_C_END 101