diff --git a/base/modules/psb_c_base_mat_mod.f90 b/base/modules/psb_c_base_mat_mod.f90 index 73486b1f..8dbbbb4b 100644 --- a/base/modules/psb_c_base_mat_mod.f90 +++ b/base/modules/psb_c_base_mat_mod.f90 @@ -432,8 +432,8 @@ module psb_c_base_mat_mod subroutine psb_c_base_clone(a,b, info) import :: psb_ipk_, psb_c_base_sparse_mat, psb_long_int_k_ implicit none - class(psb_c_base_sparse_mat), intent(inout) :: a - class(psb_c_base_sparse_mat), allocatable, intent(out) :: b + class(psb_c_base_sparse_mat), intent(inout) :: a + class(psb_c_base_sparse_mat), allocatable, intent(inout) :: b integer(psb_ipk_), intent(out) :: info end subroutine psb_c_base_clone end interface @@ -1585,8 +1585,6 @@ module psb_c_base_mat_mod contains - - subroutine c_base_mv_from(a,b) implicit none diff --git a/base/modules/psb_d_base_mat_mod.f90 b/base/modules/psb_d_base_mat_mod.f90 index d2530c4b..d29288a8 100644 --- a/base/modules/psb_d_base_mat_mod.f90 +++ b/base/modules/psb_d_base_mat_mod.f90 @@ -432,8 +432,8 @@ module psb_d_base_mat_mod subroutine psb_d_base_clone(a,b, info) import :: psb_ipk_, psb_d_base_sparse_mat, psb_long_int_k_ implicit none - class(psb_d_base_sparse_mat), intent(inout) :: a - class(psb_d_base_sparse_mat), allocatable, intent(out) :: b + class(psb_d_base_sparse_mat), intent(inout) :: a + class(psb_d_base_sparse_mat), allocatable, intent(inout) :: b integer(psb_ipk_), intent(out) :: info end subroutine psb_d_base_clone end interface @@ -1585,8 +1585,6 @@ module psb_d_base_mat_mod contains - - subroutine d_base_mv_from(a,b) implicit none diff --git a/base/modules/psb_desc_mod.f90 b/base/modules/psb_desc_mod.f90 index 134cd87c..5c59b708 100644 --- a/base/modules/psb_desc_mod.f90 +++ b/base/modules/psb_desc_mod.f90 @@ -908,9 +908,9 @@ contains implicit none !....parameters... - class(psb_desc_type), intent(inout), target :: desc - class(psb_desc_type), intent(out) :: desc_out - integer(psb_ipk_), intent(out) :: info + class(psb_desc_type), intent(inout), target :: desc + class(psb_desc_type), intent(inout) :: desc_out + integer(psb_ipk_), intent(out) :: info !locals integer(psb_ipk_) :: np,me,ictxt, err_act integer(psb_ipk_) :: debug_level, debug_unit @@ -924,31 +924,42 @@ contains call psb_erractionsave(err_act) name = 'psb_cdcpy' - ictxt = desc%get_context() + if (desc%is_valid()) then + ictxt = desc%get_context() - ! check on blacs grid - call psb_info(ictxt, me, np) - if (debug_level >= psb_debug_ext_) & - & write(debug_unit,*) me,' ',trim(name),': Entered' - if (np == -1) then - info = psb_err_context_error_ - call psb_errpush(info,name) - goto 9999 - endif + ! check on blacs grid + call psb_info(ictxt, me, np) + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),': Entered' + if (np == -1) then + info = psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif - desc_out%base_desc => desc%base_desc - if (info == psb_success_) call psb_safe_ab_cpy(desc%halo_index,desc_out%halo_index,info) - if (info == psb_success_) call psb_safe_ab_cpy(desc%ext_index,desc_out%ext_index,info) - if (info == psb_success_) call psb_safe_ab_cpy(desc%ovrlap_index,& - & desc_out%ovrlap_index,info) - if (info == psb_success_) call psb_safe_ab_cpy(desc%bnd_elem,desc_out%bnd_elem,info) - if (info == psb_success_) call psb_safe_ab_cpy(desc%ovrlap_elem,desc_out%ovrlap_elem,info) - if (info == psb_success_) call psb_safe_ab_cpy(desc%ovr_mst_idx,desc_out%ovr_mst_idx,info) - if (info == psb_success_) call psb_safe_ab_cpy(desc%lprm,desc_out%lprm,info) - if (info == psb_success_) call psb_safe_ab_cpy(desc%idx_space,desc_out%idx_space,info) - - if ((info == psb_success_).and.(allocated(desc%indxmap))) & - & call desc%indxmap%clone(desc_out%indxmap,info) + desc_out%base_desc => desc%base_desc + if (info == psb_success_)& + & call psb_safe_ab_cpy(desc%halo_index,desc_out%halo_index,info) + if (info == psb_success_)& + & call psb_safe_ab_cpy(desc%ext_index,desc_out%ext_index,info) + if (info == psb_success_)& + & call psb_safe_ab_cpy(desc%ovrlap_index,& + & desc_out%ovrlap_index,info) + if (info == psb_success_)& + & call psb_safe_ab_cpy(desc%bnd_elem,desc_out%bnd_elem,info) + if (info == psb_success_)& + & call psb_safe_ab_cpy(desc%ovrlap_elem,desc_out%ovrlap_elem,info) + if (info == psb_success_)& + & call psb_safe_ab_cpy(desc%ovr_mst_idx,desc_out%ovr_mst_idx,info) + if (info == psb_success_)& + & call psb_safe_ab_cpy(desc%lprm,desc_out%lprm,info) + if (info == psb_success_)& + & call psb_safe_ab_cpy(desc%idx_space,desc_out%idx_space,info) + if ((info == psb_success_).and.(allocated(desc%indxmap))) & + & call desc%indxmap%clone(desc_out%indxmap,info) + else + call desc_out%free(info) + end if if (info /= psb_success_) then info = psb_err_from_subroutine_ call psb_errpush(info,name) diff --git a/base/modules/psb_s_base_mat_mod.f90 b/base/modules/psb_s_base_mat_mod.f90 index 625d20e4..5b8e7b84 100644 --- a/base/modules/psb_s_base_mat_mod.f90 +++ b/base/modules/psb_s_base_mat_mod.f90 @@ -432,8 +432,8 @@ module psb_s_base_mat_mod subroutine psb_s_base_clone(a,b, info) import :: psb_ipk_, psb_s_base_sparse_mat, psb_long_int_k_ implicit none - class(psb_s_base_sparse_mat), intent(inout) :: a - class(psb_s_base_sparse_mat), allocatable, intent(out) :: b + class(psb_s_base_sparse_mat), intent(inout) :: a + class(psb_s_base_sparse_mat), allocatable, intent(inout) :: b integer(psb_ipk_), intent(out) :: info end subroutine psb_s_base_clone end interface @@ -1585,8 +1585,6 @@ module psb_s_base_mat_mod contains - - subroutine s_base_mv_from(a,b) implicit none diff --git a/base/modules/psb_z_base_mat_mod.f90 b/base/modules/psb_z_base_mat_mod.f90 index 3396675e..49b6c920 100644 --- a/base/modules/psb_z_base_mat_mod.f90 +++ b/base/modules/psb_z_base_mat_mod.f90 @@ -432,8 +432,8 @@ module psb_z_base_mat_mod subroutine psb_z_base_clone(a,b, info) import :: psb_ipk_, psb_z_base_sparse_mat, psb_long_int_k_ implicit none - class(psb_z_base_sparse_mat), intent(inout) :: a - class(psb_z_base_sparse_mat), allocatable, intent(out) :: b + class(psb_z_base_sparse_mat), intent(inout) :: a + class(psb_z_base_sparse_mat), allocatable, intent(inout) :: b integer(psb_ipk_), intent(out) :: info end subroutine psb_z_base_clone end interface @@ -1585,8 +1585,6 @@ module psb_z_base_mat_mod contains - - subroutine z_base_mv_from(a,b) implicit none diff --git a/base/serial/impl/psb_c_base_mat_impl.F90 b/base/serial/impl/psb_c_base_mat_impl.F90 index 1aec65f6..3e56ed01 100644 --- a/base/serial/impl/psb_c_base_mat_impl.F90 +++ b/base/serial/impl/psb_c_base_mat_impl.F90 @@ -555,10 +555,21 @@ subroutine psb_c_base_clone(a,b,info) use psb_error_mod implicit none - class(psb_c_base_sparse_mat), intent(inout) :: a - class(psb_c_base_sparse_mat), allocatable, intent(out) :: b + class(psb_c_base_sparse_mat), intent(inout) :: a + class(psb_c_base_sparse_mat), allocatable, intent(inout) :: b integer(psb_ipk_), intent(out) :: info + if (allocated(b)) then + call b%free() + deallocate(b, stat=info) + end if + if (info /= 0) then + info = psb_err_alloc_dealloc_ + return + end if + + ! Do not use SOURCE allocation: this makes sure that + ! memory allocated elsewhere is treated properly. #if defined(HAVE_MOLD) allocate(b,mold=a,stat=info) if (info /= psb_success_) info = psb_err_alloc_dealloc_ diff --git a/base/serial/impl/psb_d_base_mat_impl.F90 b/base/serial/impl/psb_d_base_mat_impl.F90 index d10212a2..cccf18af 100644 --- a/base/serial/impl/psb_d_base_mat_impl.F90 +++ b/base/serial/impl/psb_d_base_mat_impl.F90 @@ -555,10 +555,21 @@ subroutine psb_d_base_clone(a,b,info) use psb_error_mod implicit none - class(psb_d_base_sparse_mat), intent(inout) :: a - class(psb_d_base_sparse_mat), allocatable, intent(out) :: b + class(psb_d_base_sparse_mat), intent(inout) :: a + class(psb_d_base_sparse_mat), allocatable, intent(inout) :: b integer(psb_ipk_), intent(out) :: info + if (allocated(b)) then + call b%free() + deallocate(b, stat=info) + end if + if (info /= 0) then + info = psb_err_alloc_dealloc_ + return + end if + + ! Do not use SOURCE allocation: this makes sure that + ! memory allocated elsewhere is treated properly. #if defined(HAVE_MOLD) allocate(b,mold=a,stat=info) if (info /= psb_success_) info = psb_err_alloc_dealloc_ diff --git a/base/serial/impl/psb_s_base_mat_impl.F90 b/base/serial/impl/psb_s_base_mat_impl.F90 index aa301d63..427cb29c 100644 --- a/base/serial/impl/psb_s_base_mat_impl.F90 +++ b/base/serial/impl/psb_s_base_mat_impl.F90 @@ -555,10 +555,21 @@ subroutine psb_s_base_clone(a,b,info) use psb_error_mod implicit none - class(psb_s_base_sparse_mat), intent(inout) :: a - class(psb_s_base_sparse_mat), allocatable, intent(out) :: b + class(psb_s_base_sparse_mat), intent(inout) :: a + class(psb_s_base_sparse_mat), allocatable, intent(inout) :: b integer(psb_ipk_), intent(out) :: info + if (allocated(b)) then + call b%free() + deallocate(b, stat=info) + end if + if (info /= 0) then + info = psb_err_alloc_dealloc_ + return + end if + + ! Do not use SOURCE allocation: this makes sure that + ! memory allocated elsewhere is treated properly. #if defined(HAVE_MOLD) allocate(b,mold=a,stat=info) if (info /= psb_success_) info = psb_err_alloc_dealloc_ diff --git a/base/serial/impl/psb_z_base_mat_impl.F90 b/base/serial/impl/psb_z_base_mat_impl.F90 index d0970056..63b77d7c 100644 --- a/base/serial/impl/psb_z_base_mat_impl.F90 +++ b/base/serial/impl/psb_z_base_mat_impl.F90 @@ -555,10 +555,21 @@ subroutine psb_z_base_clone(a,b,info) use psb_error_mod implicit none - class(psb_z_base_sparse_mat), intent(inout) :: a - class(psb_z_base_sparse_mat), allocatable, intent(out) :: b + class(psb_z_base_sparse_mat), intent(inout) :: a + class(psb_z_base_sparse_mat), allocatable, intent(inout) :: b integer(psb_ipk_), intent(out) :: info + if (allocated(b)) then + call b%free() + deallocate(b, stat=info) + end if + if (info /= 0) then + info = psb_err_alloc_dealloc_ + return + end if + + ! Do not use SOURCE allocation: this makes sure that + ! memory allocated elsewhere is treated properly. #if defined(HAVE_MOLD) allocate(b,mold=a,stat=info) if (info /= psb_success_) info = psb_err_alloc_dealloc_