diff --git a/base/serial/impl/psb_c_base_mat_impl.f90 b/base/serial/impl/psb_c_base_mat_impl.f90 index f70adb1c..64545a65 100644 --- a/base/serial/impl/psb_c_base_mat_impl.f90 +++ b/base/serial/impl/psb_c_base_mat_impl.f90 @@ -514,7 +514,35 @@ subroutine psb_c_base_transc_2mat(a,b) class(psb_c_base_sparse_mat), intent(out) :: a class(psb_base_sparse_mat), intent(in) :: b - call a%transc(b) + type(psb_c_coo_sparse_mat) :: tmp + integer err_act, info + character(len=*), parameter :: name='c_base_transc' + + call psb_erractionsave(err_act) + + info = psb_success_ + select type(b) + class is (psb_c_base_sparse_mat) + call b%cp_to_coo(tmp,info) + if (info == psb_success_) call tmp%transc() + if (info == psb_success_) call a%mv_from_coo(tmp,info) + class default + info = psb_err_invalid_dynamic_type_ + end select + if (info /= psb_success_) then + call psb_errpush(info,name,a_err=b%get_fmt(),i_err=(/1,0,0,0,0/)) + goto 9999 + end if + call psb_erractionrestore(err_act) + + return +9999 continue + if (err_act /= psb_act_ret_) then + call psb_error() + end if + + return + end subroutine psb_c_base_transc_2mat subroutine psb_c_base_transp_1mat(a) @@ -556,8 +584,31 @@ subroutine psb_c_base_transc_1mat(a) implicit none class(psb_c_base_sparse_mat), intent(inout) :: a + type(psb_c_coo_sparse_mat) :: tmp + integer :: err_act, info + character(len=*), parameter :: name='c_base_transc' + + call psb_erractionsave(err_act) + info = psb_success_ + call a%mv_to_coo(tmp,info) + if (info == psb_success_) call tmp%transc() + if (info == psb_success_) call a%mv_from_coo(tmp,info) + + if (info /= psb_success_) then + info = psb_err_missing_override_method_ + call psb_errpush(info,name,a_err=a%get_fmt()) + goto 9999 + end if + call psb_erractionrestore(err_act) + + return +9999 continue + if (err_act /= psb_act_ret_) then + call psb_error() + end if + + return - call a%transc() end subroutine psb_c_base_transc_1mat diff --git a/base/serial/impl/psb_z_base_mat_impl.f90 b/base/serial/impl/psb_z_base_mat_impl.f90 index a783fd7e..822de2b5 100644 --- a/base/serial/impl/psb_z_base_mat_impl.f90 +++ b/base/serial/impl/psb_z_base_mat_impl.f90 @@ -514,8 +514,35 @@ subroutine psb_z_base_transc_2mat(a,b) class(psb_z_base_sparse_mat), intent(out) :: a class(psb_base_sparse_mat), intent(in) :: b + type(psb_z_coo_sparse_mat) :: tmp + integer err_act, info + character(len=*), parameter :: name='z_base_transc' + + call psb_erractionsave(err_act) + + info = psb_success_ + select type(b) + class is (psb_z_base_sparse_mat) + call b%cp_to_coo(tmp,info) + if (info == psb_success_) call tmp%transc() + if (info == psb_success_) call a%mv_from_coo(tmp,info) + class default + info = psb_err_invalid_dynamic_type_ + end select + if (info /= psb_success_) then + call psb_errpush(info,name,a_err=b%get_fmt(),i_err=(/1,0,0,0,0/)) + goto 9999 + end if + call psb_erractionrestore(err_act) + + return +9999 continue + if (err_act /= psb_act_ret_) then + call psb_error() + end if + + return - call a%transc(b) end subroutine psb_z_base_transc_2mat subroutine psb_z_base_transp_1mat(a) @@ -557,8 +584,31 @@ subroutine psb_z_base_transc_1mat(a) implicit none class(psb_z_base_sparse_mat), intent(inout) :: a + type(psb_z_coo_sparse_mat) :: tmp + integer :: err_act, info + character(len=*), parameter :: name='z_base_transc' + + call psb_erractionsave(err_act) + info = psb_success_ + call a%mv_to_coo(tmp,info) + if (info == psb_success_) call tmp%transc() + if (info == psb_success_) call a%mv_from_coo(tmp,info) + + if (info /= psb_success_) then + info = psb_err_missing_override_method_ + call psb_errpush(info,name,a_err=a%get_fmt()) + goto 9999 + end if + call psb_erractionrestore(err_act) + + return +9999 continue + if (err_act /= psb_act_ret_) then + call psb_error() + end if + + return - call a%transc() end subroutine psb_z_base_transc_1mat diff --git a/base/tools/psb_cdall.f90 b/base/tools/psb_cdall.f90 index d6cdbe9f..5abe3912 100644 --- a/base/tools/psb_cdall.f90 +++ b/base/tools/psb_cdall.f90 @@ -128,14 +128,6 @@ subroutine psb_cdall(ictxt, desc, info,mg,ng,parts,vg,vl,flag,nl,repl, globalche else if (present(nl)) then -!!$ allocate(desc%matrix_data(psb_mdata_size_)) -!!$ desc%matrix_data(psb_m_) = nl -!!$ call psb_sum(ictxt,desc%matrix_data(psb_m_)) -!!$ desc%matrix_data(psb_n_) = desc%matrix_data(psb_m_) -!!$ desc%matrix_data(psb_ctxt_) = ictxt -!!$ call psb_get_mpicomm(ictxt,desc%matrix_data(psb_mpi_c_)) - - if (np == 1) then allocate(psb_repl_map :: desc%indxmap, stat=info)