Fix AMG cbind interface

testmergemaint
sfilippone 1 week ago
parent afac12f35b
commit a67d8a03ff

@ -37,7 +37,8 @@ extern "C" {
psb_i_t amg_c_dkrylov(const char *method, psb_c_dspmat *ah, amg_c_dprec *ph, psb_i_t amg_c_dkrylov(const char *method, psb_c_dspmat *ah, amg_c_dprec *ph,
psb_c_dvector *bh, psb_c_dvector *xh, psb_c_dvector *bh, psb_c_dvector *xh,
psb_c_descriptor *cdh, psb_c_SolverOptions *opt); psb_c_descriptor *cdh, psb_c_dvector *s1,
psb_c_dvector *s2, psb_c_SolverOptions *opt);
#ifdef __cplusplus #ifdef __cplusplus

@ -40,7 +40,8 @@ extern "C"
psb_i_t amg_c_zkrylov(const char *method, psb_c_zspmat *ah, amg_c_zprec *ph, psb_i_t amg_c_zkrylov(const char *method, psb_c_zspmat *ah, amg_c_zprec *ph,
psb_c_zvector *bh, psb_c_zvector *xh, psb_c_zvector *bh, psb_c_zvector *xh,
psb_c_descriptor *cdh, psb_c_SolverOptions *opt); psb_c_descriptor *cdh, , psb_c_zvector *s1,
psb_c_zvector *s2, psb_c_SolverOptions *opt);
#ifdef __cplusplus #ifdef __cplusplus
} }

@ -370,7 +370,7 @@ contains
end function amg_c_dsmoothers_build_opt end function amg_c_dsmoothers_build_opt
function amg_c_dkrylov(methd,& function amg_c_dkrylov(methd,&
& ah,ph,bh,xh,cdh,options) bind(c) result(res) & ah,ph,bh,xh,cdh,s1,s2,options) bind(c) result(res)
use psb_base_mod use psb_base_mod
use psb_prec_mod use psb_prec_mod
use psb_linsolve_mod use psb_linsolve_mod
@ -378,20 +378,21 @@ contains
use psb_dlinsolve_cbind_mod use psb_dlinsolve_cbind_mod
implicit none implicit none
integer(psb_c_ipk_) :: res integer(psb_c_ipk_) :: res
type(psb_c_object_type) :: ah,cdh,ph,bh,xh type(psb_c_object_type) :: ah,cdh,ph,bh,xh,s1,s2
character(c_char) :: methd(*) character(c_char) :: methd(*)
type(solveroptions) :: options type(solveroptions) :: options
res= amg_c_dkrylov_opt(methd, ah, ph, bh, xh, options%eps,cdh, & res= amg_c_dkrylov_opt(methd, ah, ph, bh, xh, options%eps,cdh, &
& itmax=options%itmax, iter=options%iter,& & itmax=options%itmax, iter=options%iter,&
& itrace=options%itrace, istop=options%istop,& & itrace=options%itrace, istop=options%istop,&
& irst=options%irst, err=options%err) & irst=options%irst, err=options%err, s1=s1,s2=s2)
end function amg_c_dkrylov end function amg_c_dkrylov
function amg_c_dkrylov_opt(methd,& function amg_c_dkrylov_opt(methd,&
& ah,ph,bh,xh,eps,cdh,itmax,iter,err,itrace,irst,istop) bind(c) result(res) & ah,ph,bh,xh,eps,cdh,itmax,iter,err,&
& itrace,irst,istop,s1,s2) bind(c) result(res)
use psb_base_mod use psb_base_mod
use psb_prec_mod use psb_prec_mod
use psb_linsolve_mod use psb_linsolve_mod
@ -399,16 +400,17 @@ contains
use psb_prec_cbind_mod use psb_prec_cbind_mod
implicit none implicit none
integer(psb_c_ipk_) :: res integer(psb_c_ipk_) :: res
type(psb_c_object_type) :: ah,cdh,ph,bh,xh type(psb_c_object_type) :: ah,cdh,ph,bh,xh,s1, s2
integer(psb_c_ipk_), value :: itmax,itrace,irst,istop integer(psb_c_ipk_), value :: itmax,itrace,irst,istop
real(c_double), value :: eps real(c_double), value :: eps
integer(psb_c_ipk_) :: iter integer(psb_c_ipk_) :: iter
real(c_double) :: err real(c_double) :: err
character(c_char) :: methd(*) character(c_char) :: methd(*)
type(psb_desc_type), pointer :: descp type(psb_desc_type), pointer :: descp
type(psb_dspmat_type), pointer :: ap type(psb_dspmat_type), pointer :: ap
type(amg_dprec_type), pointer :: precp type(amg_dprec_type), pointer :: precp
type(psb_d_vect_type), pointer :: xp, bp type(psb_d_vect_type), pointer :: xp, bp, s1p, s2p
integer(psb_ipk_) :: iret,fitmax,fitrace,first,fistop,fiter integer(psb_ipk_) :: iret,fitmax,fitrace,first,fistop,fiter
character(len=20) :: fmethd character(len=20) :: fmethd
@ -441,6 +443,16 @@ contains
return return
end if end if
if (c_associated(s1%item)) then
call c_f_pointer(s1%item,s1p)
else
nullify(s1p)
end if
if (c_associated(s2%item)) then
call c_f_pointer(s2%item,s2p)
else
nullify(s2p)
end if
call psb_stringc2f(methd,fmethd) call psb_stringc2f(methd,fmethd)
feps = eps feps = eps
@ -449,10 +461,28 @@ contains
first = irst first = irst
fistop = istop fistop = istop
if (associated(s1p).and.associated(s2p)) then
call psb_krylov(fmethd, ap, precp, bp, xp, feps, &
& descp, iret,&
& itmax=fitmax,iter=fiter,itrace=fitrace,istop=fistop,&
& irst=first, err=ferr,s1=s1p,s2=s2p)
else if (associated(s1p)) then
call psb_krylov(fmethd, ap, precp, bp, xp, feps, &
& descp, iret,&
& itmax=fitmax,iter=fiter,itrace=fitrace,istop=fistop,&
& irst=first, err=ferr,s1=s1p)
else if (associated(s2p)) then
call psb_krylov(fmethd, ap, precp, bp, xp, feps, &
& descp, iret,&
& itmax=fitmax,iter=fiter,itrace=fitrace,istop=fistop,&
& irst=first, err=ferr,s2=s2p)
else
call psb_krylov(fmethd, ap, precp, bp, xp, feps, & call psb_krylov(fmethd, ap, precp, bp, xp, feps, &
& descp, iret,& & descp, iret,&
& itmax=fitmax,iter=fiter,itrace=fitrace,istop=fistop,& & itmax=fitmax,iter=fiter,itrace=fitrace,istop=fistop,&
& irst=first, err=ferr) & irst=first, err=ferr)
end if
iter = fiter iter = fiter
err = ferr err = ferr
res = min(iret,0) res = min(iret,0)

@ -140,11 +140,11 @@ contains
integer(psb_c_ipk_) :: res integer(psb_c_ipk_) :: res
type(psb_c_object_type) :: ph,ah,cdh type(psb_c_object_type) :: ph,ah,cdh
integer(psb_ipk_) :: iret
type(amg_zprec_type), pointer :: precp type(amg_zprec_type), pointer :: precp
type(psb_zspmat_type), pointer :: ap type(psb_zspmat_type), pointer :: ap
type(psb_desc_type), pointer :: descp type(psb_desc_type), pointer :: descp
character(len=80) :: fptype character(len=80) :: fptype
integer(psb_ipk_) :: iret
res = -1 res = -1

Loading…
Cancel
Save