base/serial/impl/psb_c_base_mat_impl.f90
 base/serial/impl/psb_z_base_mat_impl.f90
 base/tools/psb_cdall.f90

Silly bug for transc.
psblas3-type-indexed
Salvatore Filippone 13 years ago
parent afa7aafb52
commit 56fea05537

@ -514,7 +514,35 @@ subroutine psb_c_base_transc_2mat(a,b)
class(psb_c_base_sparse_mat), intent(out) :: a class(psb_c_base_sparse_mat), intent(out) :: a
class(psb_base_sparse_mat), intent(in) :: b 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 end subroutine psb_c_base_transc_2mat
subroutine psb_c_base_transp_1mat(a) subroutine psb_c_base_transp_1mat(a)
@ -556,8 +584,31 @@ subroutine psb_c_base_transc_1mat(a)
implicit none implicit none
class(psb_c_base_sparse_mat), intent(inout) :: a 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 end subroutine psb_c_base_transc_1mat

@ -514,8 +514,35 @@ subroutine psb_z_base_transc_2mat(a,b)
class(psb_z_base_sparse_mat), intent(out) :: a class(psb_z_base_sparse_mat), intent(out) :: a
class(psb_base_sparse_mat), intent(in) :: b 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 end subroutine psb_z_base_transc_2mat
subroutine psb_z_base_transp_1mat(a) subroutine psb_z_base_transp_1mat(a)
@ -557,8 +584,31 @@ subroutine psb_z_base_transc_1mat(a)
implicit none implicit none
class(psb_z_base_sparse_mat), intent(inout) :: a 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 end subroutine psb_z_base_transc_1mat

@ -128,14 +128,6 @@ subroutine psb_cdall(ictxt, desc, info,mg,ng,parts,vg,vl,flag,nl,repl, globalche
else if (present(nl)) then 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 if (np == 1) then
allocate(psb_repl_map :: desc%indxmap, stat=info) allocate(psb_repl_map :: desc%indxmap, stat=info)

Loading…
Cancel
Save