PETSC_EXTERN void PETSC_STDCALL pcgetoperators_(PC *pc,Mat *mat,Mat *pmat,MatStructure *flag,PetscErrorCode *ierr)
{
CHKFORTRANNULLOBJECT(mat);
CHKFORTRANNULLOBJECT(pmat);
CHKFORTRANNULLINTEGER(flag);
*ierr = PCGetOperators(*pc,mat,pmat,flag);
}
PETSC_EXTERN void PETSC_STDCALL dmdagetscatter_(DM *da,VecScatter *ltog,VecScatter *gtol,VecScatter *ltol,PetscErrorCode *ierr)
{
CHKFORTRANNULLOBJECT(ltog);
CHKFORTRANNULLOBJECT(gtol);
CHKFORTRANNULLOBJECT(ltol);
*ierr = DMDAGetScatter(*da,ltog,gtol,ltol);
}
PETSC_EXTERN void PETSC_STDCALL aocreatebasicis_(IS *isapp,IS *ispetsc,AO *aoout,PetscErrorCode *ierr)
{
IS cispetsc = NULL;
CHKFORTRANNULLOBJECT(ispetsc);
if (ispetsc) cispetsc = *ispetsc;
*ierr = AOCreateBasicIS(*isapp,cispetsc,aoout);
}
PETSC_EXTERN void PETSC_STDCALL aocreatememoryscalableis_(IS *isapp,IS *ispetsc,AO *aoout,PetscErrorCode *ierr)
{
IS cispetsc = NULL;
CHKFORTRANNULLOBJECT(ispetsc);
if (ispetsc) cispetsc = *ispetsc;
*ierr = AOCreateMemoryScalableIS(*isapp,cispetsc,aoout);
}
PETSC_EXTERN void PETSC_STDCALL matnestgetsubmats_(Mat *A,PetscInt *M,PetscInt *N,Mat *sub,int *ierr)
{
PetscInt i,j,m,n;
Mat **mat;
CHKFORTRANNULLINTEGER(M);
CHKFORTRANNULLINTEGER(N);
CHKFORTRANNULLOBJECT(sub);
*ierr = MatNestGetSubMats(*A,&m,&n,&mat);
if (M) {
*M = m;
}
if (N) {
*N = n;
}
if (sub) {
for (i=0; i<m; i++) {
for (j=0; j<n; j++) {
sub[j + n * i] = mat[i][j];
}
}
}
}
PETSC_EXTERN void PETSC_STDCALL pcasmgetlocalsubdomains_(PC *pc,PetscInt *n,IS *is,IS *is_local, PetscErrorCode *ierr)
{
PetscInt nloc,i;
IS *tis, *tis_local;
CHKFORTRANNULLOBJECT(is);
CHKFORTRANNULLOBJECT(is_local);
CHKFORTRANNULLINTEGER(n);
*ierr = PCASMGetLocalSubdomains(*pc,&nloc,&tis,&tis_local);
if (n) *n = nloc;
if (is) {
for (i=0; i<nloc; i++) is[i] = tis[i];
}
if (is_local && tis_local) {
for (i=0; i<nloc; i++) is_local[i] = tis_local[i];
}
}
PETSC_EXTERN void PETSC_STDCALL matmffdsetfunction_(Mat *mat,void (PETSC_STDCALL *func)(void*,Vec*,Vec*,PetscErrorCode*),void *ctx,PetscErrorCode *ierr)
{
CHKFORTRANNULLOBJECT(ctx);
PetscObjectAllocateFortranPointers(*mat,2);
((PetscObject)*mat)->fortran_func_pointers[0] = (PetscVoidFunction)func;
((PetscObject)*mat)->fortran_func_pointers[1] = (PetscVoidFunction)(PETSC_UINTPTR_T)ctx;
*ierr = MatMFFDSetFunction(*mat,ourmatmffdfunction,*mat);
}
PETSC_EXTERN void PETSC_STDCALL dmkspsetcomputeoperators_(DM *dm,void (PETSC_STDCALL *func)(KSP*,Vec*,void*,PetscErrorCode*),void *ctx,PetscErrorCode *ierr)
{
DMKSP kdm;
CHKFORTRANNULLOBJECT(ctx);
*ierr = DMGetDMKSP(*dm,&kdm);
if (!*ierr) {
kdm->fortran_func_pointers[1] = (PetscVoidFunction)func;
*ierr = DMKSPSetComputeOperators(*dm,ourkspcomputeoperators,ctx);
}
}
PETSC_EXTERN void PETSC_STDCALL taolinesearchsetobjectiveandgradientroutine_(TaoLineSearch *ls, void (PETSC_STDCALL *func)(TaoLineSearch*, Vec *, PetscReal *, Vec *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
{
CHKFORTRANNULLOBJECT(ctx);
PetscObjectAllocateFortranPointers(*ls,NFUNCS);
if (!func) {
*ierr = TaoLineSearchSetObjectiveAndGradientRoutine(*ls,0,ctx);
} else {
((PetscObject)*ls)->fortran_func_pointers[OBJGRAD] = (PetscVoidFunction)func;
*ierr = TaoLineSearchSetObjectiveAndGradientRoutine(*ls, ourtaolinesearchobjectiveandgradientroutine,ctx);
}
}
void PETSC_STDCALL taosetconstraintsroutine_(Tao *tao, Vec *C, void (PETSC_STDCALL *func)(Tao*, Vec *, Vec *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
{
CHKFORTRANNULLOBJECT(ctx);
PetscObjectAllocateFortranPointers(*tao,NFUNCS);
if (!func) {
*ierr = TaoSetConstraintsRoutine(*tao,*C,0,ctx);
} else {
((PetscObject)*tao)->fortran_func_pointers[CONSTRAINTS] = (PetscVoidFunction)func;
*ierr = TaoSetConstraintsRoutine(*tao, *C, ourtaoconstraintsroutine,ctx);
}
}
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 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 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 taosetgradientroutine_(Tao *tao, void (PETSC_STDCALL *func)(Tao*, Vec *, Vec *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
{
CHKFORTRANNULLOBJECT(ctx);
PetscObjectAllocateFortranPointers(*tao,NFUNCS);
if (!func) {
*ierr = TaoSetGradientRoutine(*tao,0,ctx);
} else {
((PetscObject)*tao)->fortran_func_pointers[GRAD] = (PetscVoidFunction)func;
*ierr = TaoSetGradientRoutine(*tao, ourtaogradientroutine,ctx);
}
}
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);
}
}
PETSC_EXTERN void PETSC_STDCALL pcasmgetlocalsubmatrices_(PC *pc,PetscInt *n,Mat *mat, PetscErrorCode *ierr)
{
PetscInt nloc,i;
Mat *tmat;
CHKFORTRANNULLOBJECT(mat);
CHKFORTRANNULLINTEGER(n);
*ierr = PCASMGetLocalSubmatrices(*pc,&nloc,&tmat);
if (n) *n = nloc;
if (mat) {
for (i=0; i<nloc; i++) mat[i] = tmat[i];
}
}
PETSC_EXTERN void PETSC_STDCALL pcasmgetsubksp_(PC *pc,PetscInt *n_local,PetscInt *first_local,KSP *ksp,PetscErrorCode *ierr)
{
KSP *tksp;
PetscInt i,nloc;
CHKFORTRANNULLINTEGER(n_local);
CHKFORTRANNULLINTEGER(first_local);
CHKFORTRANNULLOBJECT(ksp);
*ierr = PCASMGetSubKSP(*pc,&nloc,first_local,&tksp);
if (n_local) *n_local = nloc;
if (ksp) {
for (i=0; i<nloc; i++) ksp[i] = tksp[i];
}
}
void PETSC_STDCALL taosetmonitor_(Tao *tao, void (PETSC_STDCALL *func)(Tao*,void*,PetscErrorCode*),void *ctx, void (PETSC_STDCALL *mondestroy)(void*,PetscErrorCode*),PetscErrorCode *ierr)
{
CHKFORTRANNULLOBJECT(ctx);
PetscObjectAllocateFortranPointers(*tao,NFUNCS);
if (func) {
((PetscObject)*tao)->fortran_func_pointers[MON] = (PetscVoidFunction)func;
if (FORTRANNULLFUNCTION(mondestroy)){
*ierr = TaoSetMonitor(*tao,ourtaomonitor,*tao,NULL);
} else {
*ierr = TaoSetMonitor(*tao,ourtaomonitor,*tao,ourtaomondestroy);
}
}
}
PETSC_EXTERN void PETSC_STDCALL pcfieldsplitgetsubksp_(PC *pc,PetscInt *n_local,KSP *ksp,PetscErrorCode *ierr)
{
KSP *tksp;
PetscInt i,nloc;
CHKFORTRANNULLINTEGER(n_local);
*ierr = PCFieldSplitGetSubKSP(*pc,&nloc,&tksp); if (*ierr) return;
if (n_local) *n_local = nloc;
CHKFORTRANNULLOBJECT(ksp);
if (ksp) {
for (i=0; i<nloc; i++) ksp[i] = tksp[i];
}
*ierr = PetscFree(tksp);
}
EXTERN_C_BEGIN
void PETSC_STDCALL taosetobjectiveroutine_(Tao *tao, void (PETSC_STDCALL *func)(Tao*, Vec *, PetscReal *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
{
CHKFORTRANNULLOBJECT(ctx);
PetscObjectAllocateFortranPointers(*tao,NFUNCS);
if (!func) {
*ierr = TaoSetObjectiveRoutine(*tao,0,ctx);
} else {
((PetscObject)*tao)->fortran_func_pointers[OBJ] = (PetscVoidFunction)func;
*ierr = TaoSetObjectiveRoutine(*tao, ourtaoobjectiveroutine,ctx);
}
}
EXTERN_C_BEGIN
/*
These are not usually called from Fortran but allow Fortran users
to transparently set these monitors from .F code
functions, hence no STDCALL
*/
void kspdefaultconverged_(KSP *ksp,PetscInt *n,PetscReal *rnorm,KSPConvergedReason *flag,void *dummy,PetscErrorCode *ierr)
{
CHKFORTRANNULLOBJECT(dummy);
*ierr = KSPDefaultConverged(*ksp,*n,*rnorm,flag,dummy);
}
PETSC_EXTERN void PETSC_STDCALL matcreatevecs_(Mat *mat,Vec *right,Vec *left, int *ierr)
{
CHKFORTRANNULLOBJECT(right);
CHKFORTRANNULLOBJECT(left);
*ierr = MatCreateVecs(*mat,right,left);
}
void kspskipconverged_(KSP *ksp,PetscInt *n,PetscReal *rnorm,KSPConvergedReason *flag,void *dummy,PetscErrorCode *ierr)
{
CHKFORTRANNULLOBJECT(dummy);
*ierr = KSPSkipConverged(*ksp,*n,*rnorm,flag,dummy);
}
void PETSC_STDCALL aocreatemappingis_(IS *isapp,IS *ispetsc,AO *aoout,PetscErrorCode *ierr)
{
CHKFORTRANNULLOBJECT(ispetsc);
*ierr = AOCreateMappingIS(*isapp,*ispetsc,aoout);
}
PETSC_EXTERN void PETSC_STDCALL matnestgetiss_(Mat *A,IS rows[],IS cols[], int *ierr )
{
CHKFORTRANNULLOBJECT(rows);
CHKFORTRANNULLOBJECT(cols);
*ierr = MatNestGetISs(*A,rows,cols);
}
PETSC_EXTERN void PETSC_STDCALL matcreatenest_(MPI_Fint *comm,PetscInt *nr,IS is_row[],PetscInt *nc,IS is_col[],Mat a[],Mat *B,int *ierr)
{
CHKFORTRANNULLOBJECT(is_row);
CHKFORTRANNULLOBJECT(is_col);
*ierr = MatCreateNest(MPI_Comm_f2c(*comm),*nr,is_row,*nc,is_col,a,B);
}
PETSC_EXTERN void kspconvergeddefault_(KSP *ksp,PetscInt *n,PetscReal *rnorm,KSPConvergedReason *flag,void *dummy,PetscErrorCode *ierr)
{
CHKFORTRANNULLOBJECT(dummy);
*ierr = KSPConvergedDefault(*ksp,*n,*rnorm,flag,dummy);
}
PETSC_EXTERN void PETSC_STDCALL vecscattercreatetozero_(Vec *vin,VecScatter *ctx,Vec *vout, int *ierr)
{
CHKFORTRANNULLOBJECT(vout);
*ierr = VecScatterCreateToZero(*vin,ctx,vout);
}
void PETSC_STDCALL pcasmsettotalsubdomains_(PC *pc,PetscInt *N,IS *is,IS *is_local, PetscErrorCode *ierr)
{
CHKFORTRANNULLOBJECT(is);
CHKFORTRANNULLOBJECT(is_local);
*ierr = PCASMSetTotalSubdomains(*pc,*N,is,is_local);
}
