diff --git a/Makefile b/Makefile index d3c36e25..01d79f13 100644 --- a/Makefile +++ b/Makefile @@ -1,5 +1,5 @@ include Make.inc - + all: dirs mods objs libd @echo "=====================================" @echo "PSBLAS libraries Compilation Successful." diff --git a/cbind/linsolve/psb_base_linsolve_cbind_mod.f90 b/cbind/linsolve/psb_base_linsolve_cbind_mod.f90 index db9f9d35..316e5cc4 100644 --- a/cbind/linsolve/psb_base_linsolve_cbind_mod.f90 +++ b/cbind/linsolve/psb_base_linsolve_cbind_mod.f90 @@ -27,7 +27,7 @@ contains 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 ' diff --git a/cbind/linsolve/psb_clinsolve_cbind_mod.f90 b/cbind/linsolve/psb_clinsolve_cbind_mod.f90 index 1480f023..56640b98 100644 --- a/cbind/linsolve/psb_clinsolve_cbind_mod.f90 +++ b/cbind/linsolve/psb_clinsolve_cbind_mod.f90 @@ -31,6 +31,7 @@ contains function psb_c_ckrylov_opt(methd,& & ah,ph,bh,xh,eps,cdh,itmax,iter,err,itrace,irst,istop) bind(c) result(res) use psb_base_mod + use psb_error_mod use psb_prec_mod use psb_linsolve_mod use psb_objhandle_mod @@ -51,7 +52,7 @@ contains type(psb_cprec_type), pointer :: precp type(psb_c_vect_type), pointer :: xp, bp - 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 @@ -89,7 +90,8 @@ contains fitrace = itrace first = irst fistop = istop - + err_act = psb_act_abort_ + if (psb_errstatus_fatal()) call psb_error_handler(err_act) call psb_krylov(fmethd, ap, precp, bp, xp, feps, & & descp, info,& & itmax=fitmax,iter=fiter,itrace=fitrace,istop=fistop,& @@ -97,6 +99,7 @@ contains 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 92cb02fa..8b571aab 100644 --- a/cbind/linsolve/psb_dlinsolve_cbind_mod.f90 +++ b/cbind/linsolve/psb_dlinsolve_cbind_mod.f90 @@ -31,6 +31,7 @@ contains function psb_c_dkrylov_opt(methd,& & ah,ph,bh,xh,eps,cdh,itmax,iter,err,itrace,irst,istop) bind(c) result(res) use psb_base_mod + use psb_error_mod use psb_prec_mod use psb_linsolve_mod use psb_objhandle_mod @@ -51,7 +52,7 @@ contains type(psb_dprec_type), pointer :: precp type(psb_d_vect_type), pointer :: xp, bp - 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 @@ -89,7 +90,8 @@ contains fitrace = itrace first = irst fistop = istop - + err_act = psb_act_abort_ + if (psb_errstatus_fatal()) call psb_error_handler(err_act) call psb_krylov(fmethd, ap, precp, bp, xp, feps, & & descp, info,& & itmax=fitmax,iter=fiter,itrace=fitrace,istop=fistop,& @@ -97,6 +99,7 @@ contains 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 4de46691..48a4640b 100644 --- a/cbind/linsolve/psb_linsolve_cbind.h +++ b/cbind/linsolve/psb_linsolve_cbind.h @@ -24,8 +24,8 @@ typedef struct psb_c_solveroptions { double err; /* Convergence indicator on exit */ } psb_c_SolverOptions; -psb_c_i_t psb_c_DefaultSolverOptions(psb_c_SolverOptions *opt); -psb_c_i_t psb_c_PrintSolverOptions(psb_c_SolverOptions *opt); +int psb_c_DefaultSolverOptions(psb_c_SolverOptions *opt); +int psb_c_PrintSolverOptions(psb_c_SolverOptions opt); psb_c_i_t psb_c_skrylov(const char *method, psb_c_sspmat *ah, psb_c_sprec *ph, psb_c_svector *bh, psb_c_svector *xh, diff --git a/cbind/linsolve/psb_slinsolve_cbind_mod.f90 b/cbind/linsolve/psb_slinsolve_cbind_mod.f90 index ed7c13e5..645c13fe 100644 --- a/cbind/linsolve/psb_slinsolve_cbind_mod.f90 +++ b/cbind/linsolve/psb_slinsolve_cbind_mod.f90 @@ -31,6 +31,7 @@ contains function psb_c_skrylov_opt(methd,& & ah,ph,bh,xh,eps,cdh,itmax,iter,err,itrace,irst,istop) bind(c) result(res) use psb_base_mod + use psb_error_mod use psb_prec_mod use psb_linsolve_mod use psb_objhandle_mod @@ -51,7 +52,7 @@ contains type(psb_sprec_type), pointer :: precp type(psb_s_vect_type), pointer :: xp, bp - 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 @@ -89,7 +90,8 @@ contains fitrace = itrace first = irst fistop = istop - + err_act = psb_act_abort_ + if (psb_errstatus_fatal()) call psb_error_handler(err_act) call psb_krylov(fmethd, ap, precp, bp, xp, feps, & & descp, info,& & itmax=fitmax,iter=fiter,itrace=fitrace,istop=fistop,& @@ -97,6 +99,7 @@ contains 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 8a3312c1..64ed455e 100644 --- a/cbind/linsolve/psb_zlinsolve_cbind_mod.f90 +++ b/cbind/linsolve/psb_zlinsolve_cbind_mod.f90 @@ -31,6 +31,7 @@ contains function psb_c_zkrylov_opt(methd,& & ah,ph,bh,xh,eps,cdh,itmax,iter,err,itrace,irst,istop) bind(c) result(res) use psb_base_mod + use psb_error_mod use psb_prec_mod use psb_linsolve_mod use psb_objhandle_mod @@ -51,7 +52,7 @@ contains type(psb_zprec_type), pointer :: precp type(psb_z_vect_type), pointer :: xp, bp - 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 @@ -89,7 +90,8 @@ contains fitrace = itrace first = irst fistop = istop - + err_act = psb_act_abort_ + if (psb_errstatus_fatal()) call psb_error_handler(err_act) call psb_krylov(fmethd, ap, precp, bp, xp, feps, & & descp, info,& & itmax=fitmax,iter=fiter,itrace=fitrace,istop=fistop,& @@ -97,6 +99,7 @@ contains iter = fiter err = ferr res = info + if (psb_errstatus_fatal()) call psb_error_handler(err_act) end function psb_c_zkrylov_opt diff --git a/prec/impl/psb_c_bjacprec_impl.f90 b/prec/impl/psb_c_bjacprec_impl.f90 index 59b01933..c2f9d510 100644 --- a/prec/impl/psb_c_bjacprec_impl.f90 +++ b/prec/impl/psb_c_bjacprec_impl.f90 @@ -644,6 +644,10 @@ subroutine psb_c_bjac_precbld(a,desc_a,prec,info,amold,vmold,imold) enddo deallocate(prec%av,stat=info) endif + if (allocated (prec%dv)) then + call prec%dv%free(info) + if (info == 0) deallocate(prec%dv) + end if end if if (.not.allocated(prec%av)) then allocate(prec%av(psb_max_avsz),stat=info) diff --git a/prec/impl/psb_c_diagprec_impl.f90 b/prec/impl/psb_c_diagprec_impl.f90 index 4e7c766a..296fe8e2 100644 --- a/prec/impl/psb_c_diagprec_impl.f90 +++ b/prec/impl/psb_c_diagprec_impl.f90 @@ -270,7 +270,7 @@ subroutine psb_c_diag_precbld(a,desc_a,prec,info,amold,vmold,imold) prec%d(i) = cone end do - allocate(prec%dv,stat=info) + if (.not.allocated(prec%dv)) allocate(prec%dv,stat=info) if (info == 0) then if (present(vmold)) then allocate(prec%dv%v,mold=vmold,stat=info) diff --git a/prec/impl/psb_d_bjacprec_impl.f90 b/prec/impl/psb_d_bjacprec_impl.f90 index 9f5b75a7..e0eaa5be 100644 --- a/prec/impl/psb_d_bjacprec_impl.f90 +++ b/prec/impl/psb_d_bjacprec_impl.f90 @@ -644,6 +644,10 @@ subroutine psb_d_bjac_precbld(a,desc_a,prec,info,amold,vmold,imold) enddo deallocate(prec%av,stat=info) endif + if (allocated (prec%dv)) then + call prec%dv%free(info) + if (info == 0) deallocate(prec%dv) + end if end if if (.not.allocated(prec%av)) then allocate(prec%av(psb_max_avsz),stat=info) diff --git a/prec/impl/psb_d_diagprec_impl.f90 b/prec/impl/psb_d_diagprec_impl.f90 index ec624908..695f4887 100644 --- a/prec/impl/psb_d_diagprec_impl.f90 +++ b/prec/impl/psb_d_diagprec_impl.f90 @@ -270,7 +270,7 @@ subroutine psb_d_diag_precbld(a,desc_a,prec,info,amold,vmold,imold) prec%d(i) = done end do - allocate(prec%dv,stat=info) + if (.not.allocated(prec%dv)) allocate(prec%dv,stat=info) if (info == 0) then if (present(vmold)) then allocate(prec%dv%v,mold=vmold,stat=info) diff --git a/prec/impl/psb_s_bjacprec_impl.f90 b/prec/impl/psb_s_bjacprec_impl.f90 index a477c663..405c9ad5 100644 --- a/prec/impl/psb_s_bjacprec_impl.f90 +++ b/prec/impl/psb_s_bjacprec_impl.f90 @@ -644,6 +644,10 @@ subroutine psb_s_bjac_precbld(a,desc_a,prec,info,amold,vmold,imold) enddo deallocate(prec%av,stat=info) endif + if (allocated (prec%dv)) then + call prec%dv%free(info) + if (info == 0) deallocate(prec%dv) + end if end if if (.not.allocated(prec%av)) then allocate(prec%av(psb_max_avsz),stat=info) diff --git a/prec/impl/psb_s_diagprec_impl.f90 b/prec/impl/psb_s_diagprec_impl.f90 index 8e93f964..7ad4785d 100644 --- a/prec/impl/psb_s_diagprec_impl.f90 +++ b/prec/impl/psb_s_diagprec_impl.f90 @@ -270,7 +270,7 @@ subroutine psb_s_diag_precbld(a,desc_a,prec,info,amold,vmold,imold) prec%d(i) = sone end do - allocate(prec%dv,stat=info) + if (.not.allocated(prec%dv)) allocate(prec%dv,stat=info) if (info == 0) then if (present(vmold)) then allocate(prec%dv%v,mold=vmold,stat=info) diff --git a/prec/impl/psb_z_bjacprec_impl.f90 b/prec/impl/psb_z_bjacprec_impl.f90 index 91e833a4..375241a6 100644 --- a/prec/impl/psb_z_bjacprec_impl.f90 +++ b/prec/impl/psb_z_bjacprec_impl.f90 @@ -644,6 +644,10 @@ subroutine psb_z_bjac_precbld(a,desc_a,prec,info,amold,vmold,imold) enddo deallocate(prec%av,stat=info) endif + if (allocated (prec%dv)) then + call prec%dv%free(info) + if (info == 0) deallocate(prec%dv) + end if end if if (.not.allocated(prec%av)) then allocate(prec%av(psb_max_avsz),stat=info) diff --git a/prec/impl/psb_z_diagprec_impl.f90 b/prec/impl/psb_z_diagprec_impl.f90 index 6940af2a..4bc7ce61 100644 --- a/prec/impl/psb_z_diagprec_impl.f90 +++ b/prec/impl/psb_z_diagprec_impl.f90 @@ -270,7 +270,7 @@ subroutine psb_z_diag_precbld(a,desc_a,prec,info,amold,vmold,imold) prec%d(i) = zone end do - allocate(prec%dv,stat=info) + if (.not.allocated(prec%dv)) allocate(prec%dv,stat=info) if (info == 0) then if (present(vmold)) then allocate(prec%dv%v,mold=vmold,stat=info)