Fix (de)allocate prec and smoothers_free

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)