diff --git a/util/psb_metispart_mod.F90 b/util/psb_metispart_mod.F90 index 1bb8a08c..2e5c3c8b 100644 --- a/util/psb_metispart_mod.F90 +++ b/util/psb_metispart_mod.F90 @@ -154,27 +154,38 @@ contains type(psb_dspmat_type), intent(in) :: a integer(psb_ipk_) :: nparts real(psb_dpk_), optional :: weights(:) - real(psb_spk_), allocatable :: wgh_(:) select type (aa=>a%a) type is (psb_d_csr_sparse_mat) - if (present(weights)) then - if (size(weights)==nparts) then - wgh_ = weights - end if - end if - if (allocated(wgh_)) then - call build_mtpart(aa%get_nrows(),aa%get_fmt(),aa%ja,aa%irp,nparts,wgh_) - else - call build_mtpart(aa%get_nrows(),aa%get_fmt(),aa%ja,aa%irp,nparts) - end if + call d_csr_build_mtpart(aa,nparts,weights) class default write(psb_err_unit,*) 'Sorry, right now we only take CSR input!' end select end subroutine d_mat_build_mtpart + + subroutine d_csr_build_mtpart(a,nparts,weights) + use psb_base_mod + implicit none + type(psb_d_csr_sparse_mat), intent(in) :: a + integer(psb_ipk_) :: nparts + real(psb_dpk_), optional :: weights(:) + real(psb_spk_), allocatable :: wgh_(:) + + + if (present(weights)) then + if (size(weights)==nparts) then + wgh_ = weights + end if + end if + if (allocated(wgh_)) then + call build_mtpart(a%get_nrows(),a%get_fmt(),a%ja,a%irp,nparts,wgh_) + else + call build_mtpart(a%get_nrows(),a%get_fmt(),a%ja,a%irp,nparts) + end if + end subroutine d_csr_build_mtpart subroutine z_mat_build_mtpart(a,nparts,weights) use psb_base_mod @@ -182,27 +193,38 @@ contains type(psb_zspmat_type), intent(in) :: a integer(psb_ipk_) :: nparts real(psb_dpk_), optional :: weights(:) - real(psb_spk_), allocatable :: wgh_(:) select type (aa=>a%a) type is (psb_z_csr_sparse_mat) - if (present(weights)) then - if (size(weights)==nparts) then - wgh_ = weights - end if - end if - if (allocated(wgh_)) then - call build_mtpart(aa%get_nrows(),aa%get_fmt(),aa%ja,aa%irp,nparts,wgh_) - else - call build_mtpart(aa%get_nrows(),aa%get_fmt(),aa%ja,aa%irp,nparts) - end if + call z_csr_build_mtpart(aa,nparts,weights) class default write(psb_err_unit,*) 'Sorry, right now we only take CSR input!' end select end subroutine z_mat_build_mtpart + subroutine z_csr_build_mtpart(a,nparts,weights) + use psb_base_mod + implicit none + type(psb_z_csr_sparse_mat), intent(in) :: a + integer(psb_ipk_) :: nparts + real(psb_dpk_), optional :: weights(:) + real(psb_spk_), allocatable :: wgh_(:) + + + if (present(weights)) then + if (size(weights)==nparts) then + wgh_ = weights + end if + end if + if (allocated(wgh_)) then + call build_mtpart(a%get_nrows(),a%get_fmt(),a%ja,a%irp,nparts,wgh_) + else + call build_mtpart(a%get_nrows(),a%get_fmt(),a%ja,a%irp,nparts) + end if + + end subroutine z_csr_build_mtpart subroutine s_mat_build_mtpart(a,nparts,weights) use psb_base_mod @@ -214,14 +236,13 @@ contains select type (aa=>a%a) type is (psb_s_csr_sparse_mat) - call build_mtpart(aa%get_nrows(),aa%get_fmt(),aa%ja,aa%irp,nparts,weights) + call s_csr_build_mtpart(aa,nparts,weights) class default write(psb_err_unit,*) 'Sorry, right now we only take CSR input!' end select end subroutine s_mat_build_mtpart - subroutine c_mat_build_mtpart(a,nparts,weights) use psb_base_mod implicit none @@ -232,58 +253,24 @@ contains select type (aa=>a%a) type is (psb_c_csr_sparse_mat) - call build_mtpart(aa%get_nrows(),aa%get_fmt(),aa%ja,aa%irp,nparts,weights) + call c_csr_build_mtpart(aa,nparts,weights) class default write(psb_err_unit,*) 'Sorry, right now we only take CSR input!' end select end subroutine c_mat_build_mtpart - - subroutine d_csr_build_mtpart(a,nparts,weights) - use psb_base_mod - implicit none - type(psb_d_csr_sparse_mat), intent(in) :: a - integer(psb_ipk_) :: nparts - real(psb_dpk_), optional :: weights(:) - real(psb_spk_), allocatable :: wgh_(:) - - - if (present(weights)) then - if (size(weights)==nparts) then - wgh_ = weights - end if - end if - if (allocated(wgh_)) then - call build_mtpart(a%get_nrows(),a%get_fmt(),a%ja,a%irp,nparts,wgh_) - else - call build_mtpart(a%get_nrows(),a%get_fmt(),a%ja,a%irp,nparts) - end if - - end subroutine d_csr_build_mtpart - - subroutine z_csr_build_mtpart(a,nparts,weights) + subroutine c_csr_build_mtpart(a,nparts,weights) use psb_base_mod implicit none - type(psb_z_csr_sparse_mat), intent(in) :: a + type(psb_c_csr_sparse_mat), intent(in) :: a integer(psb_ipk_) :: nparts - real(psb_dpk_), optional :: weights(:) - real(psb_spk_), allocatable :: wgh_(:) + real(psb_spk_), optional :: weights(:) + + call build_mtpart(a%get_nrows(),a%get_fmt(),a%ja,a%irp,nparts,weights) - if (present(weights)) then - if (size(weights)==nparts) then - wgh_ = weights - end if - end if - if (allocated(wgh_)) then - call build_mtpart(a%get_nrows(),a%get_fmt(),a%ja,a%irp,nparts,wgh_) - else - call build_mtpart(a%get_nrows(),a%get_fmt(),a%ja,a%irp,nparts) - end if - - end subroutine z_csr_build_mtpart - + end subroutine c_csr_build_mtpart subroutine s_csr_build_mtpart(a,nparts,weights) use psb_base_mod @@ -297,21 +284,6 @@ contains end subroutine s_csr_build_mtpart - - subroutine c_csr_build_mtpart(a,nparts,weights) - use psb_base_mod - implicit none - type(psb_c_csr_sparse_mat), intent(in) :: a - integer(psb_ipk_) :: nparts - real(psb_spk_), optional :: weights(:) - - - call build_mtpart(a%get_nrows(),a%get_fmt(),a%ja,a%irp,nparts,weights) - - end subroutine c_csr_build_mtpart - - - subroutine build_mtpart(n,fida,ja,irp,nparts,weights) use psb_base_mod implicit none