fdurastante/psblas3
1
0
Fork 0
mirror of https://github.com/sfilippone/psblas3.git synced 2026-10-18 11:52:11 +00:00
Code Issues Packages Projects Releases Wiki Activity

CBIND linsolve fixes

Browse Source
This commit is contained in:
sfilippone
2026-06-16 16:42:07 +02:00
parent 8a57d90d06
commit 64bee3fb7d
6 changed files with 178 additions and 40 deletions
Download Patch File Download Diff File Expand all files Collapse all files
cbind/linsolve/psb_base_linsolve_cbind_mod.f90
+6 -2
View File
@@ -6,6 +6,7 @@ module psb_base_linsolve_cbind_mod
type, bind(c) :: solveroptions
integer(psb_c_ipk_) :: iter, itmax, itrace, irst, istop
real(c_double) :: eps, err
type(psb_c_object_type) :: s1, s2
end type solveroptions
contains
@@ -20,14 +21,15 @@ contains
options%istop = 2
options%irst = 10
options%eps = 1.d-6
options%s1 = psb_c_get_new_object()
options%s2 = psb_c_get_new_object()
res = 0
end function psb_c_DefaultSolverOptions
function psb_c_PrintSolverOptions(options)&
& bind(c,name='psb_c_PrintSolverOptions') result(res)
implicit none
type(solveroptions) :: options
type(solveroptions), value :: options
integer(psb_c_ipk_) :: res
write(*,*) 'PSBLAS C Interface Solver Options '
@@ -36,6 +38,8 @@ contains
write(*,*) ' Stopping Criterion :', options%istop
write(*,*) ' Restart :', options%irst
write(*,*) ' EPS (tolerance) :', options%eps
write(*,*) ' S1 scaling :', c_associated(options%s1%item)
write(*,*) ' S2 scaling :', c_associated(options%s2%item)
res = 0
end function psb_c_PrintSolverOptions
cbind/linsolve/psb_clinsolve_cbind_mod.f90
+42 -9
View File
@@ -23,14 +23,16 @@ contains
res= psb_c_ckrylov_opt(methd, ah, ph, bh, xh, options%eps,cdh, &
& itmax=options%itmax, iter=options%iter,&
& 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
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_error_mod
use psb_prec_mod
use psb_linsolve_mod
use psb_objhandle_mod
@@ -46,12 +48,14 @@ contains
integer(psb_c_ipk_) :: iter
real(c_double) :: err
character(c_char) :: methd(*)
type(psb_c_object_type) :: s1,s2
type(psb_desc_type), pointer :: descp
type(psb_cspmat_type), pointer :: ap
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
real(psb_spk_) :: feps,ferr
@@ -81,6 +85,16 @@ contains
else
return
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)
@@ -89,14 +103,33 @@ contains
fitrace = itrace
first = irst
fistop = istop
call psb_krylov(fmethd, ap, precp, bp, xp, feps, &
& descp, info,&
& itmax=fitmax,iter=fiter,itrace=fitrace,istop=fistop,&
& irst=first, err=ferr)
err_act = psb_act_abort_
if (psb_errstatus_fatal()) call psb_error_handler(err_act)
if (associated(s1p).and.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,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
err = ferr
res = info
if (psb_errstatus_fatal()) call psb_error_handler(err_act)
end function psb_c_ckrylov_opt
cbind/linsolve/psb_dlinsolve_cbind_mod.f90
+42 -9
View File
@@ -23,14 +23,16 @@ contains
res= psb_c_dkrylov_opt(methd, ah, ph, bh, xh, options%eps,cdh, &
& itmax=options%itmax, iter=options%iter,&
& 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
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_error_mod
use psb_prec_mod
use psb_linsolve_mod
use psb_objhandle_mod
@@ -46,12 +48,14 @@ contains
integer(psb_c_ipk_) :: iter
real(c_double) :: err
character(c_char) :: methd(*)
type(psb_c_object_type) :: s1,s2
type(psb_desc_type), pointer :: descp
type(psb_dspmat_type), pointer :: ap
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
real(psb_dpk_) :: feps,ferr
@@ -81,6 +85,16 @@ contains
else
return
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)
@@ -89,14 +103,33 @@ contains
fitrace = itrace
first = irst
fistop = istop
call psb_krylov(fmethd, ap, precp, bp, xp, feps, &
& descp, info,&
& itmax=fitmax,iter=fiter,itrace=fitrace,istop=fistop,&
& irst=first, err=ferr)
err_act = psb_act_abort_
if (psb_errstatus_fatal()) call psb_error_handler(err_act)
if (associated(s1p).and.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,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
err = ferr
res = info
if (psb_errstatus_fatal()) call psb_error_handler(err_act)
end function psb_c_dkrylov_opt
cbind/linsolve/psb_linsolve_cbind.h
+4 -2
View File
@@ -22,11 +22,13 @@ typedef struct psb_c_solveroptions {
int istop; /* Stopping criterion: 1:backward error 2: ||r||_2/||b||_2 */
double eps; /* Stopping tolerance */
double err; /* Convergence indicator on exit */
void *s1;
void *s2;
} psb_c_SolverOptions;
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,
psb_c_svector *bh, psb_c_svector *xh,
psb_c_descriptor *cdh, psb_c_SolverOptions *opt);
cbind/linsolve/psb_slinsolve_cbind_mod.f90
+42 -9
View File
@@ -23,14 +23,16 @@ contains
res= psb_c_skrylov_opt(methd, ah, ph, bh, xh, options%eps,cdh, &
& itmax=options%itmax, iter=options%iter,&
& 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
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_error_mod
use psb_prec_mod
use psb_linsolve_mod
use psb_objhandle_mod
@@ -46,12 +48,14 @@ contains
integer(psb_c_ipk_) :: iter
real(c_double) :: err
character(c_char) :: methd(*)
type(psb_c_object_type) :: s1,s2
type(psb_desc_type), pointer :: descp
type(psb_sspmat_type), pointer :: ap
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
real(psb_spk_) :: feps,ferr
@@ -81,6 +85,16 @@ contains
else
return
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)
@@ -89,14 +103,33 @@ contains
fitrace = itrace
first = irst
fistop = istop
call psb_krylov(fmethd, ap, precp, bp, xp, feps, &
& descp, info,&
& itmax=fitmax,iter=fiter,itrace=fitrace,istop=fistop,&
& irst=first, err=ferr)
err_act = psb_act_abort_
if (psb_errstatus_fatal()) call psb_error_handler(err_act)
if (associated(s1p).and.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,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
err = ferr
res = info
if (psb_errstatus_fatal()) call psb_error_handler(err_act)
end function psb_c_skrylov_opt
cbind/linsolve/psb_zlinsolve_cbind_mod.f90
+42 -9
View File
@@ -23,14 +23,16 @@ contains
res= psb_c_zkrylov_opt(methd, ah, ph, bh, xh, options%eps,cdh, &
& itmax=options%itmax, iter=options%iter,&
& 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
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_error_mod
use psb_prec_mod
use psb_linsolve_mod
use psb_objhandle_mod
@@ -46,12 +48,14 @@ contains
integer(psb_c_ipk_) :: iter
real(c_double) :: err
character(c_char) :: methd(*)
type(psb_c_object_type) :: s1,s2
type(psb_desc_type), pointer :: descp
type(psb_zspmat_type), pointer :: ap
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
real(psb_dpk_) :: feps,ferr
@@ -81,6 +85,16 @@ contains
else
return
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)
@@ -89,14 +103,33 @@ contains
fitrace = itrace
first = irst
fistop = istop
call psb_krylov(fmethd, ap, precp, bp, xp, feps, &
& descp, info,&
& itmax=fitmax,iter=fiter,itrace=fitrace,istop=fistop,&
& irst=first, err=ferr)
err_act = psb_act_abort_
if (psb_errstatus_fatal()) call psb_error_handler(err_act)
if (associated(s1p).and.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,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
err = ferr
res = info
if (psb_errstatus_fatal()) call psb_error_handler(err_act)
end function psb_c_zkrylov_opt