diff --git a/cbind/linsolve/psb_base_linsolve_cbind_mod.f90 b/cbind/linsolve/psb_base_linsolve_cbind_mod.f90 index db9f9d358..f9d943681 100644 --- a/cbind/linsolve/psb_base_linsolve_cbind_mod.f90 +++ b/cbind/linsolve/psb_base_linsolve_cbind_mod.f90 @@ -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 diff --git a/cbind/linsolve/psb_clinsolve_cbind_mod.f90 b/cbind/linsolve/psb_clinsolve_cbind_mod.f90 index 1480f0234..f076254c1 100644 --- a/cbind/linsolve/psb_clinsolve_cbind_mod.f90 +++ b/cbind/linsolve/psb_clinsolve_cbind_mod.f90 @@ -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 diff --git a/cbind/linsolve/psb_dlinsolve_cbind_mod.f90 b/cbind/linsolve/psb_dlinsolve_cbind_mod.f90 index 92cb02fa9..1feb7d0df 100644 --- a/cbind/linsolve/psb_dlinsolve_cbind_mod.f90 +++ b/cbind/linsolve/psb_dlinsolve_cbind_mod.f90 @@ -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 diff --git a/cbind/linsolve/psb_linsolve_cbind.h b/cbind/linsolve/psb_linsolve_cbind.h index d1ed4a92b..48e1f3f36 100644 --- a/cbind/linsolve/psb_linsolve_cbind.h +++ b/cbind/linsolve/psb_linsolve_cbind.h @@ -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); diff --git a/cbind/linsolve/psb_slinsolve_cbind_mod.f90 b/cbind/linsolve/psb_slinsolve_cbind_mod.f90 index ed7c13e52..dd86bc7cd 100644 --- a/cbind/linsolve/psb_slinsolve_cbind_mod.f90 +++ b/cbind/linsolve/psb_slinsolve_cbind_mod.f90 @@ -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 diff --git a/cbind/linsolve/psb_zlinsolve_cbind_mod.f90 b/cbind/linsolve/psb_zlinsolve_cbind_mod.f90 index 8a3312c18..82b151c48 100644 --- a/cbind/linsolve/psb_zlinsolve_cbind_mod.f90 +++ b/cbind/linsolve/psb_zlinsolve_cbind_mod.f90 @@ -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