mirror of
https://github.com/sfilippone/psblas3.git
synced 2026-10-16 10:52:08 +00:00
psblas3-integer8:
base/comm/psb_cspgather.F90 base/comm/psb_dspgather.F90 base/comm/psb_sspgather.F90 base/comm/psb_zspgather.F90 base/internals/psb_indx_map_fnd_owner.F90 base/internals/psi_extrct_dl.F90 base/modules/psb_realloc_mod.F90 base/modules/psi_reduce_mod.F90 Partial updates for reduce operations to support mixed I8/I4. To be finished yet.
This commit is contained in:
Salvatore Filippone
@@ -22,7 +22,7 @@ subroutine psb_csp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep
|
||||
integer(psb_ipk_) :: err_act, dupl_, nrg, ncg, nzg
|
||||
integer(psb_ipk_) :: ip, ndx,naggrm1,naggrp1, i, j, k
|
||||
logical :: keepnum_, keeploc_
|
||||
integer(psb_ipk_), allocatable :: nzbr(:), idisp(:)
|
||||
integer(psb_mpik_), allocatable :: nzbr(:), idisp(:)
|
||||
integer(psb_ipk_) :: ierr(5)
|
||||
character(len=20) :: name
|
||||
integer(psb_ipk_) :: debug_level, debug_unit
|
||||
|
||||
@@ -22,7 +22,7 @@ subroutine psb_dsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep
|
||||
integer(psb_ipk_) :: err_act, dupl_, nrg, ncg, nzg
|
||||
integer(psb_ipk_) :: ip, ndx,naggrm1,naggrp1, i, j, k
|
||||
logical :: keepnum_, keeploc_
|
||||
integer(psb_ipk_), allocatable :: nzbr(:), idisp(:)
|
||||
integer(psb_mpik_), allocatable :: nzbr(:), idisp(:)
|
||||
integer(psb_ipk_) :: ierr(5)
|
||||
character(len=20) :: name
|
||||
integer(psb_ipk_) :: debug_level, debug_unit
|
||||
|
||||
@@ -22,7 +22,7 @@ subroutine psb_ssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep
|
||||
integer(psb_ipk_) :: err_act, dupl_, nrg, ncg, nzg
|
||||
integer(psb_ipk_) :: ip, ndx,naggrm1,naggrp1, i, j, k
|
||||
logical :: keepnum_, keeploc_
|
||||
integer(psb_ipk_), allocatable :: nzbr(:), idisp(:)
|
||||
integer(psb_mpik_), allocatable :: nzbr(:), idisp(:)
|
||||
integer(psb_ipk_) :: ierr(5)
|
||||
character(len=20) :: name
|
||||
integer(psb_ipk_) :: debug_level, debug_unit
|
||||
|
||||
@@ -22,7 +22,7 @@ subroutine psb_zsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep
|
||||
integer(psb_ipk_) :: err_act, dupl_, nrg, ncg, nzg
|
||||
integer(psb_ipk_) :: ip, ndx,naggrm1,naggrp1, i, j, k
|
||||
logical :: keepnum_, keeploc_
|
||||
integer(psb_ipk_), allocatable :: nzbr(:), idisp(:)
|
||||
integer(psb_mpik_), allocatable :: nzbr(:), idisp(:)
|
||||
integer(psb_ipk_) :: ierr(5)
|
||||
character(len=20) :: name
|
||||
integer(psb_ipk_) :: debug_level, debug_unit
|
||||
|
||||
@@ -66,12 +66,14 @@ subroutine psb_indx_map_fnd_owner(idx,iprc,idxmap,info)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
|
||||
integer(psb_ipk_), allocatable :: hsz(:),hidx(:),helem(:),hproc(:),&
|
||||
& sdsz(:),sdidx(:), rvsz(:), rvidx(:),answers(:,:),idxsrch(:,:)
|
||||
|
||||
integer(psb_ipk_) :: i,n_row,n_col,err_act,ih,icomm,hsize,ip,isz,k,j,&
|
||||
integer(psb_ipk_), allocatable :: helem(:),hproc(:),&
|
||||
& answers(:,:),idxsrch(:,:)
|
||||
integer(psb_mpik_), allocatable :: hsz(:),hidx(:), &
|
||||
& sdsz(:),sdidx(:), rvsz(:), rvidx(:)
|
||||
integer(psb_mpik_) :: icomm, minfo
|
||||
integer(psb_ipk_) :: i,n_row,n_col,err_act,ih,hsize,ip,isz,k,j,&
|
||||
& last_ih, last_j, nv
|
||||
integer(psb_ipk_) :: ictxt,np,me
|
||||
integer(psb_mpik_) :: ictxt,np,me
|
||||
logical, parameter :: gettime=.false.
|
||||
real(psb_dpk_) :: t0, t1, t2, t3, t4, tamx, tidx
|
||||
character(len=20) :: name
|
||||
@@ -136,7 +138,7 @@ subroutine psb_indx_map_fnd_owner(idx,iprc,idxmap,info)
|
||||
|
||||
call mpi_allgatherv(idx,hsz(me+1),psb_mpi_ipk_integer,&
|
||||
& hproc,hsz,hidx,psb_mpi_ipk_integer,&
|
||||
& icomm,info)
|
||||
& icomm,minfo)
|
||||
if (gettime) then
|
||||
tamx = psb_wtime() - t3
|
||||
end if
|
||||
@@ -178,7 +180,8 @@ subroutine psb_indx_map_fnd_owner(idx,iprc,idxmap,info)
|
||||
end if
|
||||
|
||||
! Collect all the answers with alltoallv (need sizes)
|
||||
call mpi_alltoall(sdsz,1,psb_mpi_ipk_integer,rvsz,1,psb_mpi_def_integer,icomm,info)
|
||||
call mpi_alltoall(sdsz,1,psb_mpi_def_integer,&
|
||||
& rvsz,1,psb_mpi_def_integer,icomm,minfo)
|
||||
|
||||
isz = sum(rvsz)
|
||||
|
||||
@@ -194,7 +197,7 @@ subroutine psb_indx_map_fnd_owner(idx,iprc,idxmap,info)
|
||||
end do
|
||||
call mpi_alltoallv(hproc,sdsz,sdidx,psb_mpi_ipk_integer,&
|
||||
& answers(:,1),rvsz,rvidx,psb_mpi_ipk_integer,&
|
||||
& icomm,info)
|
||||
& icomm,minfo)
|
||||
if (gettime) then
|
||||
tamx = psb_wtime() - t3 + tamx
|
||||
end if
|
||||
|
||||
@@ -145,7 +145,7 @@ subroutine psi_extract_dep_list(ictxt,is_bld,is_upd,desc_str,dep_list,&
|
||||
integer(psb_ipk_) :: i,pointer_dep_list,proc,j,err_act
|
||||
integer(psb_ipk_) :: err
|
||||
integer(psb_ipk_) :: debug_level, debug_unit
|
||||
integer(psb_mpik_) :: icomm, me, npr
|
||||
integer(psb_mpik_) :: icomm, me, npr, dl_mpi, minfo
|
||||
character name*20
|
||||
name='psi_extrct_dl'
|
||||
|
||||
@@ -271,9 +271,11 @@ subroutine psi_extract_dep_list(ictxt,is_bld,is_upd,desc_str,dep_list,&
|
||||
goto 9999
|
||||
endif
|
||||
itmp(1:dl_lda) = dep_list(1:dl_lda,me)
|
||||
call mpi_allgather(itmp,dl_lda,psb_mpi_ipk_integer,&
|
||||
& dep_list,dl_lda,psb_mpi_ipk_integer,icomm,info)
|
||||
deallocate(itmp,stat=info)
|
||||
dl_mpi = dl_lda
|
||||
call mpi_allgather(itmp,dl_mpi,psb_mpi_ipk_integer,&
|
||||
& dep_list,dl_mpi,psb_mpi_ipk_integer,icomm,minfo)
|
||||
info = minfo
|
||||
if (info == 0) deallocate(itmp,stat=info)
|
||||
if (info /= psb_success_) then
|
||||
info=psb_err_alloc_dealloc_
|
||||
goto 9999
|
||||
|
||||
+614
-382
File diff suppressed because it is too large
Load Diff
@@ -62,6 +62,11 @@ module psi_reduce_mod
|
||||
module procedure psb_i2sums, psb_i2sumv, psb_i2summ
|
||||
end interface psb_sum
|
||||
#endif
|
||||
#if defined(LONG_INTEGERS)
|
||||
interface psb_sum
|
||||
module procedure psb_i4sums, psb_i4sumv, psb_i4summ
|
||||
end interface
|
||||
#endif
|
||||
#if !defined(LONG_INTEGERS)
|
||||
interface psb_sum
|
||||
module procedure psb_i8sums, psb_i8sumv, psb_i8summ
|
||||
@@ -2924,6 +2929,134 @@ contains
|
||||
#endif
|
||||
|
||||
|
||||
#if defined(LONG_INTEGERS)
|
||||
subroutine psb_i4sums(ictxt,dat,root)
|
||||
|
||||
#ifdef MPI_MOD
|
||||
use mpi
|
||||
#endif
|
||||
implicit none
|
||||
#ifdef MPI_H
|
||||
include 'mpif.h'
|
||||
#endif
|
||||
integer(psb_mpik_), intent(in) :: ictxt
|
||||
integer(psb_mpik_), intent(inout) :: dat
|
||||
integer(psb_mpik_), intent(in), optional :: root
|
||||
integer(psb_mpik_) :: root_
|
||||
integer(psb_mpik_) :: dat_
|
||||
integer(psb_mpik_) :: iam, np, info
|
||||
integer(psb_ipk_) :: iinfo
|
||||
|
||||
#if !defined(SERIAL_MPI)
|
||||
|
||||
call psb_info(ictxt,iam,np)
|
||||
|
||||
if (present(root)) then
|
||||
root_ = root
|
||||
else
|
||||
root_ = -1
|
||||
endif
|
||||
if (root_ == -1) then
|
||||
call mpi_allreduce(dat,dat_,1,psb_mpi_lng_integer,mpi_sum,ictxt,info)
|
||||
dat = dat_
|
||||
else
|
||||
call mpi_reduce(dat,dat_,1,psb_mpi_lng_integer,mpi_sum,root_,ictxt,info)
|
||||
dat = dat_
|
||||
endif
|
||||
|
||||
#endif
|
||||
end subroutine psb_i4sums
|
||||
|
||||
subroutine psb_i4sumv(ictxt,dat,root)
|
||||
use psb_realloc_mod
|
||||
#ifdef MPI_MOD
|
||||
use mpi
|
||||
#endif
|
||||
implicit none
|
||||
#ifdef MPI_H
|
||||
include 'mpif.h'
|
||||
#endif
|
||||
integer(psb_mpik_), intent(in) :: ictxt
|
||||
integer(psb_mpik_), intent(inout) :: dat(:)
|
||||
integer(psb_mpik_), intent(in), optional :: root
|
||||
integer(psb_mpik_) :: root_
|
||||
integer(psb_mpik_), allocatable :: dat_(:)
|
||||
integer(psb_mpik_) :: iam, np, info
|
||||
integer(psb_ipk_) :: iinfo
|
||||
|
||||
#if !defined(SERIAL_MPI)
|
||||
|
||||
call psb_info(ictxt,iam,np)
|
||||
|
||||
if (present(root)) then
|
||||
root_ = root
|
||||
else
|
||||
root_ = -1
|
||||
endif
|
||||
if (root_ == -1) then
|
||||
call psb_realloc(size(dat),dat_,info)
|
||||
dat_=dat
|
||||
if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),&
|
||||
& psb_mpi_lng_integer,mpi_sum,ictxt,info)
|
||||
else
|
||||
if (iam == root_) then
|
||||
call psb_realloc(size(dat),dat_,info)
|
||||
dat_=dat
|
||||
call mpi_reduce(dat_,dat,size(dat),psb_mpi_lng_integer,mpi_sum,root_,ictxt,info)
|
||||
else
|
||||
call psb_realloc(1,dat_,info)
|
||||
call mpi_reduce(dat,dat_,size(dat),psb_mpi_lng_integer,mpi_sum,root_,ictxt,info)
|
||||
end if
|
||||
endif
|
||||
#endif
|
||||
end subroutine psb_i4sumv
|
||||
|
||||
subroutine psb_i4summ(ictxt,dat,root)
|
||||
use psb_realloc_mod
|
||||
#ifdef MPI_MOD
|
||||
use mpi
|
||||
#endif
|
||||
implicit none
|
||||
#ifdef MPI_H
|
||||
include 'mpif.h'
|
||||
#endif
|
||||
integer(psb_mpik_), intent(in) :: ictxt
|
||||
integer(psb_mpik_), intent(inout) :: dat(:,:)
|
||||
integer(psb_mpik_), intent(in), optional :: root
|
||||
integer(psb_mpik_) :: root_
|
||||
integer(psb_mpik_), allocatable :: dat_(:,:)
|
||||
integer(psb_mpik_) :: iam, np, info
|
||||
integer(psb_ipk_) :: iinfo
|
||||
|
||||
|
||||
#if !defined(SERIAL_MPI)
|
||||
call psb_info(ictxt,iam,np)
|
||||
|
||||
if (present(root)) then
|
||||
root_ = root
|
||||
else
|
||||
root_ = -1
|
||||
endif
|
||||
if (root_ == -1) then
|
||||
call psb_realloc(size(dat,1),size(dat,2),dat_,info)
|
||||
dat_=dat
|
||||
if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),&
|
||||
& psb_mpi_lng_integer,mpi_sum,ictxt,info)
|
||||
else
|
||||
if (iam == root_) then
|
||||
call psb_realloc(size(dat,1),size(dat,2),dat_,info)
|
||||
dat_=dat
|
||||
call mpi_reduce(dat_,dat,size(dat),psb_mpi_lng_integer,mpi_sum,root_,ictxt,info)
|
||||
else
|
||||
call psb_realloc(1,1,dat_,info)
|
||||
call mpi_reduce(dat,dat_,size(dat),psb_mpi_lng_integer,mpi_sum,root_,ictxt,info)
|
||||
end if
|
||||
endif
|
||||
#endif
|
||||
end subroutine psb_i4summ
|
||||
|
||||
#endif
|
||||
|
||||
#if !defined(LONG_INTEGERS)
|
||||
subroutine psb_i8sums(ictxt,dat,root)
|
||||
|
||||
|
||||
Reference in New Issue
Block a user