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

psblas3-integer8:

Browse Source 
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.
psblas3-type-indexed
Salvatore Filippone 13 years ago
parent 1e78b3b695
commit 04d97d04bb
8 changed files with 782 additions and 412 deletions
Show Stats Download Patch File Download Diff File

2
base/comm/psb_cspgather.F90
Unescape Escape View File

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

2
base/comm/psb_dspgather.F90
Unescape Escape View File

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

2
base/comm/psb_sspgather.F90
Unescape Escape View File

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

2
base/comm/psb_zspgather.F90
Unescape Escape View File

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

19
base/internals/psb_indx_map_fnd_owner.F90
Unescape Escape View File

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

10
base/internals/psi_extrct_dl.F90
Unescape Escape View File

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

1024
base/modules/psb_realloc_mod.F90
View File

File diff suppressed because it is too large Load Diff

133
base/modules/psi_reduce_mod.F90
Unescape Escape View File

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

Write Preview
Loading…
Cancel
Save