fdurastante
/
amg4psblas
mirror of https://github.com/sfilippone/amg4psblas.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Fix CBIND interface

Browse Source
merge-kinsol-maint
sfilippone 1 week ago
parent a3e1be46ee
commit a27932fe94
4 changed files with 164 additions and 76 deletions
Show Stats Download Patch File Download Diff File

5
cbind/amgprec/amg_c_dprec.h
Unescape Escape View File

@ -36,8 +36,9 @@ extern "C" {
psb_i_t amg_c_dallocate_wrk(amg_c_dprec *ph, const char *chfmt); psb_i_t amg_c_dallocate_wrk(amg_c_dprec *ph, const char *chfmt);
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

6
cbind/amgprec/amg_c_zprec.h
Unescape Escape View File

@ -39,8 +39,10 @@ extern "C"
psb_i_t amg_c_zallocate_wrk(amg_c_zprec *ph, const char *chfmt); psb_i_t amg_c_zallocate_wrk(amg_c_zprec *ph, const char *chfmt);
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
} }

79
cbind/amgprec/amg_dprec_cbind_mod.F90
Unescape Escape View File

@ -3,6 +3,7 @@ module amg_dprec_cbind_mod
use iso_c_binding use iso_c_binding
use amg_prec_mod use amg_prec_mod
use psb_base_cbind_mod use psb_base_cbind_mod
use psb_dlinsolve_cbind_mod
type, bind(c) :: amg_c_dprec type, bind(c) :: amg_c_dprec
type(c_ptr) :: item = c_null_ptr type(c_ptr) :: item = c_null_ptr
@ -172,15 +173,17 @@ contains
end function amg_c_dprecbld end function amg_c_dprecbld
function amg_c_dhierarchy_build(ah,cdh,ph) bind(c) result(res) function amg_c_dhierarchy_build(ah,cdh,ph) bind(c) result(res)
use psb_base_mod
implicit none implicit none
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_dprec_type), pointer :: precp type(amg_dprec_type), pointer :: precp
type(psb_dspmat_type), pointer :: ap type(psb_dspmat_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, act
res = -1 res = -1
@ -204,11 +207,15 @@ contains
res = AMGC_ERR_FILTER(iret) res = AMGC_ERR_FILTER(iret)
AMGC_ERR_HANDLE(res) AMGC_ERR_HANDLE(res)
if (res /=0) then
act = psb_act_abort_
call psb_error_handler(act)
end if
return return
end function amg_c_dhierarchy_build end function amg_c_dhierarchy_build
function amg_c_dsmoothers_build(ah,cdh,ph) bind(c) result(res) function amg_c_dsmoothers_build(ah,cdh,ph) bind(c) result(res)
use psb_base_mod
implicit none implicit none
integer(psb_c_ipk_) :: res integer(psb_c_ipk_) :: res
@ -217,7 +224,7 @@ contains
type(psb_dspmat_type), pointer :: ap type(psb_dspmat_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 integer(psb_ipk_) :: iret, act
res = -1 res = -1
@ -241,6 +248,10 @@ contains
res = AMGC_ERR_FILTER(iret) res = AMGC_ERR_FILTER(iret)
AMGC_ERR_HANDLE(res) AMGC_ERR_HANDLE(res)
if (res /=0) then
act = psb_act_abort_
call psb_error_handler(act)
end if
return return
end function amg_c_dsmoothers_build end function amg_c_dsmoothers_build
@ -360,7 +371,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
@ -368,20 +379,20 @@ 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
@ -389,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
@ -430,8 +442,17 @@ contains
else else
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
!write(0,*) 'krylov: s1 s2 ',associated(s1p),associated(s2p)
call psb_stringc2f(methd,fmethd) call psb_stringc2f(methd,fmethd)
feps = eps feps = eps
fitmax = itmax fitmax = itmax
@ -439,10 +460,28 @@ contains
first = irst first = irst
fistop = istop fistop = istop
call psb_krylov(fmethd, ap, precp, bp, xp, feps, & if (associated(s1p).and.associated(s2p)) then
& descp, iret,& call psb_krylov(fmethd, ap, precp, bp, xp, feps, &
& itmax=fitmax,iter=fiter,itrace=fitrace,istop=fistop,& & descp, iret,&
& irst=first, err=ferr) & 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, &
& descp, iret,&
& itmax=fitmax,iter=fiter,itrace=fitrace,istop=fistop,&
& irst=first, err=ferr)
end if
iter = fiter iter = fiter
err = ferr err = ferr
res = min(iret,0) res = min(iret,0)
@ -497,7 +536,7 @@ contains
res = AMGC_ERR_FILTER(info) res = AMGC_ERR_FILTER(info)
AMGC_ERR_HANDLE(res) AMGC_ERR_HANDLE(res)
return return
end function amg_c_dprecapply end function amg_c_dprecapply
function amg_c_dprecapply_opt(ph,bc,xc,cdh,ctrans) bind(c,name="amg_c_dprecapply_opt") result(res) function amg_c_dprecapply_opt(ph,bc,xc,cdh,ctrans) bind(c,name="amg_c_dprecapply_opt") result(res)
use psb_base_mod use psb_base_mod
@ -553,7 +592,7 @@ end function amg_c_dprecapply
res = AMGC_ERR_FILTER(info) res = AMGC_ERR_FILTER(info)
AMGC_ERR_HANDLE(res) AMGC_ERR_HANDLE(res)
return return
end function amg_c_dprecapply_opt end function amg_c_dprecapply_opt
function amg_c_dprecfree(ph) bind(c) result(res) function amg_c_dprecfree(ph) bind(c) result(res)
implicit none implicit none
@ -617,9 +656,9 @@ end function amg_c_dprecapply_opt
integer(psb_ipk_) :: iret integer(psb_ipk_) :: iret
type(amg_dprec_type), pointer :: precp type(amg_dprec_type), pointer :: precp
character(len=6) :: fchfmt character(len=6) :: fchfmt
! Local variable ! Local variable
integer(psb_ipk_) :: info integer(psb_ipk_) :: info
! Local mold variables ! Local mold variables
#if defined (PSB_HAVE_CUDA) #if defined (PSB_HAVE_CUDA)
type(psb_d_vect_cuda), target :: dvgpu type(psb_d_vect_cuda), target :: dvgpu
#endif #endif

146
cbind/amgprec/amg_zprec_cbind_mod.F90
Unescape Escape View File

@ -3,6 +3,7 @@ module amg_zprec_cbind_mod
use iso_c_binding use iso_c_binding
use amg_prec_mod use amg_prec_mod
use psb_base_cbind_mod use psb_base_cbind_mod
use psb_zlinsolve_cbind_mod
type, bind(c) :: amg_c_zprec type, bind(c) :: amg_c_zprec
type(c_ptr) :: item = c_null_ptr type(c_ptr) :: item = c_null_ptr
@ -140,11 +141,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
@ -173,15 +174,17 @@ contains
end function amg_c_zprecbld end function amg_c_zprecbld
function amg_c_zhierarchy_build(ah,cdh,ph) bind(c) result(res) function amg_c_zhierarchy_build(ah,cdh,ph) bind(c) result(res)
use psb_base_mod
implicit none implicit none
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, act
res = -1 res = -1
@ -205,20 +208,25 @@ contains
res = AMGC_ERR_FILTER(iret) res = AMGC_ERR_FILTER(iret)
AMGC_ERR_HANDLE(res) AMGC_ERR_HANDLE(res)
if (res /=0) then
act = psb_act_abort_
call psb_error_handler(act)
end if
return return
end function amg_c_zhierarchy_build end function amg_c_zhierarchy_build
function amg_c_zsmoothers_build(ah,cdh,ph) bind(c) result(res) function amg_c_zsmoothers_build(ah,cdh,ph) bind(c) result(res)
use psb_base_mod
implicit none implicit none
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, act
res = -1 res = -1
@ -242,6 +250,10 @@ contains
res = AMGC_ERR_FILTER(iret) res = AMGC_ERR_FILTER(iret)
AMGC_ERR_HANDLE(res) AMGC_ERR_HANDLE(res)
if (res /=0) then
act = psb_act_abort_
call psb_error_handler(act)
end if
return return
end function amg_c_zsmoothers_build end function amg_c_zsmoothers_build
@ -355,31 +367,37 @@ contains
end function amg_c_zsmoothers_build_format end function amg_c_zsmoothers_build_format
function amg_c_zkrylov(methd,& function amg_c_zkrylov(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_prec_mod
use psb_linsolve_mod use psb_linsolve_mod
use psb_prec_cbind_mod use psb_prec_cbind_mod
use psb_zlinsolve_cbind_mod use psb_zlinsolve_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_zkrylov_opt(methd, ah, ph, bh, xh, options%eps,cdh, & res= amg_c_zkrylov_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_zkrylov end function amg_c_zkrylov
function amg_c_zkrylov_opt(methd,& function amg_c_zkrylov_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_prec_mod
use psb_linsolve_mod use psb_linsolve_mod
use psb_objhandle_mod use psb_objhandle_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
@ -388,7 +406,7 @@ contains
type(psb_desc_type), pointer :: descp type(psb_desc_type), pointer :: descp
type(psb_zspmat_type), pointer :: ap type(psb_zspmat_type), pointer :: ap
type(amg_zprec_type), pointer :: precp type(amg_zprec_type), pointer :: precp
type(psb_z_vect_type), pointer :: xp, bp type(psb_z_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
@ -420,6 +438,16 @@ contains
else else
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)
@ -429,10 +457,28 @@ contains
first = irst first = irst
fistop = istop fistop = istop
call psb_krylov(fmethd, ap, precp, bp, xp, feps, & if (associated(s1p).and.associated(s2p)) then
& descp, iret,& call psb_krylov(fmethd, ap, precp, bp, xp, feps, &
& itmax=fitmax,iter=fiter,itrace=fitrace,istop=fistop,& & descp, iret,&
& irst=first, err=ferr) & 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, &
& descp, iret,&
& itmax=fitmax,iter=fiter,itrace=fitrace,istop=fistop,&
& irst=first, err=ferr)
end if
iter = fiter iter = fiter
err = ferr err = ferr
res = min(iret,0) res = min(iret,0)
@ -595,55 +641,55 @@ contains
return return
end function amg_c_zdescr end function amg_c_zdescr
function amg_c_zallocate_wrk(ph,chfmt) bind(c, name="amg_c_zallocate_wrk") result(res) function amg_c_zallocate_wrk(ph,chfmt) bind(c, name="amg_c_zallocate_wrk") result(res)
#if defined (PSB_HAVE_CUDA) #if defined (PSB_HAVE_CUDA)
use psb_cuda_mod use psb_cuda_mod
#endif #endif
implicit none implicit none
integer(psb_c_ipk_) :: res integer(psb_c_ipk_) :: res
type(psb_c_object_type) :: ph type(psb_c_object_type) :: ph
character(c_char) :: chfmt(*) character(c_char) :: chfmt(*)
integer(psb_ipk_) :: iret integer(psb_ipk_) :: iret
type(amg_zprec_type), pointer :: precp type(amg_zprec_type), pointer :: precp
character(len=6) :: fchfmt character(len=6) :: fchfmt
! Local variable ! Local variable
integer(psb_ipk_) :: info integer(psb_ipk_) :: info
! Local mold variables ! Local mold variables
#if defined (PSB_HAVE_CUDA) #if defined (PSB_HAVE_CUDA)
type(psb_z_vect_cuda), target :: zvgpu type(psb_z_vect_cuda), target :: zvgpu
#endif #endif
type(psb_z_base_vect_type), target :: zvhost type(psb_z_base_vect_type), target :: zvhost
class(psb_z_base_vect_type), pointer :: vmold class(psb_z_base_vect_type), pointer :: vmold
res = -1 res = -1
if (c_associated(ph%item)) then if (c_associated(ph%item)) then
call c_f_pointer(ph%item,precp) call c_f_pointer(ph%item,precp)
else else
return return
end if end if
call psb_stringc2f(chfmt,fchfmt) call psb_stringc2f(chfmt,fchfmt)
select case (psb_toupper(fchfmt)) select case (psb_toupper(fchfmt))
case('HOST','CPU') case('HOST','CPU')
vmold => zvhost vmold => zvhost
#if defined (PSB_HAVE_CUDA) #if defined (PSB_HAVE_CUDA)
case('GPU','DEVICE') case('GPU','DEVICE')
vmold => zvgpu vmold => zvgpu
#endif #endif
case default case default
write(psb_err_unit,'(A)') 'amg_c_zallocate_wrk: Unknown format ', fchfmt, ' defaulting to HOST/CPU' write(psb_err_unit,'(A)') 'amg_c_zallocate_wrk: Unknown format ', fchfmt, ' defaulting to HOST/CPU'
vmold => zvhost vmold => zvhost
end select end select
call precp%allocate_wrk(info,vmold=vmold) call precp%allocate_wrk(info,vmold=vmold)
iret = info iret = info
res = AMGC_ERR_FILTER(iret) res = AMGC_ERR_FILTER(iret)
AMGC_ERR_HANDLE(res) AMGC_ERR_HANDLE(res)
return return
end function amg_c_zallocate_wrk end function amg_c_zallocate_wrk
end module amg_zprec_cbind_mod end module amg_zprec_cbind_mod

Write Preview
Loading…
Cancel
Save