void PETSC_STDCALL taosetconvergencetest_(Tao *tao, void (PETSC_STDCALL *func)(Tao*,void*,PetscErrorCode*),void *ctx, PetscErrorCode *ierr)
{
CHKFORTRANNULLOBJECT(ctx);
PetscObjectAllocateFortranPointers(*tao,NFUNCS);
if (!func) {
*ierr = TaoSetConvergenceTest(*tao,0,ctx);
} else {
((PetscObject)*tao)->fortran_func_pointers[CONVTEST] = (PetscVoidFunction)func;
*ierr = TaoSetConvergenceTest(*tao,ourtaoconvergencetest,ctx);
}
}
void PETSC_STDCALL taosethessianroutine_(Tao *tao, Mat *J, Mat *Jp, void (PETSC_STDCALL *func)(Tao*, Vec *, Mat *, Mat *,void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
{
CHKFORTRANNULLOBJECT(ctx);
PetscObjectAllocateFortranPointers(*tao,NFUNCS);
if (!func) {
*ierr = TaoSetHessianRoutine(*tao,*J,*Jp,0,ctx);
} else {
((PetscObject)*tao)->fortran_func_pointers[HESS] = (PetscVoidFunction)func;
*ierr = TaoSetHessianRoutine(*tao,*J, *Jp, ourtaohessianroutine,ctx);
}
}
void PETSC_STDCALL taosetseparableobjectiveroutine_(Tao *tao, Vec *F, void (PETSC_STDCALL *func)(Tao*, Vec *, Vec *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
{
CHKFORTRANNULLOBJECT(ctx);
PetscObjectAllocateFortranPointers(*tao,NFUNCS);
if (!func) {
*ierr = TaoSetSeparableObjectiveRoutine(*tao,*F,0,ctx);
} else {
((PetscObject)*tao)->fortran_func_pointers[SEPOBJ] = (PetscVoidFunction)func;
*ierr = TaoSetSeparableObjectiveRoutine(*tao,*F, ourtaoseparableobjectiveroutine,ctx);
}
}
void PETSC_STDCALL taosetjacobiandesignroutine_(Tao *tao, Mat *J, void (PETSC_STDCALL *func)(Tao*, Vec *, Mat *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
{
CHKFORTRANNULLOBJECT(ctx);
PetscObjectAllocateFortranPointers(*tao,NFUNCS);
if (!func) {
*ierr = TaoSetJacobianDesignRoutine(*tao,*J,0,ctx);
} else {
((PetscObject)*tao)->fortran_func_pointers[JACDESIGN] = (PetscVoidFunction)func;
*ierr = TaoSetJacobianDesignRoutine(*tao,*J, ourtaojacobiandesignroutine,ctx);
}
}
void PETSC_STDCALL taosetobjectiveandgradientroutine_(Tao *tao, void (PETSC_STDCALL *func)(Tao*, Vec *, PetscReal *, Vec *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
{
CHKFORTRANNULLOBJECT(ctx);
PetscObjectAllocateFortranPointers(*tao,NFUNCS);
if (!func) {
*ierr = TaoSetObjectiveAndGradientRoutine(*tao,0,ctx);
} else {
((PetscObject)*tao)->fortran_func_pointers[OBJGRAD] = (PetscVoidFunction)func;
*ierr = TaoSetObjectiveAndGradientRoutine(*tao, ourtaoobjectiveandgradientroutine,ctx);
}
}
PETSC_EXTERN void PETSC_STDCALL taosetmonitor_(Tao *tao, void (PETSC_STDCALL *func)(Tao*,void*,PetscErrorCode*),void *ctx, void (PETSC_STDCALL *mondestroy)(void*,PetscErrorCode*),PetscErrorCode *ierr)
{
PetscObjectAllocateFortranPointers(*tao,NFUNCS);
if (func) {
((PetscObject)*tao)->fortran_func_pointers[MON] = (PetscVoidFunction)func;
if (FORTRANNULLFUNCTION(mondestroy)){
*ierr = TaoSetMonitor(*tao,ourtaomonitor,ctx,NULL);
} else {
*ierr = TaoSetMonitor(*tao,ourtaomonitor,ctx,ourtaomondestroy);
}
}
}
void PETSC_STDCALL taosetvariableboundsroutine_(Tao *tao, void (PETSC_STDCALL *func)(Tao*,Vec*,Vec*,void*,PetscErrorCode*),void *ctx, PetscErrorCode *ierr)
{
CHKFORTRANNULLOBJECT(ctx);
PetscObjectAllocateFortranPointers(*tao,NFUNCS);
if (func) {
((PetscObject)*tao)->fortran_func_pointers[BOUNDS] = (PetscVoidFunction)func;
*ierr = TaoSetVariableBoundsRoutine(*tao,ourtaoboundsroutine,ctx);
} else {
*ierr = TaoSetVariableBoundsRoutine(*tao,0,ctx);
}
}
void PETSC_STDCALL pcmgsetresidual_(PC *pc,PetscInt *l,PetscErrorCode (*residual)(Mat*,Vec*,Vec*,Vec*,PetscErrorCode*),Mat *mat, PetscErrorCode *ierr)
{
MVVVV rr;
if ((PetscVoidFunction)residual == (PetscVoidFunction)pcmgdefaultresidual_) rr = PCMGDefaultResidual;
else {
PetscObjectAllocateFortranPointers(*mat,1);
/* Attach the residual computer to the Mat, this is not ideal but the only object/context passed in the residual computer */
((PetscObject)*mat)->fortran_func_pointers[0] = (PetscVoidFunction)residual;
rr = ourresidualfunction;
}
*ierr = PCMGSetResidual(*pc,*l,rr,*mat);
}
EXTERN_C_BEGIN
PETSC_EXTERN void PETSC_STDCALL taosetobjectiveroutine_(Tao *tao, void (PETSC_STDCALL *func)(Tao*, Vec *, PetscReal *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
{
PetscObjectAllocateFortranPointers(*tao,NFUNCS);
if (!func) {
*ierr = TaoSetObjectiveRoutine(*tao,0,ctx);
} else {
((PetscObject)*tao)->fortran_func_pointers[OBJ] = (PetscVoidFunction)func;
*ierr = TaoSetObjectiveRoutine(*tao, ourtaoobjectiveroutine,ctx);
}
}
void PETSC_STDCALL dasetlocalfunction_(DA *da,void (PETSC_STDCALL *func)(DALocalInfo*,void*,void*,void*,PetscErrorCode*),PetscErrorCode *ierr)
{
PetscInt dim;
PetscObjectAllocateFortranPointers(*da,6);
*ierr = DAGetInfo(*da,&dim,0,0,0,0,0,0,0,0,0,0); if (*ierr) return;
if (dim == 2) {
((PetscObject)*da)->fortran_func_pointers[4] = (PetscVoidFunction)func;
*ierr = DASetLocalFunction(*da,(DALocalFunction1)ourlf2d);
} else if (dim == 3) {
((PetscObject)*da)->fortran_func_pointers[5] = (PetscVoidFunction)func;
*ierr = DASetLocalFunction(*da,(DALocalFunction1)ourlf3d);
} else if (dim == 1) {
((PetscObject)*da)->fortran_func_pointers[3] = (PetscVoidFunction)func;
*ierr = DASetLocalFunction(*da,(DALocalFunction1)ourlf1d);
} else *ierr = 1;
}
void PETSC_STDCALL dasetlocaljacobian_(DA *da,void (PETSC_STDCALL *jac)(DALocalInfo*,void*,void*,void*,PetscErrorCode*),PetscErrorCode *ierr)
{
PetscInt dim;
PetscObjectAllocateFortranPointers(*da,6);
*ierr = DAGetInfo(*da,&dim,0,0,0,0,0,0,0,0,0,0); if (*ierr) return;
if (dim == 2) {
((PetscObject)*da)->fortran_func_pointers[1] = (PetscVoidFunction)jac;
*ierr = DASetLocalJacobian(*da,(DALocalFunction1)ourlj2d);
} else if (dim == 3) {
((PetscObject)*da)->fortran_func_pointers[2] = (PetscVoidFunction)jac;
*ierr = DASetLocalJacobian(*da,(DALocalFunction1)ourlj3d);
} else if (dim == 1) {
((PetscObject)*da)->fortran_func_pointers[0] = (PetscVoidFunction)jac;
*ierr = DASetLocalJacobian(*da,(DALocalFunction1)ourlj1d);
} else *ierr = 1;
}
void PETSC_STDCALL matshellsetoperation_(Mat *mat,MatOperation *op,PetscErrorCode (PETSC_STDCALL *f)(Mat*,Vec*,Vec*,PetscErrorCode*),PetscErrorCode *ierr)
{
MPI_Comm comm;
*ierr = PetscObjectGetComm((PetscObject)*mat,&comm);if (*ierr) return;
PetscObjectAllocateFortranPointers(*mat,11);
if (*op == MATOP_MULT) {
*ierr = MatShellSetOperation(*mat,*op,(PetscVoidFunction)ourmult);
((PetscObject)*mat)->fortran_func_pointers[0] = (PetscVoidFunction)f;
} else if (*op == MATOP_MULT_TRANSPOSE) {
*ierr = MatShellSetOperation(*mat,*op,(PetscVoidFunction)ourmulttranspose);
((PetscObject)*mat)->fortran_func_pointers[2] = (PetscVoidFunction)f;
} else if (*op == MATOP_MULT_ADD) {
*ierr = MatShellSetOperation(*mat,*op,(PetscVoidFunction)ourmultadd);
((PetscObject)*mat)->fortran_func_pointers[1] = (PetscVoidFunction)f;
} else if (*op == MATOP_MULT_TRANSPOSE_ADD) {
*ierr = MatShellSetOperation(*mat,*op,(PetscVoidFunction)ourmulttransposeadd);
((PetscObject)*mat)->fortran_func_pointers[3] = (PetscVoidFunction)f;
} else if (*op == MATOP_GET_DIAGONAL) {
*ierr = MatShellSetOperation(*mat,*op,(PetscVoidFunction)ourgetdiagonal);
((PetscObject)*mat)->fortran_func_pointers[4] = (PetscVoidFunction)f;
} else if (*op == MATOP_DIAGONAL_SCALE) {
*ierr = MatShellSetOperation(*mat,*op,(PetscVoidFunction)ourdiagonalscale);
((PetscObject)*mat)->fortran_func_pointers[5] = (PetscVoidFunction)f;
} else if (*op == MATOP_DIAGONAL_SET) {
*ierr = MatShellSetOperation(*mat,*op,(PetscVoidFunction)ourdiagonalset);
((PetscObject)*mat)->fortran_func_pointers[6] = (PetscVoidFunction)f;
} else if (*op == MATOP_GET_VECS) {
*ierr = MatShellSetOperation(*mat,*op,(PetscVoidFunction)ourgetvecs);
((PetscObject)*mat)->fortran_func_pointers[7] = (PetscVoidFunction)f;
} else if (*op == MATOP_VIEW) {
*ierr = MatShellSetOperation(*mat,*op,(PetscVoidFunction)ourview);
((PetscObject)*mat)->fortran_func_pointers[8] = (PetscVoidFunction)f;
} else if (*op == MATOP_SOR) {
*ierr = MatShellSetOperation(*mat,*op,(PetscVoidFunction)oursor);
((PetscObject)*mat)->fortran_func_pointers[9] = (PetscVoidFunction)f;
} else if (*op == MATOP_SHIFT) {
*ierr = MatShellSetOperation(*mat,*op,(PetscVoidFunction)ourshift);
((PetscObject)*mat)->fortran_func_pointers[10] = (PetscVoidFunction)f;
} else {
PetscError(comm,__LINE__,"MatShellSetOperation_Fortran",__FILE__,__SDIR__,PETSC_ERR_ARG_WRONG,PETSC_ERROR_INITIAL,
"Cannot set that matrix operation");
*ierr = 1;
}
}
PETSC_EXTERN void PETSC_STDCALL pcshellsetapplyrichardson_(PC *pc,void (PETSC_STDCALL *apply)(void*,Vec*,Vec*,Vec*,PetscReal*,PetscReal*,PetscReal*,PetscInt*,PetscBool*,PetscInt*,PCRichardsonConvergedReason*,PetscErrorCode*),PetscErrorCode *ierr)
{
PetscObjectAllocateFortranPointers(*pc,9);
((PetscObject)*pc)->fortran_func_pointers[2] = (PetscVoidFunction)apply;
*ierr = PCShellSetApplyRichardson(*pc,ourapplyrichardson);
}
void PETSC_STDCALL matnullspacesetfunction_(MatNullSpace *sp, PetscErrorCode (*rem)(MatNullSpace,Vec,void*),void *ctx,PetscErrorCode *ierr)
{
PetscObjectAllocateFortranPointers(*sp,1);
((PetscObject)*sp)->fortran_func_pointers[0] = (PetscVoidFunction)rem;
*ierr = MatNullSpaceSetFunction(*sp,ournullfunction,ctx);
}
