diff --git a/.VERSION b/.VERSION index 83300500..cb871239 100644 --- a/.VERSION +++ b/.VERSION @@ -1,5 +1,4 @@ $Format:%d%n%n$ -# Fall back version, probably last release: 1.2.1 # AMG4PSBLAS version file. diff --git a/LICENSE b/LICENSE index d68a0e9c..d55d3f6d 100644 --- a/LICENSE +++ b/LICENSE @@ -7,7 +7,7 @@ (C) Copyright 2025 Salvatore Filippone (C) Copyright 2025 Pasqua D'Ambra (C) Copyright 2025 Fabio Durastante - + Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: diff --git a/amgprec/amg_c_jac_smoother.f90 b/amgprec/amg_c_jac_smoother.f90 index fa3efe78..1f303828 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 0359efdd..367c0d93 100644 --- a/amgprec/amg_c_prec_type.f90 +++ b/amgprec/amg_c_prec_type.f90 @@ -671,6 +671,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 93136b48..5bd5a9f7 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 7733ddfd..72a822fb 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 1a9a932e..69809dd6 100644 --- a/amgprec/amg_d_prec_type.f90 +++ b/amgprec/amg_d_prec_type.f90 @@ -671,6 +671,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 508495d3..60e64286 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 a03e7e16..393b8dbd 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 ea87bbf3..f9ad90fe 100644 --- a/amgprec/amg_s_prec_type.f90 +++ b/amgprec/amg_s_prec_type.f90 @@ -671,6 +671,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 5fecc0e9..c6f661d0 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 9d44ca06..df82dcb7 100644 --- a/amgprec/amg_z_prec_type.f90 +++ b/amgprec/amg_z_prec_type.f90 @@ -671,6 +671,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 e33c2952..20ff02e7 100644 --- a/amgprec/impl/solver/amg_c_diag_solver_bld.f90 +++ b/amgprec/impl/solver/amg_c_diag_solver_bld.f90 @@ -91,11 +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 - if (allocated(sv%dv)) then - call sv%dv%free(info) - deallocate(sv%dv) - end if - 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) @@ -176,11 +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 - if (allocated(sv%dv)) then - call sv%dv%free(info) - deallocate(sv%dv) - end if - 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 9fbcd717..47881e54 100644 --- a/amgprec/impl/solver/amg_c_jac_solver_bld.f90 +++ b/amgprec/impl/solver/amg_c_jac_solver_bld.f90 @@ -100,11 +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 - if (allocated(sv%dv)) then - call sv%dv%free(info) - deallocate(sv%dv) - end if - 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 1d0d2cf1..6d4923a4 100644 --- a/amgprec/impl/solver/amg_c_l1_jac_solver_bld.f90 +++ b/amgprec/impl/solver/amg_c_l1_jac_solver_bld.f90 @@ -103,11 +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 - if (allocated(sv%dv)) then - call sv%dv%free(info) - deallocate(sv%dv) - end if - 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 3c357e15..c320e77b 100644 --- a/amgprec/impl/solver/amg_d_diag_solver_bld.f90 +++ b/amgprec/impl/solver/amg_d_diag_solver_bld.f90 @@ -91,11 +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 - if (allocated(sv%dv)) then - call sv%dv%free(info) - deallocate(sv%dv) - end if - 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) @@ -176,11 +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 - if (allocated(sv%dv)) then - call sv%dv%free(info) - deallocate(sv%dv) - end if - 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 23a0b190..39e55cb7 100644 --- a/amgprec/impl/solver/amg_d_jac_solver_bld.f90 +++ b/amgprec/impl/solver/amg_d_jac_solver_bld.f90 @@ -100,11 +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 - if (allocated(sv%dv)) then - call sv%dv%free(info) - deallocate(sv%dv) - end if - 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 411501ec..4a03d723 100644 --- a/amgprec/impl/solver/amg_d_l1_jac_solver_bld.f90 +++ b/amgprec/impl/solver/amg_d_l1_jac_solver_bld.f90 @@ -103,11 +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 - if (allocated(sv%dv)) then - call sv%dv%free(info) - deallocate(sv%dv) - end if - 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 7561bca2..089db3fe 100644 --- a/amgprec/impl/solver/amg_s_diag_solver_bld.f90 +++ b/amgprec/impl/solver/amg_s_diag_solver_bld.f90 @@ -91,11 +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 - if (allocated(sv%dv)) then - call sv%dv%free(info) - deallocate(sv%dv) - end if - 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) @@ -176,11 +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 - if (allocated(sv%dv)) then - call sv%dv%free(info) - deallocate(sv%dv) - end if - 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 1afadf09..9e9f1944 100644 --- a/amgprec/impl/solver/amg_s_jac_solver_bld.f90 +++ b/amgprec/impl/solver/amg_s_jac_solver_bld.f90 @@ -100,11 +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 - if (allocated(sv%dv)) then - call sv%dv%free(info) - deallocate(sv%dv) - end if - 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 ad82fb3b..46f87e0f 100644 --- a/amgprec/impl/solver/amg_s_l1_jac_solver_bld.f90 +++ b/amgprec/impl/solver/amg_s_l1_jac_solver_bld.f90 @@ -103,11 +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 - if (allocated(sv%dv)) then - call sv%dv%free(info) - deallocate(sv%dv) - end if - 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 43d23e41..69e768c2 100644 --- a/amgprec/impl/solver/amg_z_diag_solver_bld.f90 +++ b/amgprec/impl/solver/amg_z_diag_solver_bld.f90 @@ -91,11 +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 - if (allocated(sv%dv)) then - call sv%dv%free(info) - deallocate(sv%dv) - end if - 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) @@ -176,11 +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 - if (allocated(sv%dv)) then - call sv%dv%free(info) - deallocate(sv%dv) - end if - 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 e84a019b..47879f7c 100644 --- a/amgprec/impl/solver/amg_z_jac_solver_bld.f90 +++ b/amgprec/impl/solver/amg_z_jac_solver_bld.f90 @@ -100,11 +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 - if (allocated(sv%dv)) then - call sv%dv%free(info) - deallocate(sv%dv) - end if - 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 391cee83..95104c77 100644 --- a/amgprec/impl/solver/amg_z_l1_jac_solver_bld.f90 +++ b/amgprec/impl/solver/amg_z_l1_jac_solver_bld.f90 @@ -103,11 +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 - if (allocated(sv%dv)) then - call sv%dv%free(info) - deallocate(sv%dv) - end if - 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/cbind/amgprec/amg_dprec_cbind_mod.F90 b/cbind/amgprec/amg_dprec_cbind_mod.F90 index d59a3cbc..c37c8ae3 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,7 +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 @@ -371,7 +381,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 ee672fbc..6efd1697 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 @@ -206,19 +208,24 @@ 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 @@ -243,6 +250,11 @@ 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