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

Reworked interface METISPART: use LPK matrix input.

Browse Source
mat-allocate
Salvatore Filippone 4 years ago
parent f268a411e8
commit 39d6bf01e0
8 changed files with 174 additions and 125 deletions
Show Stats Download Patch File Download Diff File

11
test/fileread/psb_cf_sample.f90
Unescape Escape View File

@ -38,10 +38,11 @@ program psb_cf_sample
implicit none
! input parameters
character(len=40) :: kmethd, ptype, mtrx_file, rhs_file,renum
character(len=40) :: kmethd, ptype, mtrx_file, rhs_file
! sparse matrices
type(psb_cspmat_type) :: a, aux_a
type(psb_cspmat_type) :: a
type(psb_lcspmat_type) :: aux_a
! preconditioner data
type(psb_cprec_type) :: prec
@ -56,6 +57,7 @@ program psb_cf_sample
type(psb_desc_type):: desc_a
integer(psb_ipk_) :: ictxt, iam, np
integer(psb_lpk_) :: lnp
! solver paramters
integer(psb_ipk_) :: iter, itmax, ierr, itrace, ircode,&
@ -140,7 +142,6 @@ program psb_cf_sample
m_problem = aux_a%get_nrows()
call psb_bcast(ictxt,m_problem)
call psb_mat_renum(psb_mat_renum_identity_,aux_a,info,perm)
! At this point aux_b may still be unallocated
if (size(aux_b,dim=1) == m_problem) then
@ -180,7 +181,9 @@ program psb_cf_sample
write(psb_out_unit,'("Partition type: graph vector")')
write(psb_out_unit,'(" ")')
! write(psb_err_unit,'("Build type: graph")')
call build_mtpart(aux_a,np)
call aux_a%cscnv(info,type='csr')
lnp = np
call build_mtpart(aux_a,lnp)
endif
call psb_barrier(ictxt)

11
test/fileread/psb_df_sample.f90
Unescape Escape View File

@ -38,10 +38,11 @@ program psb_df_sample
implicit none
! input parameters
character(len=40) :: kmethd, ptype, mtrx_file, rhs_file,renum
character(len=40) :: kmethd, ptype, mtrx_file, rhs_file
! sparse matrices
type(psb_dspmat_type) :: a, aux_a
type(psb_dspmat_type) :: a
type(psb_ldspmat_type) :: aux_a
! preconditioner data
type(psb_dprec_type) :: prec
@ -56,6 +57,7 @@ program psb_df_sample
type(psb_desc_type):: desc_a
integer(psb_ipk_) :: ictxt, iam, np
integer(psb_lpk_) :: lnp
! solver paramters
integer(psb_ipk_) :: iter, itmax, ierr, itrace, ircode,&
@ -140,7 +142,6 @@ program psb_df_sample
m_problem = aux_a%get_nrows()
call psb_bcast(ictxt,m_problem)
call psb_mat_renum(psb_mat_renum_identity_,aux_a,info,perm)
! At this point aux_b may still be unallocated
if (size(aux_b,dim=1) == m_problem) then
@ -180,7 +181,9 @@ program psb_df_sample
write(psb_out_unit,'("Partition type: graph vector")')
write(psb_out_unit,'(" ")')
! write(psb_err_unit,'("Build type: graph")')
call build_mtpart(aux_a,np)
call aux_a%cscnv(info,type='csr')
lnp = np
call build_mtpart(aux_a,lnp)
endif
call psb_barrier(ictxt)

11
test/fileread/psb_sf_sample.f90
Unescape Escape View File

@ -38,10 +38,11 @@ program psb_sf_sample
implicit none
! input parameters
character(len=40) :: kmethd, ptype, mtrx_file, rhs_file,renum
character(len=40) :: kmethd, ptype, mtrx_file, rhs_file
! sparse matrices
type(psb_sspmat_type) :: a, aux_a
type(psb_sspmat_type) :: a
type(psb_lsspmat_type) :: aux_a
! preconditioner data
type(psb_sprec_type) :: prec
@ -56,6 +57,7 @@ program psb_sf_sample
type(psb_desc_type):: desc_a
integer(psb_ipk_) :: ictxt, iam, np
integer(psb_lpk_) :: lnp
! solver paramters
integer(psb_ipk_) :: iter, itmax, ierr, itrace, ircode,&
@ -140,7 +142,6 @@ program psb_sf_sample
m_problem = aux_a%get_nrows()
call psb_bcast(ictxt,m_problem)
call psb_mat_renum(psb_mat_renum_identity_,aux_a,info,perm)
! At this point aux_b may still be unallocated
if (size(aux_b,dim=1) == m_problem) then
@ -180,7 +181,9 @@ program psb_sf_sample
write(psb_out_unit,'("Partition type: graph vector")')
write(psb_out_unit,'(" ")')
! write(psb_err_unit,'("Build type: graph")')
call build_mtpart(aux_a,np)
call aux_a%cscnv(info,type='csr')
lnp = np
call build_mtpart(aux_a,lnp)
endif
call psb_barrier(ictxt)

11
test/fileread/psb_zf_sample.f90
Unescape Escape View File

@ -38,10 +38,11 @@ program psb_zf_sample
implicit none
! input parameters
character(len=40) :: kmethd, ptype, mtrx_file, rhs_file,renum
character(len=40) :: kmethd, ptype, mtrx_file, rhs_file
! sparse matrices
type(psb_zspmat_type) :: a, aux_a
type(psb_zspmat_type) :: a
type(psb_lzspmat_type) :: aux_a
! preconditioner data
type(psb_zprec_type) :: prec
@ -56,6 +57,7 @@ program psb_zf_sample
type(psb_desc_type):: desc_a
integer(psb_ipk_) :: ictxt, iam, np
integer(psb_lpk_) :: lnp
! solver paramters
integer(psb_ipk_) :: iter, itmax, ierr, itrace, ircode,&
@ -140,7 +142,6 @@ program psb_zf_sample
m_problem = aux_a%get_nrows()
call psb_bcast(ictxt,m_problem)
call psb_mat_renum(psb_mat_renum_identity_,aux_a,info,perm)
! At this point aux_b may still be unallocated
if (size(aux_b,dim=1) == m_problem) then
@ -180,7 +181,9 @@ program psb_zf_sample
write(psb_out_unit,'("Partition type: graph vector")')
write(psb_out_unit,'(" ")')
! write(psb_err_unit,'("Build type: graph")')
call build_mtpart(aux_a,np)
call aux_a%cscnv(info,type='csr')
lnp = np
call build_mtpart(aux_a,lnp)
endif
call psb_barrier(ictxt)

2
util/Makefile
Unescape Escape View File

@ -38,7 +38,7 @@ $(HERE)/$(LIBNAME): $(OBJS)
$(OBJS): $(MODDIR)/$(BASEMODNAME)$(.mod)
psb_util_mod.o: $(BASEOBJS)
psb_metispart_mod.o: metis_int.o
psb_metispart_mod.o: psb_metis_int.o
psb_mat_dist_mod.o: psb_s_mat_dist_mod.o psb_d_mat_dist_mod.o psb_c_mat_dist_mod.o psb_z_mat_dist_mod.o
$(IMPLOBJS): $(BASEOBJS)

35
util/psb_metis_int.c
Unescape Escape View File

@ -1,31 +1,10 @@
#include <stdio.h>
#if defined(HAVE_METIS_)
#include "metis.h"
#include "psb_metis_int.h"
typedef int32_t psb_m_t;
#if defined(IPK4) && defined(LPK4)
typedef int32_t psb_i_t;
typedef int32_t psb_l_t;
#elif defined(IPK4) && defined(LPK8)
typedef int32_t psb_i_t;
typedef int64_t psb_l_t;
#elif defined(IPK8) && defined(LPK8)
typedef int64_t psb_i_t;
typedef int64_t psb_l_t;
#else
#endif
typedef int64_t psb_e_t;
typedef float psb_s_t;
typedef double psb_d_t;
typedef float complex psb_c_t;
typedef double complex psb_z_t;
int metis_PartGraphKway_C(int *n, int *ixadj, int *iadj, int *ivwg,
int *iajw, int *nparts, float *weights,
int *graphpart)
int metis_PartGraphKway_C(idx_t *n, idx_t *ixadj, idx_t *iadj, idx_t *ivwg,
idx_t *iajw, idx_t *nparts, float *weights,
idx_t *graphpart)
{
int res = -1;
idx_t objval = 0;
@ -58,9 +37,9 @@ int metis_PartGraphKway_C(int *n, int *ixadj, int *iadj, int *ivwg,
#else
int metis_PartGraphKway_C(int *n, int *ixadj, int *iadj, int *ivwg,
int *iajw, int *nparts, float *weights,
int *graphpart)
int metis_PartGraphKway_C(idx_t *n, idx_t *ixadj, idx_t *iadj, idx_t *ivwg,
idx_t *iajw, idx_t *nparts, float *weights,
idx_t *graphpart)
{
return(-1);
}

112
util/psb_metispart_mod.F90
Unescape Escape View File

@ -54,31 +54,32 @@
! uses information prepared by the previous two subroutines.
!
module psb_metispart_mod
use psb_base_mod, only : psb_sspmat_type, psb_cspmat_type,&
& psb_dspmat_type, psb_zspmat_type, psb_err_unit, &
& psb_ipk_, psb_lpk_, psb_mpk_, psb_epk_, psb_spk_,&
& psb_s_csr_sparse_mat, psb_d_csr_sparse_mat, &
& psb_c_csr_sparse_mat, psb_z_csr_sparse_mat
use psb_base_mod, only : psb_ipk_, psb_lpk_, psb_mpk_, psb_epk_, &
& psb_err_unit, psb_spk_,&
& psb_lsspmat_type, psb_lcspmat_type,&
& psb_ldspmat_type, psb_lzspmat_type, &
& psb_ls_csr_sparse_mat, psb_ld_csr_sparse_mat, &
& psb_lc_csr_sparse_mat, psb_lz_csr_sparse_mat
public part_graph, build_mtpart, distr_mtpart,&
& getv_mtpart, free_part
private
integer(psb_ipk_), allocatable, save :: graph_vect(:)
integer(psb_lpk_), allocatable, save :: graph_vect(:)
interface build_mtpart
module procedure d_mat_build_mtpart, s_mat_build_mtpart,&
& z_mat_build_mtpart, c_mat_build_mtpart
module procedure ld_mat_build_mtpart, ls_mat_build_mtpart,&
& lz_mat_build_mtpart, lc_mat_build_mtpart
end interface
interface
subroutine psi_build_mtpart(n,ja,irp,nparts,vect, weights)
import :: psb_ipk_, psb_spk_
interface psi_build_mtpart
subroutine psi_l_build_mtpart(n,ja,irp,nparts,vect, weights)
import :: psb_lpk_, psb_spk_
implicit none
integer(psb_ipk_), intent(in) :: n, nparts
integer(psb_ipk_), intent(in) :: ja(:), irp(:)
integer(psb_ipk_), allocatable, intent(inout) :: vect(:)
integer(psb_lpk_), intent(in) :: n, nparts
integer(psb_lpk_), intent(in) :: ja(:), irp(:)
integer(psb_lpk_), allocatable, intent(inout) :: vect(:)
real(psb_spk_),optional, intent(in) :: weights(:)
end subroutine psi_build_mtpart
end subroutine psi_l_build_mtpart
end interface
contains
@ -156,28 +157,29 @@ contains
end if
end subroutine getv_mtpart
subroutine d_mat_build_mtpart(a,nparts,weights)
subroutine ld_mat_build_mtpart(a,nparts,weights)
use psb_base_mod
implicit none
type(psb_dspmat_type), intent(in) :: a
integer(psb_ipk_) :: nparts
type(psb_ldspmat_type), intent(in) :: a
integer(psb_lpk_) :: nparts
real(psb_dpk_), optional :: weights(:)
select type (aa=>a%a)
type is (psb_d_csr_sparse_mat)
call d_csr_build_mtpart(aa,nparts,weights)
type is (psb_ld_csr_sparse_mat)
call ld_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
end subroutine ld_mat_build_mtpart
subroutine d_csr_build_mtpart(a,nparts,weights)
subroutine ld_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
type(psb_ld_csr_sparse_mat), intent(in) :: a
integer(psb_lpk_) :: nparts
real(psb_dpk_), optional :: weights(:)
real(psb_spk_), allocatable :: wgh_(:)
@ -193,30 +195,30 @@ contains
call psi_build_mtpart(a%get_nrows(),a%ja,a%irp,nparts,graph_vect)
end if
end subroutine d_csr_build_mtpart
end subroutine ld_csr_build_mtpart
subroutine z_mat_build_mtpart(a,nparts,weights)
subroutine lz_mat_build_mtpart(a,nparts,weights)
use psb_base_mod
implicit none
type(psb_zspmat_type), intent(in) :: a
integer(psb_ipk_) :: nparts
type(psb_lzspmat_type), intent(in) :: a
integer(psb_lpk_) :: nparts
real(psb_dpk_), optional :: weights(:)
select type (aa=>a%a)
type is (psb_z_csr_sparse_mat)
call z_csr_build_mtpart(aa,nparts,weights)
type is (psb_lz_csr_sparse_mat)
call lz_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
end subroutine lz_mat_build_mtpart
subroutine z_csr_build_mtpart(a,nparts,weights)
subroutine lz_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
type(psb_lz_csr_sparse_mat), intent(in) :: a
integer(psb_lpk_) :: nparts
real(psb_dpk_), optional :: weights(:)
real(psb_spk_), allocatable :: wgh_(:)
@ -232,65 +234,65 @@ contains
call psi_build_mtpart(a%get_nrows(),a%ja,a%irp,nparts,graph_vect)
end if
end subroutine z_csr_build_mtpart
end subroutine lz_csr_build_mtpart
subroutine s_mat_build_mtpart(a,nparts,weights)
subroutine ls_mat_build_mtpart(a,nparts,weights)
use psb_base_mod
implicit none
type(psb_sspmat_type), intent(in) :: a
integer(psb_ipk_) :: nparts
type(psb_lsspmat_type), intent(in) :: a
integer(psb_lpk_) :: nparts
real(psb_spk_), optional :: weights(:)
select type (aa=>a%a)
type is (psb_s_csr_sparse_mat)
call s_csr_build_mtpart(aa,nparts,weights)
type is (psb_ls_csr_sparse_mat)
call ls_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
end subroutine ls_mat_build_mtpart
subroutine c_mat_build_mtpart(a,nparts,weights)
subroutine lc_mat_build_mtpart(a,nparts,weights)
use psb_base_mod
implicit none
type(psb_cspmat_type), intent(in) :: a
integer(psb_ipk_) :: nparts
type(psb_lcspmat_type), intent(in) :: a
integer(psb_lpk_) :: nparts
real(psb_spk_), optional :: weights(:)
select type (aa=>a%a)
type is (psb_c_csr_sparse_mat)
call c_csr_build_mtpart(aa,nparts,weights)
type is (psb_lc_csr_sparse_mat)
call lc_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
end subroutine lc_mat_build_mtpart
subroutine c_csr_build_mtpart(a,nparts,weights)
subroutine lc_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
type(psb_lc_csr_sparse_mat), intent(in) :: a
integer(psb_lpk_) :: nparts
real(psb_spk_), optional :: weights(:)
call psi_build_mtpart(a%get_nrows(),a%ja,a%irp,nparts,graph_vect,weights)
end subroutine c_csr_build_mtpart
end subroutine lc_csr_build_mtpart
subroutine s_csr_build_mtpart(a,nparts,weights)
subroutine ls_csr_build_mtpart(a,nparts,weights)
use psb_base_mod
implicit none
type(psb_s_csr_sparse_mat), intent(in) :: a
integer(psb_ipk_) :: nparts
type(psb_ls_csr_sparse_mat), intent(in) :: a
integer(psb_lpk_) :: nparts
real(psb_spk_), optional :: weights(:)
call psi_build_mtpart(a%get_nrows(),a%ja,a%irp,nparts,graph_vect,weights)
end subroutine s_csr_build_mtpart
end subroutine ls_csr_build_mtpart
!
! WARNING: called IRET otherwise Intel compiler complains,

100
util/psi_build_mtpart.F90
Unescape Escape View File

@ -1,31 +1,21 @@
subroutine psi_build_mtpart(n,ja,irp,nparts,graph_vect,weights)
subroutine psi_l_build_mtpart(n,ja,irp,nparts,graph_vect,weights)
use psb_base_mod
use iso_c_binding
implicit none
integer(psb_ipk_), intent(in) :: n, nparts
integer(psb_ipk_), intent(in) :: ja(:), irp(:)
integer(psb_ipk_), allocatable, intent(inout) :: graph_vect(:)
integer(psb_lpk_), intent(in) :: n, nparts
integer(psb_lpk_), intent(in) :: ja(:), irp(:)
integer(psb_lpk_), allocatable, intent(inout) :: graph_vect(:)
real(psb_spk_),optional, intent(in) :: weights(:)
! local variables
integer(psb_ipk_) :: i,numflag, nedc,wgflag
integer(psb_ipk_) :: iopt(10),idummy(2),jdummy(2), info
integer(psb_ipk_) :: nl,nptl
integer(psb_ipk_), allocatable :: irpl(:),jal(:),gvl(:)
integer(psb_lpk_) :: i,numflag, nedc,wgflag
integer(psb_lpk_) :: iopt(10),idummy(2),jdummy(2)
integer(psb_ipk_) :: info
integer(psb_lpk_) :: nl,nptl
integer(psb_lpk_), allocatable :: irpl(:),jal(:),gvl(:)
real(psb_spk_),allocatable :: wgh_(:)
#if defined(HAVE_METIS) && defined(IPK4)
#if defined(HAVE_METIS) && defined(LPK4) && defined(METIS_32)
interface
! subroutine METIS_PartGraphKway(n,ixadj,iadj,ivwg,iajw,&
! & wgflag,numflag,nparts,weights,iopt,nedc,part) bind(c)
! use iso_c_binding
! integer(c_int) :: n,wgflag,numflag,nparts,nedc
! integer(c_int) :: ixadj(*),iadj(*),ivwg(*),iajw(*),iopt(*),part(*)
! real(c_float) :: weights(*)
! !integer(psb_ipk_) :: n,wgflag,numflag,nparts,nedc
! !integer(psb_ipk_) :: ixadj(*),iadj(*),ivwg(*),iajw(*),iopt(*),part(*)
! end subroutine METIS_PartGraphKway
function METIS_PartGraphKway(n,ixadj,iadj,ivwg,iajw,&
& nparts,weights,part) bind(c,name="metis_PartGraphKway_C") result(res)
use iso_c_binding
@ -86,10 +76,76 @@ subroutine psi_build_mtpart(n,ja,irp,nparts,graph_vect,weights)
graph_vect(i) = 0
enddo
endif
#elif defined(HAVE_METIS) && defined(LPK8) && defined(METIS_64)
interface
function METIS_PartGraphKway(n,ixadj,iadj,ivwg,iajw,&
& nparts,weights,part) bind(c,name="metis_PartGraphKway_C") result(res)
use iso_c_binding
integer(c_long_long) :: res
integer(c_long_long) :: n,nparts
integer(c_long_long) :: ixadj(*),iadj(*),ivwg(*),iajw(*),part(*)
real(c_float) :: weights(*)
!integer(psb_ipk_) :: n,wgflag,numflag,nparts,nedc
!integer(psb_ipk_) :: ixadj(*),iadj(*),ivwg(*),iajw(*),iopt(*),part(*)
end function METIS_PartGraphKway
end interface
call psb_realloc(n,graph_vect,info)
if (info == psb_success_) allocate(gvl(n),wgh_(nparts),stat=info)
if (info /= psb_success_) then
write(psb_err_unit,*) 'Fatal error in BUILD_MTPART: memory allocation ',&
& ' failure.'
return
endif
if (nparts > 1) then
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
!!$ 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)
else
!!$ write(*,*) 'weights absent',wgh_
info = METIS_PartGraphKway(nl,irpl,jal,idummy,jdummy,&
& nptl,wgh_,gvl)
end if
else
!!$ 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
enddo
endif
#else
write(psb_err_unit,*) 'Warning: METIS was not configured at PSBLAS compile time !'
write(psb_err_unit,*) 'Warning: no suitable METIS interface for LPK indices'
#endif
return
end subroutine psi_build_mtpart
end subroutine psi_l_build_mtpart

Write Preview
Loading…
Cancel
Save