From f660aa7cde4f2b6b0b5011c96241dcf85fb55db0 Mon Sep 17 00:00:00 2001 From: sfilippone Date: Tue, 5 May 2026 16:58:50 +0200 Subject: [PATCH 1/3] Fix matrix generation --- samples/advanced/pdegen/amg_d_genpde_mod.F90 | 4 ++-- samples/advanced/pdegen/amg_s_genpde_mod.F90 | 4 ++-- samples/simple/pdegen/amg_dpde_mod.f90 | 2 +- samples/simple/pdegen/amg_spde_mod.f90 | 2 +- 4 files changed, 6 insertions(+), 6 deletions(-) diff --git a/samples/advanced/pdegen/amg_d_genpde_mod.F90 b/samples/advanced/pdegen/amg_d_genpde_mod.F90 index 7bf4b128..b83d38d3 100644 --- a/samples/advanced/pdegen/amg_d_genpde_mod.F90 +++ b/samples/advanced/pdegen/amg_d_genpde_mod.F90 @@ -176,7 +176,7 @@ contains else partition_ = 3 end if - deltah = done/(idim+2) + deltah = done/(idim+1) sqdeltah = deltah*deltah deltah2 = 2.0_psb_dpk_* deltah @@ -643,7 +643,7 @@ contains f_ => d_null_func_2d end if - deltah = done/(idim+2) + deltah = done/(idim+1) sqdeltah = deltah*deltah deltah2 = 2.0_psb_dpk_* deltah diff --git a/samples/advanced/pdegen/amg_s_genpde_mod.F90 b/samples/advanced/pdegen/amg_s_genpde_mod.F90 index bc99530d..872b1c7e 100644 --- a/samples/advanced/pdegen/amg_s_genpde_mod.F90 +++ b/samples/advanced/pdegen/amg_s_genpde_mod.F90 @@ -176,7 +176,7 @@ contains else partition_ = 3 end if - deltah = sone/(idim+2) + deltah = sone/(idim+1) sqdeltah = deltah*deltah deltah2 = 2.0_psb_spk_* deltah @@ -643,7 +643,7 @@ contains f_ => s_null_func_2d end if - deltah = sone/(idim+2) + deltah = sone/(idim+1) sqdeltah = deltah*deltah deltah2 = 2.0_psb_spk_* deltah diff --git a/samples/simple/pdegen/amg_dpde_mod.f90 b/samples/simple/pdegen/amg_dpde_mod.f90 index e6883248..fba9dcf7 100644 --- a/samples/simple/pdegen/amg_dpde_mod.f90 +++ b/samples/simple/pdegen/amg_dpde_mod.f90 @@ -144,7 +144,7 @@ contains f_ => d_null_func_3d end if - deltah = 1.d0/(idim+2) + deltah = 1.d0/(idim+1) sqdeltah = deltah*deltah deltah2 = 2.0_psb_dpk_* deltah diff --git a/samples/simple/pdegen/amg_spde_mod.f90 b/samples/simple/pdegen/amg_spde_mod.f90 index d2d55447..c3fdcfe7 100644 --- a/samples/simple/pdegen/amg_spde_mod.f90 +++ b/samples/simple/pdegen/amg_spde_mod.f90 @@ -144,7 +144,7 @@ contains f_ => s_null_func_3d end if - deltah = 1.d0/(idim+2) + deltah = 1.d0/(idim+1) sqdeltah = deltah*deltah deltah2 = 2.0_psb_spk_* deltah From 64c1c9bbbd19d60483461e69226f1307b638f354 Mon Sep 17 00:00:00 2001 From: sfilippone Date: Tue, 12 May 2026 13:26:20 +0200 Subject: [PATCH 2/3] Fix (de)allocate prec and smoothers_free --- amgprec/amg_c_jac_smoother.f90 | 1 - amgprec/amg_c_prec_type.f90 | 4 ++++ amgprec/amg_d_jac_smoother.f90 | 1 - amgprec/amg_d_poly_smoother.f90 | 1 - amgprec/amg_d_prec_type.f90 | 4 ++++ amgprec/amg_s_jac_smoother.f90 | 1 - amgprec/amg_s_poly_smoother.f90 | 1 - amgprec/amg_s_prec_type.f90 | 4 ++++ amgprec/amg_z_jac_smoother.f90 | 1 - amgprec/amg_z_prec_type.f90 | 4 ++++ amgprec/impl/smoother/amg_c_as_smoother_free.f90 | 1 - amgprec/impl/smoother/amg_c_base_smoother_free.f90 | 1 - amgprec/impl/smoother/amg_d_as_smoother_free.f90 | 1 - amgprec/impl/smoother/amg_d_base_smoother_free.f90 | 1 - amgprec/impl/smoother/amg_s_as_smoother_free.f90 | 1 - amgprec/impl/smoother/amg_s_base_smoother_free.f90 | 1 - amgprec/impl/smoother/amg_z_as_smoother_free.f90 | 1 - amgprec/impl/smoother/amg_z_base_smoother_free.f90 | 1 - amgprec/impl/solver/amg_c_diag_solver_bld.f90 | 4 ++-- amgprec/impl/solver/amg_c_jac_solver_bld.f90 | 2 +- amgprec/impl/solver/amg_c_l1_jac_solver_bld.f90 | 2 +- amgprec/impl/solver/amg_d_diag_solver_bld.f90 | 4 ++-- amgprec/impl/solver/amg_d_jac_solver_bld.f90 | 2 +- amgprec/impl/solver/amg_d_l1_jac_solver_bld.f90 | 2 +- amgprec/impl/solver/amg_s_diag_solver_bld.f90 | 4 ++-- amgprec/impl/solver/amg_s_jac_solver_bld.f90 | 2 +- amgprec/impl/solver/amg_s_l1_jac_solver_bld.f90 | 2 +- amgprec/impl/solver/amg_z_diag_solver_bld.f90 | 4 ++-- amgprec/impl/solver/amg_z_jac_solver_bld.f90 | 2 +- amgprec/impl/solver/amg_z_l1_jac_solver_bld.f90 | 2 +- 30 files changed, 32 insertions(+), 30 deletions(-) diff --git a/amgprec/amg_c_jac_smoother.f90 b/amgprec/amg_c_jac_smoother.f90 index 94229ff5..22fd5bef 100644 --- a/amgprec/amg_c_jac_smoother.f90 +++ b/amgprec/amg_c_jac_smoother.f90 @@ -345,7 +345,6 @@ contains if (allocated(sm%sv)) then call sm%sv%free(info) - if (info == psb_success_) deallocate(sm%sv,stat=info) if (info /= psb_success_) then info = psb_err_alloc_dealloc_ call psb_errpush(info,name) diff --git a/amgprec/amg_c_prec_type.f90 b/amgprec/amg_c_prec_type.f90 index 85e05366..578dcff0 100644 --- a/amgprec/amg_c_prec_type.f90 +++ b/amgprec/amg_c_prec_type.f90 @@ -665,6 +665,10 @@ contains info = psb_err_internal_error_; goto 9999 end if + ! + ! In the internals, do FREE on components, + ! but do not deallocate them + ! if (allocated(prec%precv)) then do i=1,size(prec%precv) call prec%precv(i)%free_smoothers(info) diff --git a/amgprec/amg_d_jac_smoother.f90 b/amgprec/amg_d_jac_smoother.f90 index fff8e22e..01f9d786 100644 --- a/amgprec/amg_d_jac_smoother.f90 +++ b/amgprec/amg_d_jac_smoother.f90 @@ -345,7 +345,6 @@ contains if (allocated(sm%sv)) then call sm%sv%free(info) - if (info == psb_success_) deallocate(sm%sv,stat=info) if (info /= psb_success_) then info = psb_err_alloc_dealloc_ call psb_errpush(info,name) diff --git a/amgprec/amg_d_poly_smoother.f90 b/amgprec/amg_d_poly_smoother.f90 index bd24b49a..7529c6d0 100644 --- a/amgprec/amg_d_poly_smoother.f90 +++ b/amgprec/amg_d_poly_smoother.f90 @@ -279,7 +279,6 @@ contains if (allocated(sm%sv)) then call sm%sv%free(info) - if (info == psb_success_) deallocate(sm%sv,stat=info) if (info /= psb_success_) then info = psb_err_alloc_dealloc_ call psb_errpush(info,name) diff --git a/amgprec/amg_d_prec_type.f90 b/amgprec/amg_d_prec_type.f90 index c7404e2d..805f73d5 100644 --- a/amgprec/amg_d_prec_type.f90 +++ b/amgprec/amg_d_prec_type.f90 @@ -665,6 +665,10 @@ contains info = psb_err_internal_error_; goto 9999 end if + ! + ! In the internals, do FREE on components, + ! but do not deallocate them + ! if (allocated(prec%precv)) then do i=1,size(prec%precv) call prec%precv(i)%free_smoothers(info) diff --git a/amgprec/amg_s_jac_smoother.f90 b/amgprec/amg_s_jac_smoother.f90 index 256f9ecc..8df800da 100644 --- a/amgprec/amg_s_jac_smoother.f90 +++ b/amgprec/amg_s_jac_smoother.f90 @@ -345,7 +345,6 @@ contains if (allocated(sm%sv)) then call sm%sv%free(info) - if (info == psb_success_) deallocate(sm%sv,stat=info) if (info /= psb_success_) then info = psb_err_alloc_dealloc_ call psb_errpush(info,name) diff --git a/amgprec/amg_s_poly_smoother.f90 b/amgprec/amg_s_poly_smoother.f90 index aa905aad..322f249e 100644 --- a/amgprec/amg_s_poly_smoother.f90 +++ b/amgprec/amg_s_poly_smoother.f90 @@ -279,7 +279,6 @@ contains if (allocated(sm%sv)) then call sm%sv%free(info) - if (info == psb_success_) deallocate(sm%sv,stat=info) if (info /= psb_success_) then info = psb_err_alloc_dealloc_ call psb_errpush(info,name) diff --git a/amgprec/amg_s_prec_type.f90 b/amgprec/amg_s_prec_type.f90 index 7d45e184..5a4a94dc 100644 --- a/amgprec/amg_s_prec_type.f90 +++ b/amgprec/amg_s_prec_type.f90 @@ -665,6 +665,10 @@ contains info = psb_err_internal_error_; goto 9999 end if + ! + ! In the internals, do FREE on components, + ! but do not deallocate them + ! if (allocated(prec%precv)) then do i=1,size(prec%precv) call prec%precv(i)%free_smoothers(info) diff --git a/amgprec/amg_z_jac_smoother.f90 b/amgprec/amg_z_jac_smoother.f90 index f698f95b..b1aa7d5a 100644 --- a/amgprec/amg_z_jac_smoother.f90 +++ b/amgprec/amg_z_jac_smoother.f90 @@ -345,7 +345,6 @@ contains if (allocated(sm%sv)) then call sm%sv%free(info) - if (info == psb_success_) deallocate(sm%sv,stat=info) if (info /= psb_success_) then info = psb_err_alloc_dealloc_ call psb_errpush(info,name) diff --git a/amgprec/amg_z_prec_type.f90 b/amgprec/amg_z_prec_type.f90 index dba1ab52..1db85845 100644 --- a/amgprec/amg_z_prec_type.f90 +++ b/amgprec/amg_z_prec_type.f90 @@ -665,6 +665,10 @@ contains info = psb_err_internal_error_; goto 9999 end if + ! + ! In the internals, do FREE on components, + ! but do not deallocate them + ! if (allocated(prec%precv)) then do i=1,size(prec%precv) call prec%precv(i)%free_smoothers(info) diff --git a/amgprec/impl/smoother/amg_c_as_smoother_free.f90 b/amgprec/impl/smoother/amg_c_as_smoother_free.f90 index f491fb4f..6f05f30e 100644 --- a/amgprec/impl/smoother/amg_c_as_smoother_free.f90 +++ b/amgprec/impl/smoother/amg_c_as_smoother_free.f90 @@ -53,7 +53,6 @@ subroutine amg_c_as_smoother_free(sm,info) if (allocated(sm%sv)) then call sm%sv%free(info) - if (info == psb_success_) deallocate(sm%sv,stat=info) if (info /= psb_success_) then info = psb_err_alloc_dealloc_ call psb_errpush(info,name) diff --git a/amgprec/impl/smoother/amg_c_base_smoother_free.f90 b/amgprec/impl/smoother/amg_c_base_smoother_free.f90 index d5a1882f..f3af2822 100644 --- a/amgprec/impl/smoother/amg_c_base_smoother_free.f90 +++ b/amgprec/impl/smoother/amg_c_base_smoother_free.f90 @@ -52,7 +52,6 @@ subroutine amg_c_base_smoother_free(sm,info) if (allocated(sm%sv)) then call sm%sv%free(info) - if (info == psb_success_) deallocate(sm%sv,stat=info) end if if (info /= psb_success_) then info = psb_err_alloc_dealloc_ diff --git a/amgprec/impl/smoother/amg_d_as_smoother_free.f90 b/amgprec/impl/smoother/amg_d_as_smoother_free.f90 index 55bf9355..5f06713c 100644 --- a/amgprec/impl/smoother/amg_d_as_smoother_free.f90 +++ b/amgprec/impl/smoother/amg_d_as_smoother_free.f90 @@ -53,7 +53,6 @@ subroutine amg_d_as_smoother_free(sm,info) if (allocated(sm%sv)) then call sm%sv%free(info) - if (info == psb_success_) deallocate(sm%sv,stat=info) if (info /= psb_success_) then info = psb_err_alloc_dealloc_ call psb_errpush(info,name) diff --git a/amgprec/impl/smoother/amg_d_base_smoother_free.f90 b/amgprec/impl/smoother/amg_d_base_smoother_free.f90 index fcbe41ba..056da6cc 100644 --- a/amgprec/impl/smoother/amg_d_base_smoother_free.f90 +++ b/amgprec/impl/smoother/amg_d_base_smoother_free.f90 @@ -52,7 +52,6 @@ subroutine amg_d_base_smoother_free(sm,info) if (allocated(sm%sv)) then call sm%sv%free(info) - if (info == psb_success_) deallocate(sm%sv,stat=info) end if if (info /= psb_success_) then info = psb_err_alloc_dealloc_ diff --git a/amgprec/impl/smoother/amg_s_as_smoother_free.f90 b/amgprec/impl/smoother/amg_s_as_smoother_free.f90 index 8b71ab0a..c23b86fb 100644 --- a/amgprec/impl/smoother/amg_s_as_smoother_free.f90 +++ b/amgprec/impl/smoother/amg_s_as_smoother_free.f90 @@ -53,7 +53,6 @@ subroutine amg_s_as_smoother_free(sm,info) if (allocated(sm%sv)) then call sm%sv%free(info) - if (info == psb_success_) deallocate(sm%sv,stat=info) if (info /= psb_success_) then info = psb_err_alloc_dealloc_ call psb_errpush(info,name) diff --git a/amgprec/impl/smoother/amg_s_base_smoother_free.f90 b/amgprec/impl/smoother/amg_s_base_smoother_free.f90 index cd626c27..8691f9d3 100644 --- a/amgprec/impl/smoother/amg_s_base_smoother_free.f90 +++ b/amgprec/impl/smoother/amg_s_base_smoother_free.f90 @@ -52,7 +52,6 @@ subroutine amg_s_base_smoother_free(sm,info) if (allocated(sm%sv)) then call sm%sv%free(info) - if (info == psb_success_) deallocate(sm%sv,stat=info) end if if (info /= psb_success_) then info = psb_err_alloc_dealloc_ diff --git a/amgprec/impl/smoother/amg_z_as_smoother_free.f90 b/amgprec/impl/smoother/amg_z_as_smoother_free.f90 index 08b23f50..36640bd6 100644 --- a/amgprec/impl/smoother/amg_z_as_smoother_free.f90 +++ b/amgprec/impl/smoother/amg_z_as_smoother_free.f90 @@ -53,7 +53,6 @@ subroutine amg_z_as_smoother_free(sm,info) if (allocated(sm%sv)) then call sm%sv%free(info) - if (info == psb_success_) deallocate(sm%sv,stat=info) if (info /= psb_success_) then info = psb_err_alloc_dealloc_ call psb_errpush(info,name) diff --git a/amgprec/impl/smoother/amg_z_base_smoother_free.f90 b/amgprec/impl/smoother/amg_z_base_smoother_free.f90 index 3cae112e..f1da5f3c 100644 --- a/amgprec/impl/smoother/amg_z_base_smoother_free.f90 +++ b/amgprec/impl/smoother/amg_z_base_smoother_free.f90 @@ -52,7 +52,6 @@ subroutine amg_z_base_smoother_free(sm,info) if (allocated(sm%sv)) then call sm%sv%free(info) - if (info == psb_success_) deallocate(sm%sv,stat=info) end if if (info /= psb_success_) then info = psb_err_alloc_dealloc_ diff --git a/amgprec/impl/solver/amg_c_diag_solver_bld.f90 b/amgprec/impl/solver/amg_c_diag_solver_bld.f90 index 3048605f..32252377 100644 --- a/amgprec/impl/solver/amg_c_diag_solver_bld.f90 +++ b/amgprec/impl/solver/amg_c_diag_solver_bld.f90 @@ -91,7 +91,7 @@ subroutine amg_c_diag_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold) sv%d(i) = cone/sv%d(i) end if end do - allocate(sv%dv,stat=info) + if (.not.allocated(sv%dv)) allocate(sv%dv,stat=info) if (info == psb_success_) then call sv%dv%bld(sv%d) if (present(vmold)) call sv%dv%cnv(vmold) @@ -172,7 +172,7 @@ subroutine amg_c_l1_diag_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold) sv%d(i) = cone/sv%d(i) end if end do - allocate(sv%dv,stat=info) + if (.not.allocated(sv%dv)) allocate(sv%dv,stat=info) if (info == psb_success_) then call sv%dv%bld(sv%d) if (present(vmold)) call sv%dv%cnv(vmold) diff --git a/amgprec/impl/solver/amg_c_jac_solver_bld.f90 b/amgprec/impl/solver/amg_c_jac_solver_bld.f90 index 2a55b8b5..b9d9bcd7 100644 --- a/amgprec/impl/solver/amg_c_jac_solver_bld.f90 +++ b/amgprec/impl/solver/amg_c_jac_solver_bld.f90 @@ -100,7 +100,7 @@ subroutine amg_c_jac_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold) sv%d(i) = cone/sv%d(i) end if end do - allocate(sv%dv,stat=info) + if (.not.allocated(sv%dv)) allocate(sv%dv,stat=info) if (info == psb_success_) then call sv%dv%bld(sv%d) if (present(vmold)) call sv%dv%cnv(vmold) diff --git a/amgprec/impl/solver/amg_c_l1_jac_solver_bld.f90 b/amgprec/impl/solver/amg_c_l1_jac_solver_bld.f90 index b83fe53d..809af437 100644 --- a/amgprec/impl/solver/amg_c_l1_jac_solver_bld.f90 +++ b/amgprec/impl/solver/amg_c_l1_jac_solver_bld.f90 @@ -103,7 +103,7 @@ subroutine amg_c_l1_jac_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold) sv%d(i) = cone/sv%d(i) end if end do - allocate(sv%dv,stat=info) + if (.not.allocated(sv%dv)) allocate(sv%dv,stat=info) if (info == psb_success_) then call sv%dv%bld(sv%d) if (present(vmold)) call sv%dv%cnv(vmold) diff --git a/amgprec/impl/solver/amg_d_diag_solver_bld.f90 b/amgprec/impl/solver/amg_d_diag_solver_bld.f90 index 77d34ce7..08c5d0b5 100644 --- a/amgprec/impl/solver/amg_d_diag_solver_bld.f90 +++ b/amgprec/impl/solver/amg_d_diag_solver_bld.f90 @@ -91,7 +91,7 @@ subroutine amg_d_diag_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold) sv%d(i) = done/sv%d(i) end if end do - allocate(sv%dv,stat=info) + if (.not.allocated(sv%dv)) allocate(sv%dv,stat=info) if (info == psb_success_) then call sv%dv%bld(sv%d) if (present(vmold)) call sv%dv%cnv(vmold) @@ -172,7 +172,7 @@ subroutine amg_d_l1_diag_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold) sv%d(i) = done/sv%d(i) end if end do - allocate(sv%dv,stat=info) + if (.not.allocated(sv%dv)) allocate(sv%dv,stat=info) if (info == psb_success_) then call sv%dv%bld(sv%d) if (present(vmold)) call sv%dv%cnv(vmold) diff --git a/amgprec/impl/solver/amg_d_jac_solver_bld.f90 b/amgprec/impl/solver/amg_d_jac_solver_bld.f90 index 1a8f9456..8660eaf2 100644 --- a/amgprec/impl/solver/amg_d_jac_solver_bld.f90 +++ b/amgprec/impl/solver/amg_d_jac_solver_bld.f90 @@ -100,7 +100,7 @@ subroutine amg_d_jac_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold) sv%d(i) = done/sv%d(i) end if end do - allocate(sv%dv,stat=info) + if (.not.allocated(sv%dv)) allocate(sv%dv,stat=info) if (info == psb_success_) then call sv%dv%bld(sv%d) if (present(vmold)) call sv%dv%cnv(vmold) diff --git a/amgprec/impl/solver/amg_d_l1_jac_solver_bld.f90 b/amgprec/impl/solver/amg_d_l1_jac_solver_bld.f90 index 3ba0dc4a..9cb47dbb 100644 --- a/amgprec/impl/solver/amg_d_l1_jac_solver_bld.f90 +++ b/amgprec/impl/solver/amg_d_l1_jac_solver_bld.f90 @@ -103,7 +103,7 @@ subroutine amg_d_l1_jac_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold) sv%d(i) = done/sv%d(i) end if end do - allocate(sv%dv,stat=info) + if (.not.allocated(sv%dv)) allocate(sv%dv,stat=info) if (info == psb_success_) then call sv%dv%bld(sv%d) if (present(vmold)) call sv%dv%cnv(vmold) diff --git a/amgprec/impl/solver/amg_s_diag_solver_bld.f90 b/amgprec/impl/solver/amg_s_diag_solver_bld.f90 index 9e678a00..3a6588a5 100644 --- a/amgprec/impl/solver/amg_s_diag_solver_bld.f90 +++ b/amgprec/impl/solver/amg_s_diag_solver_bld.f90 @@ -91,7 +91,7 @@ subroutine amg_s_diag_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold) sv%d(i) = sone/sv%d(i) end if end do - allocate(sv%dv,stat=info) + if (.not.allocated(sv%dv)) allocate(sv%dv,stat=info) if (info == psb_success_) then call sv%dv%bld(sv%d) if (present(vmold)) call sv%dv%cnv(vmold) @@ -172,7 +172,7 @@ subroutine amg_s_l1_diag_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold) sv%d(i) = sone/sv%d(i) end if end do - allocate(sv%dv,stat=info) + if (.not.allocated(sv%dv)) allocate(sv%dv,stat=info) if (info == psb_success_) then call sv%dv%bld(sv%d) if (present(vmold)) call sv%dv%cnv(vmold) diff --git a/amgprec/impl/solver/amg_s_jac_solver_bld.f90 b/amgprec/impl/solver/amg_s_jac_solver_bld.f90 index 2486b017..2ae080e9 100644 --- a/amgprec/impl/solver/amg_s_jac_solver_bld.f90 +++ b/amgprec/impl/solver/amg_s_jac_solver_bld.f90 @@ -100,7 +100,7 @@ subroutine amg_s_jac_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold) sv%d(i) = sone/sv%d(i) end if end do - allocate(sv%dv,stat=info) + if (.not.allocated(sv%dv)) allocate(sv%dv,stat=info) if (info == psb_success_) then call sv%dv%bld(sv%d) if (present(vmold)) call sv%dv%cnv(vmold) diff --git a/amgprec/impl/solver/amg_s_l1_jac_solver_bld.f90 b/amgprec/impl/solver/amg_s_l1_jac_solver_bld.f90 index 6cfff1e9..b90b9df2 100644 --- a/amgprec/impl/solver/amg_s_l1_jac_solver_bld.f90 +++ b/amgprec/impl/solver/amg_s_l1_jac_solver_bld.f90 @@ -103,7 +103,7 @@ subroutine amg_s_l1_jac_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold) sv%d(i) = sone/sv%d(i) end if end do - allocate(sv%dv,stat=info) + if (.not.allocated(sv%dv)) allocate(sv%dv,stat=info) if (info == psb_success_) then call sv%dv%bld(sv%d) if (present(vmold)) call sv%dv%cnv(vmold) diff --git a/amgprec/impl/solver/amg_z_diag_solver_bld.f90 b/amgprec/impl/solver/amg_z_diag_solver_bld.f90 index ef743861..aaf5ef97 100644 --- a/amgprec/impl/solver/amg_z_diag_solver_bld.f90 +++ b/amgprec/impl/solver/amg_z_diag_solver_bld.f90 @@ -91,7 +91,7 @@ subroutine amg_z_diag_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold) sv%d(i) = zone/sv%d(i) end if end do - allocate(sv%dv,stat=info) + if (.not.allocated(sv%dv)) allocate(sv%dv,stat=info) if (info == psb_success_) then call sv%dv%bld(sv%d) if (present(vmold)) call sv%dv%cnv(vmold) @@ -172,7 +172,7 @@ subroutine amg_z_l1_diag_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold) sv%d(i) = zone/sv%d(i) end if end do - allocate(sv%dv,stat=info) + if (.not.allocated(sv%dv)) allocate(sv%dv,stat=info) if (info == psb_success_) then call sv%dv%bld(sv%d) if (present(vmold)) call sv%dv%cnv(vmold) diff --git a/amgprec/impl/solver/amg_z_jac_solver_bld.f90 b/amgprec/impl/solver/amg_z_jac_solver_bld.f90 index 4185e069..26b6015c 100644 --- a/amgprec/impl/solver/amg_z_jac_solver_bld.f90 +++ b/amgprec/impl/solver/amg_z_jac_solver_bld.f90 @@ -100,7 +100,7 @@ subroutine amg_z_jac_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold) sv%d(i) = zone/sv%d(i) end if end do - allocate(sv%dv,stat=info) + if (.not.allocated(sv%dv)) allocate(sv%dv,stat=info) if (info == psb_success_) then call sv%dv%bld(sv%d) if (present(vmold)) call sv%dv%cnv(vmold) diff --git a/amgprec/impl/solver/amg_z_l1_jac_solver_bld.f90 b/amgprec/impl/solver/amg_z_l1_jac_solver_bld.f90 index febe2c3a..be333796 100644 --- a/amgprec/impl/solver/amg_z_l1_jac_solver_bld.f90 +++ b/amgprec/impl/solver/amg_z_l1_jac_solver_bld.f90 @@ -103,7 +103,7 @@ subroutine amg_z_l1_jac_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold) sv%d(i) = zone/sv%d(i) end if end do - allocate(sv%dv,stat=info) + if (.not.allocated(sv%dv)) allocate(sv%dv,stat=info) if (info == psb_success_) then call sv%dv%bld(sv%d) if (present(vmold)) call sv%dv%cnv(vmold) From 1faa0d57b3822dd79394b0a89caa9861498e6358 Mon Sep 17 00:00:00 2001 From: sfilippone Date: Tue, 12 May 2026 13:36:38 +0200 Subject: [PATCH 3/3] Improve CBIND prec --- cbind/amgprec/amg_dprec_cbind_mod.F90 | 19 +++++++++++++++---- cbind/amgprec/amg_zprec_cbind_mod.F90 | 19 +++++++++++++++---- 2 files changed, 30 insertions(+), 8 deletions(-) diff --git a/cbind/amgprec/amg_dprec_cbind_mod.F90 b/cbind/amgprec/amg_dprec_cbind_mod.F90 index 18dcad06..613728d1 100644 --- a/cbind/amgprec/amg_dprec_cbind_mod.F90 +++ b/cbind/amgprec/amg_dprec_cbind_mod.F90 @@ -172,15 +172,17 @@ contains end function amg_c_dprecbld function amg_c_dhierarchy_build(ah,cdh,ph) bind(c) result(res) + use psb_base_mod implicit none integer(psb_c_ipk_) :: res type(psb_c_object_type) :: ph,ah,cdh - integer(psb_ipk_) :: iret type(amg_dprec_type), pointer :: precp type(psb_dspmat_type), pointer :: ap type(psb_desc_type), pointer :: descp character(len=80) :: fptype + integer(psb_ipk_) :: iret, act + res = -1 @@ -204,11 +206,16 @@ contains res = AMGC_ERR_FILTER(iret) AMGC_ERR_HANDLE(res) - + if (res /=0) then + act = psb_act_abort_ + call psb_error_handler(act) + end if + return end function amg_c_dhierarchy_build function amg_c_dsmoothers_build(ah,cdh,ph) bind(c) result(res) + use psb_base_mod implicit none integer(psb_c_ipk_) :: res @@ -217,7 +224,7 @@ contains type(psb_dspmat_type), pointer :: ap type(psb_desc_type), pointer :: descp character(len=80) :: fptype - integer(psb_ipk_) :: iret + integer(psb_ipk_) :: iret, act res = -1 @@ -241,6 +248,10 @@ contains res = AMGC_ERR_FILTER(iret) AMGC_ERR_HANDLE(res) + if (res /=0) then + act = psb_act_abort_ + call psb_error_handler(act) + end if return end function amg_c_dsmoothers_build @@ -257,7 +268,7 @@ contains type(psb_c_object_type) :: ah,cdh,ph,bh,xh character(c_char) :: methd(*) type(solveroptions) :: options - + res= amg_c_dkrylov_opt(methd, ah, ph, bh, xh, options%eps,cdh, & & itmax=options%itmax, iter=options%iter,& & itrace=options%itrace, istop=options%istop,& diff --git a/cbind/amgprec/amg_zprec_cbind_mod.F90 b/cbind/amgprec/amg_zprec_cbind_mod.F90 index ff9517d4..a08a38c6 100644 --- a/cbind/amgprec/amg_zprec_cbind_mod.F90 +++ b/cbind/amgprec/amg_zprec_cbind_mod.F90 @@ -140,11 +140,11 @@ contains integer(psb_c_ipk_) :: res type(psb_c_object_type) :: ph,ah,cdh - integer(psb_ipk_) :: iret type(amg_zprec_type), pointer :: precp type(psb_zspmat_type), pointer :: ap type(psb_desc_type), pointer :: descp character(len=80) :: fptype + integer(psb_ipk_) :: iret res = -1 @@ -173,15 +173,17 @@ contains end function amg_c_zprecbld function amg_c_zhierarchy_build(ah,cdh,ph) bind(c) result(res) + use psb_base_mod implicit none integer(psb_c_ipk_) :: res type(psb_c_object_type) :: ph,ah,cdh - integer(psb_ipk_) :: iret type(amg_zprec_type), pointer :: precp type(psb_zspmat_type), pointer :: ap type(psb_desc_type), pointer :: descp character(len=80) :: fptype + integer(psb_ipk_) :: iret, act + res = -1 @@ -205,20 +207,25 @@ contains res = AMGC_ERR_FILTER(iret) AMGC_ERR_HANDLE(res) - + if (res /=0) then + act = psb_act_abort_ + call psb_error_handler(act) + end if + return end function amg_c_zhierarchy_build function amg_c_zsmoothers_build(ah,cdh,ph) bind(c) result(res) + use psb_base_mod implicit none integer(psb_c_ipk_) :: res type(psb_c_object_type) :: ph,ah,cdh - integer(psb_ipk_) :: iret type(amg_zprec_type), pointer :: precp type(psb_zspmat_type), pointer :: ap type(psb_desc_type), pointer :: descp character(len=80) :: fptype + integer(psb_ipk_) :: iret, act res = -1 @@ -242,6 +249,10 @@ contains res = AMGC_ERR_FILTER(iret) AMGC_ERR_HANDLE(res) + if (res /=0) then + act = psb_act_abort_ + call psb_error_handler(act) + end if return end function amg_c_zsmoothers_build