Improve CBIND prec

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)

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)

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)

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)

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)

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)

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)

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)

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)

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)

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)

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_

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)

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_

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)

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_

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)

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_

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)

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)

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)

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)

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)

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)

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)

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)

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)

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)

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)

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)

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,&

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