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

Fix implementation of SPGATHER.

Browse Source
psblas-3.6-maint
Salvatore Filippone 7 years ago
parent 5310eb4826
commit 53766df273
4 changed files with 140 additions and 64 deletions
Show Stats Download Patch File Download Diff File

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

@ -121,24 +121,41 @@ subroutine psb_csp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep
nzbr(me+1) = nzl nzbr(me+1) = nzl
call psb_sum(ictxt,nzbr(1:np)) call psb_sum(ictxt,nzbr(1:np))
nzg = sum(nzbr) nzg = sum(nzbr)
if (info == psb_success_) call glob_coo%allocate(nrg,ncg,nzg) if ((root_ == -1).or.(root_ == me)) then
if (info == psb_success_) call glob_coo%allocate(nrg,ncg,nzg)
else
if (info == psb_success_) call glob_coo%allocate(1,1,1)
end if
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
do ip=1,np do ip=1,np
idisp(ip) = sum(nzbr(1:ip-1)) idisp(ip) = sum(nzbr(1:ip-1))
enddo enddo
ndx = nzbr(me+1) ndx = nzbr(me+1)
call mpi_allgatherv(loc_coo%val,ndx,psb_mpi_c_spk_,& if (root_ == -1) then
& glob_coo%val,nzbr,idisp,& call mpi_allgatherv(loc_coo%val,ndx,psb_mpi_c_spk_,&
& psb_mpi_c_spk_,icomm,minfo) & glob_coo%val,nzbr,idisp,&
if (minfo == psb_success_) call & & psb_mpi_c_spk_,icomm,minfo)
& mpi_allgatherv(loc_coo%ia,ndx,psb_mpi_ipk_integer,& if (minfo == psb_success_) call &
& glob_coo%ia,nzbr,idisp,& & mpi_allgatherv(loc_coo%ia,ndx,psb_mpi_ipk_integer,&
& psb_mpi_ipk_integer,icomm,minfo) & glob_coo%ia,nzbr,idisp,&
if (minfo == psb_success_) call & & psb_mpi_ipk_integer,icomm,minfo)
& mpi_allgatherv(loc_coo%ja,ndx,psb_mpi_ipk_integer,& if (minfo == psb_success_) call &
& glob_coo%ja,nzbr,idisp,& & mpi_allgatherv(loc_coo%ja,ndx,psb_mpi_ipk_integer,&
& psb_mpi_ipk_integer,icomm,minfo) & glob_coo%ja,nzbr,idisp,&
& psb_mpi_ipk_integer,icomm,minfo)
else
call mpi_gatherv(loc_coo%val,ndx,psb_mpi_c_spk_,&
& glob_coo%val,nzbr,idisp,&
& psb_mpi_c_spk_,root_,icomm,minfo)
if (minfo == psb_success_) call &
& mpi_gatherv(loc_coo%ia,ndx,psb_mpi_ipk_integer,&
& glob_coo%ia,nzbr,idisp,&
& psb_mpi_ipk_integer,root_,icomm,minfo)
if (minfo == psb_success_) call &
& mpi_gatherv(loc_coo%ja,ndx,psb_mpi_ipk_integer,&
& glob_coo%ja,nzbr,idisp,&
& psb_mpi_ipk_integer,root_,icomm,minfo)
end if
if (minfo /= psb_success_) then if (minfo /= psb_success_) then
info = minfo info = minfo
call psb_errpush(psb_err_internal_error_,name,a_err=' from mpi_allgatherv') call psb_errpush(psb_err_internal_error_,name,a_err=' from mpi_allgatherv')
@ -146,9 +163,11 @@ subroutine psb_csp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep
end if end if
call loc_coo%free() call loc_coo%free()
call glob_coo%set_nzeros(nzg) if ((root_ == -1).or.(root_ == me)) then
if (present(dupl)) call glob_coo%set_dupl(dupl) call glob_coo%set_nzeros(nzg)
call globa%mv_from(glob_coo) if (present(dupl)) call glob_coo%set_dupl(dupl)
call globa%mv_from(glob_coo)
end if
else else
write(psb_err_unit,*) 'SP_ALLGATHER: Not implemented yet with keepnum ',keepnum_ write(psb_err_unit,*) 'SP_ALLGATHER: Not implemented yet with keepnum ',keepnum_

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

@ -121,24 +121,41 @@ subroutine psb_dsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep
nzbr(me+1) = nzl nzbr(me+1) = nzl
call psb_sum(ictxt,nzbr(1:np)) call psb_sum(ictxt,nzbr(1:np))
nzg = sum(nzbr) nzg = sum(nzbr)
if (info == psb_success_) call glob_coo%allocate(nrg,ncg,nzg) if ((root_ == -1).or.(root_ == me)) then
if (info == psb_success_) call glob_coo%allocate(nrg,ncg,nzg)
else
if (info == psb_success_) call glob_coo%allocate(1,1,1)
end if
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
do ip=1,np do ip=1,np
idisp(ip) = sum(nzbr(1:ip-1)) idisp(ip) = sum(nzbr(1:ip-1))
enddo enddo
ndx = nzbr(me+1) ndx = nzbr(me+1)
call mpi_allgatherv(loc_coo%val,ndx,psb_mpi_r_dpk_,& if (root_ == -1) then
& glob_coo%val,nzbr,idisp,& call mpi_allgatherv(loc_coo%val,ndx,psb_mpi_r_dpk_,&
& psb_mpi_r_dpk_,icomm,minfo) & glob_coo%val,nzbr,idisp,&
if (minfo == psb_success_) call & & psb_mpi_r_dpk_,icomm,minfo)
& mpi_allgatherv(loc_coo%ia,ndx,psb_mpi_ipk_integer,& if (minfo == psb_success_) call &
& glob_coo%ia,nzbr,idisp,& & mpi_allgatherv(loc_coo%ia,ndx,psb_mpi_ipk_integer,&
& psb_mpi_ipk_integer,icomm,minfo) & glob_coo%ia,nzbr,idisp,&
if (minfo == psb_success_) call & & psb_mpi_ipk_integer,icomm,minfo)
& mpi_allgatherv(loc_coo%ja,ndx,psb_mpi_ipk_integer,& if (minfo == psb_success_) call &
& glob_coo%ja,nzbr,idisp,& & mpi_allgatherv(loc_coo%ja,ndx,psb_mpi_ipk_integer,&
& psb_mpi_ipk_integer,icomm,minfo) & glob_coo%ja,nzbr,idisp,&
& psb_mpi_ipk_integer,icomm,minfo)
else
call mpi_gatherv(loc_coo%val,ndx,psb_mpi_r_dpk_,&
& glob_coo%val,nzbr,idisp,&
& psb_mpi_r_dpk_,root_,icomm,minfo)
if (minfo == psb_success_) call &
& mpi_gatherv(loc_coo%ia,ndx,psb_mpi_ipk_integer,&
& glob_coo%ia,nzbr,idisp,&
& psb_mpi_ipk_integer,root_,icomm,minfo)
if (minfo == psb_success_) call &
& mpi_gatherv(loc_coo%ja,ndx,psb_mpi_ipk_integer,&
& glob_coo%ja,nzbr,idisp,&
& psb_mpi_ipk_integer,root_,icomm,minfo)
end if
if (minfo /= psb_success_) then if (minfo /= psb_success_) then
info = minfo info = minfo
call psb_errpush(psb_err_internal_error_,name,a_err=' from mpi_allgatherv') call psb_errpush(psb_err_internal_error_,name,a_err=' from mpi_allgatherv')
@ -146,9 +163,11 @@ subroutine psb_dsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep
end if end if
call loc_coo%free() call loc_coo%free()
call glob_coo%set_nzeros(nzg) if ((root_ == -1).or.(root_ == me)) then
if (present(dupl)) call glob_coo%set_dupl(dupl) call glob_coo%set_nzeros(nzg)
call globa%mv_from(glob_coo) if (present(dupl)) call glob_coo%set_dupl(dupl)
call globa%mv_from(glob_coo)
end if
else else
write(psb_err_unit,*) 'SP_ALLGATHER: Not implemented yet with keepnum ',keepnum_ write(psb_err_unit,*) 'SP_ALLGATHER: Not implemented yet with keepnum ',keepnum_

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

@ -121,24 +121,41 @@ subroutine psb_ssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep
nzbr(me+1) = nzl nzbr(me+1) = nzl
call psb_sum(ictxt,nzbr(1:np)) call psb_sum(ictxt,nzbr(1:np))
nzg = sum(nzbr) nzg = sum(nzbr)
if (info == psb_success_) call glob_coo%allocate(nrg,ncg,nzg) if ((root_ == -1).or.(root_ == me)) then
if (info == psb_success_) call glob_coo%allocate(nrg,ncg,nzg)
else
if (info == psb_success_) call glob_coo%allocate(1,1,1)
end if
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
do ip=1,np do ip=1,np
idisp(ip) = sum(nzbr(1:ip-1)) idisp(ip) = sum(nzbr(1:ip-1))
enddo enddo
ndx = nzbr(me+1) ndx = nzbr(me+1)
call mpi_allgatherv(loc_coo%val,ndx,psb_mpi_r_spk_,& if (root_ == -1) then
& glob_coo%val,nzbr,idisp,& call mpi_allgatherv(loc_coo%val,ndx,psb_mpi_r_spk_,&
& psb_mpi_r_spk_,icomm,minfo) & glob_coo%val,nzbr,idisp,&
if (minfo == psb_success_) call & & psb_mpi_r_spk_,icomm,minfo)
& mpi_allgatherv(loc_coo%ia,ndx,psb_mpi_ipk_integer,& if (minfo == psb_success_) call &
& glob_coo%ia,nzbr,idisp,& & mpi_allgatherv(loc_coo%ia,ndx,psb_mpi_ipk_integer,&
& psb_mpi_ipk_integer,icomm,minfo) & glob_coo%ia,nzbr,idisp,&
if (minfo == psb_success_) call & & psb_mpi_ipk_integer,icomm,minfo)
& mpi_allgatherv(loc_coo%ja,ndx,psb_mpi_ipk_integer,& if (minfo == psb_success_) call &
& glob_coo%ja,nzbr,idisp,& & mpi_allgatherv(loc_coo%ja,ndx,psb_mpi_ipk_integer,&
& psb_mpi_ipk_integer,icomm,minfo) & glob_coo%ja,nzbr,idisp,&
& psb_mpi_ipk_integer,icomm,minfo)
else
call mpi_gatherv(loc_coo%val,ndx,psb_mpi_r_spk_,&
& glob_coo%val,nzbr,idisp,&
& psb_mpi_r_spk_,root_,icomm,minfo)
if (minfo == psb_success_) call &
& mpi_gatherv(loc_coo%ia,ndx,psb_mpi_ipk_integer,&
& glob_coo%ia,nzbr,idisp,&
& psb_mpi_ipk_integer,root_,icomm,minfo)
if (minfo == psb_success_) call &
& mpi_gatherv(loc_coo%ja,ndx,psb_mpi_ipk_integer,&
& glob_coo%ja,nzbr,idisp,&
& psb_mpi_ipk_integer,root_,icomm,minfo)
end if
if (minfo /= psb_success_) then if (minfo /= psb_success_) then
info = minfo info = minfo
call psb_errpush(psb_err_internal_error_,name,a_err=' from mpi_allgatherv') call psb_errpush(psb_err_internal_error_,name,a_err=' from mpi_allgatherv')
@ -146,9 +163,11 @@ subroutine psb_ssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep
end if end if
call loc_coo%free() call loc_coo%free()
call glob_coo%set_nzeros(nzg) if ((root_ == -1).or.(root_ == me)) then
if (present(dupl)) call glob_coo%set_dupl(dupl) call glob_coo%set_nzeros(nzg)
call globa%mv_from(glob_coo) if (present(dupl)) call glob_coo%set_dupl(dupl)
call globa%mv_from(glob_coo)
end if
else else
write(psb_err_unit,*) 'SP_ALLGATHER: Not implemented yet with keepnum ',keepnum_ write(psb_err_unit,*) 'SP_ALLGATHER: Not implemented yet with keepnum ',keepnum_

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

@ -121,24 +121,41 @@ subroutine psb_zsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep
nzbr(me+1) = nzl nzbr(me+1) = nzl
call psb_sum(ictxt,nzbr(1:np)) call psb_sum(ictxt,nzbr(1:np))
nzg = sum(nzbr) nzg = sum(nzbr)
if (info == psb_success_) call glob_coo%allocate(nrg,ncg,nzg) if ((root_ == -1).or.(root_ == me)) then
if (info == psb_success_) call glob_coo%allocate(nrg,ncg,nzg)
else
if (info == psb_success_) call glob_coo%allocate(1,1,1)
end if
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
do ip=1,np do ip=1,np
idisp(ip) = sum(nzbr(1:ip-1)) idisp(ip) = sum(nzbr(1:ip-1))
enddo enddo
ndx = nzbr(me+1) ndx = nzbr(me+1)
call mpi_allgatherv(loc_coo%val,ndx,psb_mpi_c_dpk_,& if (root_ == -1) then
& glob_coo%val,nzbr,idisp,& call mpi_allgatherv(loc_coo%val,ndx,psb_mpi_c_dpk_,&
& psb_mpi_c_dpk_,icomm,minfo) & glob_coo%val,nzbr,idisp,&
if (minfo == psb_success_) call & & psb_mpi_c_dpk_,icomm,minfo)
& mpi_allgatherv(loc_coo%ia,ndx,psb_mpi_ipk_integer,& if (minfo == psb_success_) call &
& glob_coo%ia,nzbr,idisp,& & mpi_allgatherv(loc_coo%ia,ndx,psb_mpi_ipk_integer,&
& psb_mpi_ipk_integer,icomm,minfo) & glob_coo%ia,nzbr,idisp,&
if (minfo == psb_success_) call & & psb_mpi_ipk_integer,icomm,minfo)
& mpi_allgatherv(loc_coo%ja,ndx,psb_mpi_ipk_integer,& if (minfo == psb_success_) call &
& glob_coo%ja,nzbr,idisp,& & mpi_allgatherv(loc_coo%ja,ndx,psb_mpi_ipk_integer,&
& psb_mpi_ipk_integer,icomm,minfo) & glob_coo%ja,nzbr,idisp,&
& psb_mpi_ipk_integer,icomm,minfo)
else
call mpi_gatherv(loc_coo%val,ndx,psb_mpi_c_dpk_,&
& glob_coo%val,nzbr,idisp,&
& psb_mpi_c_dpk_,root_,icomm,minfo)
if (minfo == psb_success_) call &
& mpi_gatherv(loc_coo%ia,ndx,psb_mpi_ipk_integer,&
& glob_coo%ia,nzbr,idisp,&
& psb_mpi_ipk_integer,root_,icomm,minfo)
if (minfo == psb_success_) call &
& mpi_gatherv(loc_coo%ja,ndx,psb_mpi_ipk_integer,&
& glob_coo%ja,nzbr,idisp,&
& psb_mpi_ipk_integer,root_,icomm,minfo)
end if
if (minfo /= psb_success_) then if (minfo /= psb_success_) then
info = minfo info = minfo
call psb_errpush(psb_err_internal_error_,name,a_err=' from mpi_allgatherv') call psb_errpush(psb_err_internal_error_,name,a_err=' from mpi_allgatherv')
@ -146,9 +163,11 @@ subroutine psb_zsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep
end if end if
call loc_coo%free() call loc_coo%free()
call glob_coo%set_nzeros(nzg) if ((root_ == -1).or.(root_ == me)) then
if (present(dupl)) call glob_coo%set_dupl(dupl) call glob_coo%set_nzeros(nzg)
call globa%mv_from(glob_coo) if (present(dupl)) call glob_coo%set_dupl(dupl)
call globa%mv_from(glob_coo)
end if
else else
write(psb_err_unit,*) 'SP_ALLGATHER: Not implemented yet with keepnum ',keepnum_ write(psb_err_unit,*) 'SP_ALLGATHER: Not implemented yet with keepnum ',keepnum_

Write Preview
Loading…
Cancel
Save