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

CBIND linsolve fixes

Browse Source
merge-kinsol-maint
sfilippone 1 week ago
parent 8a57d90d06
commit 64bee3fb7d
6 changed files with 178 additions and 40 deletions
Show Stats Download Patch File Download Diff File

8
cbind/linsolve/psb_base_linsolve_cbind_mod.f90
Unescape Escape View File

@ -6,6 +6,7 @@ module psb_base_linsolve_cbind_mod
type, bind(c) :: solveroptions type, bind(c) :: solveroptions
integer(psb_c_ipk_) :: iter, itmax, itrace, irst, istop integer(psb_c_ipk_) :: iter, itmax, itrace, irst, istop
real(c_double) :: eps, err real(c_double) :: eps, err
type(psb_c_object_type) :: s1, s2
end type solveroptions end type solveroptions
contains contains
@ -20,14 +21,15 @@ contains
options%istop = 2 options%istop = 2
options%irst = 10 options%irst = 10
options%eps = 1.d-6 options%eps = 1.d-6
options%s1 = psb_c_get_new_object()
options%s2 = psb_c_get_new_object()
res = 0 res = 0
end function psb_c_DefaultSolverOptions end function psb_c_DefaultSolverOptions
function psb_c_PrintSolverOptions(options)& function psb_c_PrintSolverOptions(options)&
& bind(c,name='psb_c_PrintSolverOptions') result(res) & bind(c,name='psb_c_PrintSolverOptions') result(res)
implicit none implicit none
type(solveroptions) :: options type(solveroptions), value :: options
integer(psb_c_ipk_) :: res integer(psb_c_ipk_) :: res
write(*,*) 'PSBLAS C Interface Solver Options ' write(*,*) 'PSBLAS C Interface Solver Options '
@ -36,6 +38,8 @@ contains
write(*,*) ' Stopping Criterion :', options%istop write(*,*) ' Stopping Criterion :', options%istop
write(*,*) ' Restart :', options%irst write(*,*) ' Restart :', options%irst
write(*,*) ' EPS (tolerance) :', options%eps write(*,*) ' EPS (tolerance) :', options%eps
write(*,*) ' S1 scaling :', c_associated(options%s1%item)
write(*,*) ' S2 scaling :', c_associated(options%s2%item)
res = 0 res = 0
end function psb_c_PrintSolverOptions end function psb_c_PrintSolverOptions

51
cbind/linsolve/psb_clinsolve_cbind_mod.f90
Unescape Escape View File

@ -23,14 +23,16 @@ contains
res= psb_c_ckrylov_opt(methd, ah, ph, bh, xh, options%eps,cdh, & res= psb_c_ckrylov_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=options%s1,s2=options%s2)
end function psb_c_ckrylov end function psb_c_ckrylov
function psb_c_ckrylov_opt(methd,& function psb_c_ckrylov_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_error_mod
use psb_prec_mod use psb_prec_mod
use psb_linsolve_mod use psb_linsolve_mod
use psb_objhandle_mod use psb_objhandle_mod
@ -46,12 +48,14 @@ contains
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_c_object_type) :: s1,s2
type(psb_desc_type), pointer :: descp type(psb_desc_type), pointer :: descp
type(psb_cspmat_type), pointer :: ap type(psb_cspmat_type), pointer :: ap
type(psb_cprec_type), pointer :: precp type(psb_cprec_type), pointer :: precp
type(psb_c_vect_type), pointer :: xp, bp type(psb_c_vect_type), pointer :: xp, bp, s1p, s2p
integer(psb_c_ipk_) :: info,fitmax,fitrace,first,fistop,fiter integer(psb_c_ipk_) :: info,fitmax,fitrace,first,fistop,fiter,err_act
character(len=20) :: fmethd character(len=20) :: fmethd
real(psb_spk_) :: feps,ferr real(psb_spk_) :: feps,ferr
@ -81,6 +85,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)
@ -89,14 +103,33 @@ contains
fitrace = itrace fitrace = itrace
first = irst first = irst
fistop = istop fistop = istop
err_act = psb_act_abort_
call psb_krylov(fmethd, ap, precp, bp, xp, feps, & if (psb_errstatus_fatal()) call psb_error_handler(err_act)
& descp, info,& if (associated(s1p).and.associated(s2p)) then
& itmax=fitmax,iter=fiter,itrace=fitrace,istop=fistop,& call psb_krylov(fmethd, ap, precp, bp, xp, feps, &
& irst=first, err=ferr) & descp, info,&
& 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, info,&
& 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, info,&
& 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, info,&
& itmax=fitmax,iter=fiter,itrace=fitrace,istop=fistop,&
& irst=first, err=ferr)
end if
iter = fiter iter = fiter
err = ferr err = ferr
res = info res = info
if (psb_errstatus_fatal()) call psb_error_handler(err_act)
end function psb_c_ckrylov_opt end function psb_c_ckrylov_opt

51
cbind/linsolve/psb_dlinsolve_cbind_mod.f90
Unescape Escape View File

@ -23,14 +23,16 @@ contains
res= psb_c_dkrylov_opt(methd, ah, ph, bh, xh, options%eps,cdh, & res= psb_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=options%s1,s2=options%s2)
end function psb_c_dkrylov end function psb_c_dkrylov
function psb_c_dkrylov_opt(methd,& function psb_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_error_mod
use psb_prec_mod use psb_prec_mod
use psb_linsolve_mod use psb_linsolve_mod
use psb_objhandle_mod use psb_objhandle_mod
@ -46,12 +48,14 @@ contains
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_c_object_type) :: s1,s2
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(psb_dprec_type), pointer :: precp type(psb_dprec_type), pointer :: precp
type(psb_d_vect_type), pointer :: xp, bp type(psb_d_vect_type), pointer :: xp, bp, s1p, s2p
integer(psb_c_ipk_) :: info,fitmax,fitrace,first,fistop,fiter integer(psb_c_ipk_) :: info,fitmax,fitrace,first,fistop,fiter,err_act
character(len=20) :: fmethd character(len=20) :: fmethd
real(psb_dpk_) :: feps,ferr real(psb_dpk_) :: feps,ferr
@ -81,6 +85,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)
@ -89,14 +103,33 @@ contains
fitrace = itrace fitrace = itrace
first = irst first = irst
fistop = istop fistop = istop
err_act = psb_act_abort_
call psb_krylov(fmethd, ap, precp, bp, xp, feps, & if (psb_errstatus_fatal()) call psb_error_handler(err_act)
& descp, info,& if (associated(s1p).and.associated(s2p)) then
& itmax=fitmax,iter=fiter,itrace=fitrace,istop=fistop,& call psb_krylov(fmethd, ap, precp, bp, xp, feps, &
& irst=first, err=ferr) & descp, info,&
& 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, info,&
& 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, info,&
& 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, info,&
& itmax=fitmax,iter=fiter,itrace=fitrace,istop=fistop,&
& irst=first, err=ferr)
end if
iter = fiter iter = fiter
err = ferr err = ferr
res = info res = info
if (psb_errstatus_fatal()) call psb_error_handler(err_act)
end function psb_c_dkrylov_opt end function psb_c_dkrylov_opt

4
cbind/linsolve/psb_linsolve_cbind.h
Unescape Escape View File

@ -22,10 +22,12 @@ typedef struct psb_c_solveroptions {
int istop; /* Stopping criterion: 1:backward error 2: ||r||_2/||b||_2 */ int istop; /* Stopping criterion: 1:backward error 2: ||r||_2/||b||_2 */
double eps; /* Stopping tolerance */ double eps; /* Stopping tolerance */
double err; /* Convergence indicator on exit */ double err; /* Convergence indicator on exit */
void *s1;
void *s2;
} psb_c_SolverOptions; } psb_c_SolverOptions;
int psb_c_DefaultSolverOptions(psb_c_SolverOptions *opt); int psb_c_DefaultSolverOptions(psb_c_SolverOptions *opt);
int psb_c_PrintSolverOptions(psb_c_SolverOptions *opt); int psb_c_PrintSolverOptions(psb_c_SolverOptions opt);
int psb_c_skrylov(const char *method, psb_c_sspmat *ah, psb_c_sprec *ph, int psb_c_skrylov(const char *method, psb_c_sspmat *ah, psb_c_sprec *ph,
psb_c_svector *bh, psb_c_svector *xh, psb_c_svector *bh, psb_c_svector *xh,

51
cbind/linsolve/psb_slinsolve_cbind_mod.f90
Unescape Escape View File

@ -23,14 +23,16 @@ contains
res= psb_c_skrylov_opt(methd, ah, ph, bh, xh, options%eps,cdh, & res= psb_c_skrylov_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=options%s1,s2=options%s2)
end function psb_c_skrylov end function psb_c_skrylov
function psb_c_skrylov_opt(methd,& function psb_c_skrylov_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_error_mod
use psb_prec_mod use psb_prec_mod
use psb_linsolve_mod use psb_linsolve_mod
use psb_objhandle_mod use psb_objhandle_mod
@ -46,12 +48,14 @@ contains
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_c_object_type) :: s1,s2
type(psb_desc_type), pointer :: descp type(psb_desc_type), pointer :: descp
type(psb_sspmat_type), pointer :: ap type(psb_sspmat_type), pointer :: ap
type(psb_sprec_type), pointer :: precp type(psb_sprec_type), pointer :: precp
type(psb_s_vect_type), pointer :: xp, bp type(psb_s_vect_type), pointer :: xp, bp, s1p, s2p
integer(psb_c_ipk_) :: info,fitmax,fitrace,first,fistop,fiter integer(psb_c_ipk_) :: info,fitmax,fitrace,first,fistop,fiter,err_act
character(len=20) :: fmethd character(len=20) :: fmethd
real(psb_spk_) :: feps,ferr real(psb_spk_) :: feps,ferr
@ -81,6 +85,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)
@ -89,14 +103,33 @@ contains
fitrace = itrace fitrace = itrace
first = irst first = irst
fistop = istop fistop = istop
err_act = psb_act_abort_
call psb_krylov(fmethd, ap, precp, bp, xp, feps, & if (psb_errstatus_fatal()) call psb_error_handler(err_act)
& descp, info,& if (associated(s1p).and.associated(s2p)) then
& itmax=fitmax,iter=fiter,itrace=fitrace,istop=fistop,& call psb_krylov(fmethd, ap, precp, bp, xp, feps, &
& irst=first, err=ferr) & descp, info,&
& 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, info,&
& 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, info,&
& 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, info,&
& itmax=fitmax,iter=fiter,itrace=fitrace,istop=fistop,&
& irst=first, err=ferr)
end if
iter = fiter iter = fiter
err = ferr err = ferr
res = info res = info
if (psb_errstatus_fatal()) call psb_error_handler(err_act)
end function psb_c_skrylov_opt end function psb_c_skrylov_opt

51
cbind/linsolve/psb_zlinsolve_cbind_mod.f90
Unescape Escape View File

@ -23,14 +23,16 @@ contains
res= psb_c_zkrylov_opt(methd, ah, ph, bh, xh, options%eps,cdh, & res= psb_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=options%s1,s2=options%s2)
end function psb_c_zkrylov end function psb_c_zkrylov
function psb_c_zkrylov_opt(methd,& function psb_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_base_mod
use psb_error_mod
use psb_prec_mod use psb_prec_mod
use psb_linsolve_mod use psb_linsolve_mod
use psb_objhandle_mod use psb_objhandle_mod
@ -46,12 +48,14 @@ contains
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_c_object_type) :: s1,s2
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(psb_zprec_type), pointer :: precp type(psb_zprec_type), pointer :: precp
type(psb_z_vect_type), pointer :: xp, bp type(psb_z_vect_type), pointer :: xp, bp, s1p, s2p
integer(psb_c_ipk_) :: info,fitmax,fitrace,first,fistop,fiter integer(psb_c_ipk_) :: info,fitmax,fitrace,first,fistop,fiter,err_act
character(len=20) :: fmethd character(len=20) :: fmethd
real(psb_dpk_) :: feps,ferr real(psb_dpk_) :: feps,ferr
@ -81,6 +85,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)
@ -89,14 +103,33 @@ contains
fitrace = itrace fitrace = itrace
first = irst first = irst
fistop = istop fistop = istop
err_act = psb_act_abort_
call psb_krylov(fmethd, ap, precp, bp, xp, feps, & if (psb_errstatus_fatal()) call psb_error_handler(err_act)
& descp, info,& if (associated(s1p).and.associated(s2p)) then
& itmax=fitmax,iter=fiter,itrace=fitrace,istop=fistop,& call psb_krylov(fmethd, ap, precp, bp, xp, feps, &
& irst=first, err=ferr) & descp, info,&
& 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, info,&
& 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, info,&
& 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, info,&
& itmax=fitmax,iter=fiter,itrace=fitrace,istop=fistop,&
& irst=first, err=ferr)
end if
iter = fiter iter = fiter
err = ferr err = ferr
res = info res = info
if (psb_errstatus_fatal()) call psb_error_handler(err_act)
end function psb_c_zkrylov_opt end function psb_c_zkrylov_opt

Write Preview
Loading…
Cancel
Save