fdurastante
/
psblas3
mirror of https://github.com/sfilippone/psblas3.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Fix METISPART for Intel 17.

Browse Source
scr-persistent-collective
Salvatore Filippone 6 years ago
parent e828a2a45a
commit c465f255c2
1 changed files with 52 additions and 80 deletions
Show Stats Download Patch File Download Diff File

132
util/psb_metispart_mod.F90
Unescape Escape View File

@ -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

Write Preview
Loading…
Cancel
Save