From 9e1c7b775e7ce028aa23be1938a8c0331bd2ff1f Mon Sep 17 00:00:00 2001 From: sfilippone Date: Tue, 12 May 2026 13:27:24 +0200 Subject: [PATCH] Fix (de)allocate prec and SolverOptions --- cbind/linsolve/psb_base_linsolve_cbind_mod.f90 | 2 +- cbind/linsolve/psb_clinsolve_cbind_mod.f90 | 7 +++++-- cbind/linsolve/psb_dlinsolve_cbind_mod.f90 | 7 +++++-- cbind/linsolve/psb_linsolve_cbind.h | 2 +- cbind/linsolve/psb_slinsolve_cbind_mod.f90 | 7 +++++-- cbind/linsolve/psb_zlinsolve_cbind_mod.f90 | 7 +++++-- prec/impl/psb_c_bjacprec_impl.f90 | 4 ++++ prec/impl/psb_c_diagprec_impl.f90 | 2 +- prec/impl/psb_d_bjacprec_impl.f90 | 4 ++++ prec/impl/psb_d_diagprec_impl.f90 | 2 +- prec/impl/psb_s_bjacprec_impl.f90 | 4 ++++ prec/impl/psb_s_diagprec_impl.f90 | 2 +- prec/impl/psb_z_bjacprec_impl.f90 | 4 ++++ prec/impl/psb_z_diagprec_impl.f90 | 2 +- 14 files changed, 42 insertions(+), 14 deletions(-) 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 29a0b2fc..b4d9b48c 100644 --- a/cbind/linsolve/psb_clinsolve_cbind_mod.f90 +++ b/cbind/linsolve/psb_clinsolve_cbind_mod.f90 @@ -32,6 +32,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 @@ -53,7 +54,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 @@ -91,7 +92,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,& @@ -99,6 +101,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 35612ec3..5feac2cb 100644 --- a/cbind/linsolve/psb_dlinsolve_cbind_mod.f90 +++ b/cbind/linsolve/psb_dlinsolve_cbind_mod.f90 @@ -32,6 +32,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 @@ -53,7 +54,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 @@ -91,7 +92,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,& @@ -99,6 +101,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 d86bf216..41bb7ed1 100644 --- a/cbind/linsolve/psb_linsolve_cbind.h +++ b/cbind/linsolve/psb_linsolve_cbind.h @@ -25,7 +25,7 @@ typedef struct psb_c_solveroptions { } 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, diff --git a/cbind/linsolve/psb_slinsolve_cbind_mod.f90 b/cbind/linsolve/psb_slinsolve_cbind_mod.f90 index e1823bd8..5a2c064b 100644 --- a/cbind/linsolve/psb_slinsolve_cbind_mod.f90 +++ b/cbind/linsolve/psb_slinsolve_cbind_mod.f90 @@ -32,6 +32,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 @@ -53,7 +54,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 @@ -91,7 +92,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,& @@ -99,6 +101,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 3234c72c..a95d7f96 100644 --- a/cbind/linsolve/psb_zlinsolve_cbind_mod.f90 +++ b/cbind/linsolve/psb_zlinsolve_cbind_mod.f90 @@ -32,6 +32,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 @@ -53,7 +54,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 @@ -91,7 +92,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,& @@ -99,6 +101,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)