diff --git a/util/psb_metispart_mod.F90 b/util/psb_metispart_mod.F90 index 2e5c3c8b..7657a91a 100644 --- a/util/psb_metispart_mod.F90 +++ b/util/psb_metispart_mod.F90 @@ -65,12 +65,8 @@ module psb_metispart_mod integer(psb_ipk_), allocatable, save :: graph_vect(:) interface build_mtpart - module procedure build_mtpart,& - & d_mat_build_mtpart, s_mat_build_mtpart,& - & z_mat_build_mtpart, c_mat_build_mtpart, & - & d_csr_build_mtpart, s_csr_build_mtpart,& - & z_csr_build_mtpart, c_csr_build_mtpart - + module procedure d_mat_build_mtpart, s_mat_build_mtpart,& + & z_mat_build_mtpart, c_mat_build_mtpart end interface contains @@ -180,9 +176,9 @@ contains end if end if if (allocated(wgh_)) then - call build_mtpart(a%get_nrows(),a%get_fmt(),a%ja,a%irp,nparts,wgh_) + call inner_build_mtpart(a%get_nrows(),a%ja,a%irp,nparts,wgh_) else - call build_mtpart(a%get_nrows(),a%get_fmt(),a%ja,a%irp,nparts) + call inner_build_mtpart(a%get_nrows(),a%ja,a%irp,nparts) end if end subroutine d_csr_build_mtpart @@ -219,9 +215,9 @@ contains end if end if if (allocated(wgh_)) then - call build_mtpart(a%get_nrows(),a%get_fmt(),a%ja,a%irp,nparts,wgh_) + call inner_build_mtpart(a%get_nrows(),a%ja,a%irp,nparts,wgh_) else - call build_mtpart(a%get_nrows(),a%get_fmt(),a%ja,a%irp,nparts) + call inner_build_mtpart(a%get_nrows(),a%ja,a%irp,nparts) end if end subroutine z_csr_build_mtpart @@ -268,7 +264,7 @@ contains real(psb_spk_), optional :: weights(:) - call build_mtpart(a%get_nrows(),a%get_fmt(),a%ja,a%irp,nparts,weights) + call inner_build_mtpart(a%get_nrows(),a%ja,a%irp,nparts,weights) end subroutine c_csr_build_mtpart @@ -280,21 +276,20 @@ contains real(psb_spk_), optional :: weights(:) - call build_mtpart(a%get_nrows(),a%get_fmt(),a%ja,a%irp,nparts,weights) + call inner_build_mtpart(a%get_nrows(),a%ja,a%irp,nparts,weights) end subroutine s_csr_build_mtpart - subroutine build_mtpart(n,fida,ja,irp,nparts,weights) + subroutine inner_build_mtpart(n,ja,irp,nparts,weights) use psb_base_mod + use iso_c_binding implicit none - integer(psb_ipk_) :: nparts - integer(psb_ipk_) :: ja(:), irp(:) + integer(psb_ipk_), intent(in) :: nparts + integer(psb_ipk_), intent(in) :: ja(:), irp(:) + real(psb_spk_),optional, intent(in) :: weights(:) + ! local variables integer(psb_ipk_) :: n, i,numflag,nedc,wgflag - character(len=5) :: fida - integer(psb_ipk_), parameter :: nb=512 - real(psb_dpk_), parameter :: seed=12345.d0 integer(psb_ipk_) :: iopt(10),idummy(2),jdummy(2), info - real(psb_spk_),optional :: weights(:) integer(psb_ipk_) :: nl,nptl integer(psb_ipk_), allocatable :: irpl(:),jal(:),gvl(:) real(psb_spk_),allocatable :: wgh_(:) @@ -332,46 +327,40 @@ contains return endif if (nparts > 1) then - if (psb_toupper(fida) == 'CSR') then - iopt(1) = 0 - numflag = 1 - wgflag = 0 + iopt(1) = 0 + numflag = 1 + wgflag = 0 !!$ write(*,*) 'Before allocation',nparts - irpl=irp - jal = ja - nl = n - nptl = nparts - wgh_ = -1.0 - if(present(weights)) then - if (size(weights) == nptl) then + irpl=irp + jal = ja + nl = n + nptl = nparts + wgh_ = -1.0 + if(present(weights)) then + if (size(weights) == nptl) then !!$ write(*,*) 'weights present',weights - ! call METIS_PartGraphKway(n,irp,ja,idummy,jdummy,& - ! & wgflag,numflag,nparts,weights,iopt,nedc,graph_vect) - info = METIS_PartGraphKway(nl,irpl,jal,idummy,jdummy,& - & nptl,weights,gvl) + ! call METIS_PartGraphKway(n,irp,ja,idummy,jdummy,& + ! & wgflag,numflag,nparts,weights,iopt,nedc,graph_vect) + info = METIS_PartGraphKway(nl,irpl,jal,idummy,jdummy,& + & nptl,weights,gvl) - else -!!$ write(*,*) 'weights absent',wgh_ - info = METIS_PartGraphKway(nl,irpl,jal,idummy,jdummy,& - & nptl,wgh_,gvl) - end if else -!!$ write(*,*) 'weights absent',wgh_ +!!$ write(*,*) 'weights absent',wgh_ info = METIS_PartGraphKway(nl,irpl,jal,idummy,jdummy,& & nptl,wgh_,gvl) - endif -!!$ write(*,*) 'after allocation',info - - do i=1, n - graph_vect(i) = gvl(i) - 1 - enddo + end if else - write(psb_err_unit,*) 'Fatal error in BUILD_MTPART: matrix format ',& - & ' failure. ', FIDA - return +!!$ write(*,*) 'weights absent',wgh_ + info = METIS_PartGraphKway(nl,irpl,jal,idummy,jdummy,& + & nptl,wgh_,gvl) endif +!!$ write(*,*) 'after allocation',info + + do i=1, n + graph_vect(i) = gvl(i) - 1 + enddo else do i=1, n graph_vect(i) = 0 @@ -383,7 +372,7 @@ contains return - end subroutine build_mtpart + end subroutine inner_build_mtpart ! ! WARNING: called IRET otherwise Intel compiler complains,