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_cscatter.F90
 base/comm/psb_cspgather.F90
 base/comm/psb_dscatter.F90
 base/comm/psb_dspgather.F90
 base/comm/psb_iscatter.F90
 base/comm/psb_sscatter.F90
 base/comm/psb_sspgather.F90
 base/comm/psb_zscatter.F90
 base/comm/psb_zspgather.F90
 base/internals/psb_indx_map_fnd_owner.F90
 base/internals/psi_desc_index.F90
 base/internals/psi_extrct_dl.F90
 base/internals/psi_iswapdata.F90
 base/internals/psi_iswaptran.F90
 base/modules/psb_const_mod.F90
 base/modules/psi_bcast_mod.F90
 base/modules/psi_comm_buffers_mod.F90
 base/modules/psi_p2p_mod.F90
 base/modules/psi_penv_mod.F90
 base/modules/psi_reduce_mod.F90
 base/tools/psb_ccdbldext.F90
 base/tools/psb_csphalo.F90
 base/tools/psb_dcdbldext.F90
 base/tools/psb_dsphalo.F90
 base/tools/psb_scdbldext.F90
 base/tools/psb_ssphalo.F90
 base/tools/psb_zcdbldext.F90
 base/tools/psb_zsphalo.F90

New names for variables holding mpi datatypes; hopefully clear enough.
psblas3-type-indexed
Salvatore Filippone 13 years ago
parent b41af4a30a
commit 0b2b2e5bad
28 changed files with 260 additions and 250 deletions
Show Stats Download Patch File Download Diff File

16
base/comm/psb_cscatter.F90
Unescape Escape View File

@ -169,8 +169,8 @@ subroutine psb_cscatterm(globx, locx, desc_a, info, iroot)
end do end do
call psb_loc_to_glob(ltg(1:nrow),desc_a,info) call psb_loc_to_glob(ltg(1:nrow),desc_a,info)
call mpi_gather(nrow,1,psb_mpi_integer,all_dim,& call mpi_gather(nrow,1,psb_mpi_ipk_integer,all_dim,&
& 1,psb_mpi_integer,rootrank,icomm,info) & 1,psb_mpi_ipk_integer,rootrank,icomm,info)
if (me == root) then if (me == root) then
displ(1)=0 displ(1)=0
@ -190,8 +190,8 @@ subroutine psb_cscatterm(globx, locx, desc_a, info, iroot)
end if end if
call mpi_gatherv(ltg,nrow,& call mpi_gatherv(ltg,nrow,&
& psb_mpi_integer,l_t_g_all,all_dim,& & psb_mpi_ipk_integer,l_t_g_all,all_dim,&
& displ,psb_mpi_integer,rootrank,icomm,info) & displ,psb_mpi_ipk_integer,rootrank,icomm,info)
do c=1, k do c=1, k
@ -383,8 +383,8 @@ subroutine psb_cscatterv(globx, locx, desc_a, info, iroot)
call psb_loc_to_glob(ltg(1:nrow),desc_a,info) call psb_loc_to_glob(ltg(1:nrow),desc_a,info)
call mpi_gather(nrow,1,psb_mpi_integer,all_dim,& call mpi_gather(nrow,1,psb_mpi_ipk_integer,all_dim,&
& 1,psb_mpi_integer,rootrank,icomm,info) & 1,psb_mpi_ipk_integer,rootrank,icomm,info)
if(me == root) then if(me == root) then
displ(1)=0 displ(1)=0
@ -401,8 +401,8 @@ subroutine psb_cscatterv(globx, locx, desc_a, info, iroot)
end if end if
call mpi_gatherv(ltg,nrow,& call mpi_gatherv(ltg,nrow,&
& psb_mpi_integer,l_t_g_all,all_dim,& & psb_mpi_ipk_integer,l_t_g_all,all_dim,&
& displ,psb_mpi_integer,rootrank,icomm,info) & displ,psb_mpi_ipk_integer,rootrank,icomm,info)
! prepare vector to scatter ! prepare vector to scatter
if (me == root) then if (me == root) then

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

@ -73,12 +73,12 @@ subroutine psb_csp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep
call mpi_allgatherv(loc_coo%val,ndx,mpi_complex,& call mpi_allgatherv(loc_coo%val,ndx,mpi_complex,&
& glob_coo%val,nzbr,idisp,& & glob_coo%val,nzbr,idisp,&
& mpi_complex,icomm,minfo) & mpi_complex,icomm,minfo)
if (minfo == psb_success_) call mpi_allgatherv(loc_coo%ia,ndx,psb_mpi_integer,& if (minfo == psb_success_) call mpi_allgatherv(loc_coo%ia,ndx,psb_mpi_ipk_integer,&
& glob_coo%ia,nzbr,idisp,& & glob_coo%ia,nzbr,idisp,&
& psb_mpi_integer,icomm,minfo) & psb_mpi_ipk_integer,icomm,minfo)
if (minfo == psb_success_) call mpi_allgatherv(loc_coo%ja,ndx,psb_mpi_integer,& if (minfo == psb_success_) call mpi_allgatherv(loc_coo%ja,ndx,psb_mpi_ipk_integer,&
& glob_coo%ja,nzbr,idisp,& & glob_coo%ja,nzbr,idisp,&
& psb_mpi_integer,icomm,minfo) & psb_mpi_ipk_integer,icomm,minfo)
if (minfo /= psb_success_) then if (minfo /= psb_success_) then
info = minfo info = minfo

16
base/comm/psb_dscatter.F90
Unescape Escape View File

@ -169,8 +169,8 @@ subroutine psb_dscatterm(globx, locx, desc_a, info, iroot)
end do end do
call psb_loc_to_glob(ltg(1:nrow),desc_a,info) call psb_loc_to_glob(ltg(1:nrow),desc_a,info)
call mpi_gather(nrow,1,psb_mpi_integer,all_dim,& call mpi_gather(nrow,1,psb_mpi_ipk_integer,all_dim,&
& 1,psb_mpi_integer,rootrank,icomm,info) & 1,psb_mpi_ipk_integer,rootrank,icomm,info)
if (me == root) then if (me == root) then
displ(1)=0 displ(1)=0
@ -190,8 +190,8 @@ subroutine psb_dscatterm(globx, locx, desc_a, info, iroot)
end if end if
call mpi_gatherv(ltg,nrow,& call mpi_gatherv(ltg,nrow,&
& psb_mpi_integer,l_t_g_all,all_dim,& & psb_mpi_ipk_integer,l_t_g_all,all_dim,&
& displ,psb_mpi_integer,rootrank,icomm,info) & displ,psb_mpi_ipk_integer,rootrank,icomm,info)
do c=1, k do c=1, k
@ -383,8 +383,8 @@ subroutine psb_dscatterv(globx, locx, desc_a, info, iroot)
call psb_loc_to_glob(ltg(1:nrow),desc_a,info) call psb_loc_to_glob(ltg(1:nrow),desc_a,info)
call mpi_gather(nrow,1,psb_mpi_integer,all_dim,& call mpi_gather(nrow,1,psb_mpi_ipk_integer,all_dim,&
& 1,psb_mpi_integer,rootrank,icomm,info) & 1,psb_mpi_ipk_integer,rootrank,icomm,info)
if(me == root) then if(me == root) then
displ(1)=0 displ(1)=0
@ -401,8 +401,8 @@ subroutine psb_dscatterv(globx, locx, desc_a, info, iroot)
end if end if
call mpi_gatherv(ltg,nrow,& call mpi_gatherv(ltg,nrow,&
& psb_mpi_integer,l_t_g_all,all_dim,& & psb_mpi_ipk_integer,l_t_g_all,all_dim,&
& displ,psb_mpi_integer,rootrank,icomm,info) & displ,psb_mpi_ipk_integer,rootrank,icomm,info)
! prepare vector to scatter ! prepare vector to scatter
if (me == root) then if (me == root) then

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

@ -73,12 +73,12 @@ subroutine psb_dsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep
call mpi_allgatherv(loc_coo%val,ndx,mpi_complex,& call mpi_allgatherv(loc_coo%val,ndx,mpi_complex,&
& glob_coo%val,nzbr,idisp,& & glob_coo%val,nzbr,idisp,&
& mpi_complex,icomm,minfo) & mpi_complex,icomm,minfo)
if (minfo == psb_success_) call mpi_allgatherv(loc_coo%ia,ndx,psb_mpi_integer,& if (minfo == psb_success_) call mpi_allgatherv(loc_coo%ia,ndx,psb_mpi_ipk_integer,&
& glob_coo%ia,nzbr,idisp,& & glob_coo%ia,nzbr,idisp,&
& psb_mpi_integer,icomm,minfo) & psb_mpi_ipk_integer,icomm,minfo)
if (minfo == psb_success_) call mpi_allgatherv(loc_coo%ja,ndx,psb_mpi_integer,& if (minfo == psb_success_) call mpi_allgatherv(loc_coo%ja,ndx,psb_mpi_ipk_integer,&
& glob_coo%ja,nzbr,idisp,& & glob_coo%ja,nzbr,idisp,&
& psb_mpi_integer,icomm,minfo) & psb_mpi_ipk_integer,icomm,minfo)
if (minfo /= psb_success_) then if (minfo /= psb_success_) then
info = minfo info = minfo

24
base/comm/psb_iscatter.F90
Unescape Escape View File

@ -167,8 +167,8 @@ subroutine psb_iscatterm(globx, locx, desc_a, info, iroot)
end do end do
call psb_loc_to_glob(ltg(1:nrow),desc_a,info) call psb_loc_to_glob(ltg(1:nrow),desc_a,info)
call mpi_gather(nrow,1,psb_mpi_integer,all_dim,& call mpi_gather(nrow,1,psb_mpi_ipk_integer,all_dim,&
& 1,psb_mpi_integer,rootrank,icomm,info) & 1,psb_mpi_ipk_integer,rootrank,icomm,info)
if (me == root) then if (me == root) then
displ(1)=0 displ(1)=0
@ -188,8 +188,8 @@ subroutine psb_iscatterm(globx, locx, desc_a, info, iroot)
end if end if
call mpi_gatherv(ltg,nrow,& call mpi_gatherv(ltg,nrow,&
& psb_mpi_integer,l_t_g_all,all_dim,& & psb_mpi_ipk_integer,l_t_g_all,all_dim,&
& displ,psb_mpi_integer,rootrank,icomm,info) & displ,psb_mpi_ipk_integer,rootrank,icomm,info)
do c=1, k do c=1, k
@ -206,8 +206,8 @@ subroutine psb_iscatterm(globx, locx, desc_a, info, iroot)
! scatter !!! ! scatter !!!
call mpi_scatterv(scatterv,all_dim,displ,& call mpi_scatterv(scatterv,all_dim,displ,&
& psb_mpi_integer,locx(1,jlocx+c-1),nrow,& & psb_mpi_ipk_integer,locx(1,jlocx+c-1),nrow,&
& psb_mpi_integer,rootrank,icomm,info) & psb_mpi_ipk_integer,rootrank,icomm,info)
end do end do
@ -381,8 +381,8 @@ subroutine psb_iscatterv(globx, locx, desc_a, info, iroot)
call psb_loc_to_glob(ltg(1:nrow),desc_a,info) call psb_loc_to_glob(ltg(1:nrow),desc_a,info)
call mpi_gather(nrow,1,psb_mpi_integer,all_dim,& call mpi_gather(nrow,1,psb_mpi_ipk_integer,all_dim,&
& 1,psb_mpi_integer,rootrank,icomm,info) & 1,psb_mpi_ipk_integer,rootrank,icomm,info)
if(me == root) then if(me == root) then
displ(1)=0 displ(1)=0
@ -399,8 +399,8 @@ subroutine psb_iscatterv(globx, locx, desc_a, info, iroot)
end if end if
call mpi_gatherv(ltg,nrow,& call mpi_gatherv(ltg,nrow,&
& psb_mpi_integer,l_t_g_all,all_dim,& & psb_mpi_ipk_integer,l_t_g_all,all_dim,&
& displ,psb_mpi_integer,rootrank,icomm,info) & displ,psb_mpi_ipk_integer,rootrank,icomm,info)
! prepare vector to scatter ! prepare vector to scatter
if (me == root) then if (me == root) then
@ -415,8 +415,8 @@ subroutine psb_iscatterv(globx, locx, desc_a, info, iroot)
end if end if
call mpi_scatterv(scatterv,all_dim,displ,& call mpi_scatterv(scatterv,all_dim,displ,&
& psb_mpi_integer,locx,nrow,& & psb_mpi_ipk_integer,locx,nrow,&
& psb_mpi_integer,rootrank,icomm,info) & psb_mpi_ipk_integer,rootrank,icomm,info)
if (me == root) deallocate(all_dim, l_t_g_all, displ, scatterv) if (me == root) deallocate(all_dim, l_t_g_all, displ, scatterv)
end if end if

16
base/comm/psb_sscatter.F90
Unescape Escape View File

@ -169,8 +169,8 @@ subroutine psb_sscatterm(globx, locx, desc_a, info, iroot)
end do end do
call psb_loc_to_glob(ltg(1:nrow),desc_a,info) call psb_loc_to_glob(ltg(1:nrow),desc_a,info)
call mpi_gather(nrow,1,psb_mpi_integer,all_dim,& call mpi_gather(nrow,1,psb_mpi_ipk_integer,all_dim,&
& 1,psb_mpi_integer,rootrank,icomm,info) & 1,psb_mpi_ipk_integer,rootrank,icomm,info)
if (me == root) then if (me == root) then
displ(1)=0 displ(1)=0
@ -190,8 +190,8 @@ subroutine psb_sscatterm(globx, locx, desc_a, info, iroot)
end if end if
call mpi_gatherv(ltg,nrow,& call mpi_gatherv(ltg,nrow,&
& psb_mpi_integer,l_t_g_all,all_dim,& & psb_mpi_ipk_integer,l_t_g_all,all_dim,&
& displ,psb_mpi_integer,rootrank,icomm,info) & displ,psb_mpi_ipk_integer,rootrank,icomm,info)
do c=1, k do c=1, k
@ -383,8 +383,8 @@ subroutine psb_sscatterv(globx, locx, desc_a, info, iroot)
call psb_loc_to_glob(ltg(1:nrow),desc_a,info) call psb_loc_to_glob(ltg(1:nrow),desc_a,info)
call mpi_gather(nrow,1,psb_mpi_integer,all_dim,& call mpi_gather(nrow,1,psb_mpi_ipk_integer,all_dim,&
& 1,psb_mpi_integer,rootrank,icomm,info) & 1,psb_mpi_ipk_integer,rootrank,icomm,info)
if(me == root) then if(me == root) then
displ(1)=0 displ(1)=0
@ -401,8 +401,8 @@ subroutine psb_sscatterv(globx, locx, desc_a, info, iroot)
end if end if
call mpi_gatherv(ltg,nrow,& call mpi_gatherv(ltg,nrow,&
& psb_mpi_integer,l_t_g_all,all_dim,& & psb_mpi_ipk_integer,l_t_g_all,all_dim,&
& displ,psb_mpi_integer,rootrank,icomm,info) & displ,psb_mpi_ipk_integer,rootrank,icomm,info)
! prepare vector to scatter ! prepare vector to scatter
if (me == root) then if (me == root) then

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

@ -73,12 +73,12 @@ subroutine psb_ssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep
call mpi_allgatherv(loc_coo%val,ndx,mpi_complex,& call mpi_allgatherv(loc_coo%val,ndx,mpi_complex,&
& glob_coo%val,nzbr,idisp,& & glob_coo%val,nzbr,idisp,&
& mpi_complex,icomm,minfo) & mpi_complex,icomm,minfo)
if (minfo == psb_success_) call mpi_allgatherv(loc_coo%ia,ndx,psb_mpi_integer,& if (minfo == psb_success_) call mpi_allgatherv(loc_coo%ia,ndx,psb_mpi_ipk_integer,&
& glob_coo%ia,nzbr,idisp,& & glob_coo%ia,nzbr,idisp,&
& psb_mpi_integer,icomm,minfo) & psb_mpi_ipk_integer,icomm,minfo)
if (minfo == psb_success_) call mpi_allgatherv(loc_coo%ja,ndx,psb_mpi_integer,& if (minfo == psb_success_) call mpi_allgatherv(loc_coo%ja,ndx,psb_mpi_ipk_integer,&
& glob_coo%ja,nzbr,idisp,& & glob_coo%ja,nzbr,idisp,&
& psb_mpi_integer,icomm,minfo) & psb_mpi_ipk_integer,icomm,minfo)
if (minfo /= psb_success_) then if (minfo /= psb_success_) then
info = minfo info = minfo

16
base/comm/psb_zscatter.F90
Unescape Escape View File

@ -169,8 +169,8 @@ subroutine psb_zscatterm(globx, locx, desc_a, info, iroot)
end do end do
call psb_loc_to_glob(ltg(1:nrow),desc_a,info) call psb_loc_to_glob(ltg(1:nrow),desc_a,info)
call mpi_gather(nrow,1,psb_mpi_integer,all_dim,& call mpi_gather(nrow,1,psb_mpi_ipk_integer,all_dim,&
& 1,psb_mpi_integer,rootrank,icomm,info) & 1,psb_mpi_ipk_integer,rootrank,icomm,info)
if (me == root) then if (me == root) then
displ(1)=0 displ(1)=0
@ -190,8 +190,8 @@ subroutine psb_zscatterm(globx, locx, desc_a, info, iroot)
end if end if
call mpi_gatherv(ltg,nrow,& call mpi_gatherv(ltg,nrow,&
& psb_mpi_integer,l_t_g_all,all_dim,& & psb_mpi_ipk_integer,l_t_g_all,all_dim,&
& displ,psb_mpi_integer,rootrank,icomm,info) & displ,psb_mpi_ipk_integer,rootrank,icomm,info)
do c=1, k do c=1, k
@ -383,8 +383,8 @@ subroutine psb_zscatterv(globx, locx, desc_a, info, iroot)
call psb_loc_to_glob(ltg(1:nrow),desc_a,info) call psb_loc_to_glob(ltg(1:nrow),desc_a,info)
call mpi_gather(nrow,1,psb_mpi_integer,all_dim,& call mpi_gather(nrow,1,psb_mpi_ipk_integer,all_dim,&
& 1,psb_mpi_integer,rootrank,icomm,info) & 1,psb_mpi_ipk_integer,rootrank,icomm,info)
if(me == root) then if(me == root) then
displ(1)=0 displ(1)=0
@ -401,8 +401,8 @@ subroutine psb_zscatterv(globx, locx, desc_a, info, iroot)
end if end if
call mpi_gatherv(ltg,nrow,& call mpi_gatherv(ltg,nrow,&
& psb_mpi_integer,l_t_g_all,all_dim,& & psb_mpi_ipk_integer,l_t_g_all,all_dim,&
& displ,psb_mpi_integer,rootrank,icomm,info) & displ,psb_mpi_ipk_integer,rootrank,icomm,info)
! prepare vector to scatter ! prepare vector to scatter
if (me == root) then if (me == root) then

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

@ -73,12 +73,12 @@ subroutine psb_zsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep
call mpi_allgatherv(loc_coo%val,ndx,mpi_complex,& call mpi_allgatherv(loc_coo%val,ndx,mpi_complex,&
& glob_coo%val,nzbr,idisp,& & glob_coo%val,nzbr,idisp,&
& mpi_complex,icomm,minfo) & mpi_complex,icomm,minfo)
if (minfo == psb_success_) call mpi_allgatherv(loc_coo%ia,ndx,psb_mpi_integer,& if (minfo == psb_success_) call mpi_allgatherv(loc_coo%ia,ndx,psb_mpi_ipk_integer,&
& glob_coo%ia,nzbr,idisp,& & glob_coo%ia,nzbr,idisp,&
& psb_mpi_integer,icomm,minfo) & psb_mpi_ipk_integer,icomm,minfo)
if (minfo == psb_success_) call mpi_allgatherv(loc_coo%ja,ndx,psb_mpi_integer,& if (minfo == psb_success_) call mpi_allgatherv(loc_coo%ja,ndx,psb_mpi_ipk_integer,&
& glob_coo%ja,nzbr,idisp,& & glob_coo%ja,nzbr,idisp,&
& psb_mpi_integer,icomm,minfo) & psb_mpi_ipk_integer,icomm,minfo)
if (minfo /= psb_success_) then if (minfo /= psb_success_) then
info = minfo info = minfo

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

@ -134,8 +134,8 @@ subroutine psb_indx_map_fnd_owner(idx,iprc,idxmap,info)
t3 = psb_wtime() t3 = psb_wtime()
end if end if
call mpi_allgatherv(idx,hsz(me+1),psb_mpi_integer,& call mpi_allgatherv(idx,hsz(me+1),psb_mpi_ipk_integer,&
& hproc,hsz,hidx,psb_mpi_integer,& & hproc,hsz,hidx,psb_mpi_ipk_integer,&
& icomm,info) & icomm,info)
if (gettime) then if (gettime) then
tamx = psb_wtime() - t3 tamx = psb_wtime() - t3
@ -178,7 +178,7 @@ subroutine psb_indx_map_fnd_owner(idx,iprc,idxmap,info)
end if end if
! Collect all the answers with alltoallv (need sizes) ! Collect all the answers with alltoallv (need sizes)
call mpi_alltoall(sdsz,1,psb_mpi_integer,rvsz,1,mpi_integer,icomm,info) call mpi_alltoall(sdsz,1,psb_mpi_ipk_integer,rvsz,1,psb_mpi_def_integer,icomm,info)
isz = sum(rvsz) isz = sum(rvsz)
@ -192,8 +192,8 @@ subroutine psb_indx_map_fnd_owner(idx,iprc,idxmap,info)
rvidx(ip) = j rvidx(ip) = j
j = j + rvsz(ip) j = j + rvsz(ip)
end do end do
call mpi_alltoallv(hproc,sdsz,sdidx,psb_mpi_integer,& call mpi_alltoallv(hproc,sdsz,sdidx,psb_mpi_ipk_integer,&
& answers(:,1),rvsz,rvidx,psb_mpi_integer,& & answers(:,1),rvsz,rvidx,psb_mpi_ipk_integer,&
& icomm,info) & icomm,info)
if (gettime) then if (gettime) then
tamx = psb_wtime() - t3 + tamx tamx = psb_wtime() - t3 + tamx

6
base/internals/psi_desc_index.F90
Unescape Escape View File

@ -186,7 +186,7 @@ subroutine psi_desc_index(desc,index_in,dep_list,&
i = i + nerv + 1 i = i + nerv + 1
end do end do
ihinsz=i ihinsz=i
call mpi_alltoall(sdsz,1,mpi_integer,rvsz,1,mpi_integer,icomm,minfo) call mpi_alltoall(sdsz,1,psb_mpi_def_integer,rvsz,1,psb_mpi_def_integer,icomm,minfo)
if (minfo /= psb_success_) then if (minfo /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='mpi_alltoall') call psb_errpush(psb_err_from_subroutine_,name,a_err='mpi_alltoall')
goto 9999 goto 9999
@ -292,8 +292,8 @@ subroutine psi_desc_index(desc,index_in,dep_list,&
idxr = idxr + rvsz(proc+1) idxr = idxr + rvsz(proc+1)
end do end do
call mpi_alltoallv(sndbuf,sdsz,bsdindx,psb_mpi_integer,& call mpi_alltoallv(sndbuf,sdsz,bsdindx,psb_mpi_ipk_integer,&
& rcvbuf,rvsz,brvindx,psb_mpi_integer,icomm,minfo) & rcvbuf,rvsz,brvindx,psb_mpi_ipk_integer,icomm,minfo)
if (minfo /= psb_success_) then if (minfo /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='mpi_alltoallv') call psb_errpush(psb_err_from_subroutine_,name,a_err='mpi_alltoallv')
goto 9999 goto 9999

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

@ -271,8 +271,8 @@ subroutine psi_extract_dep_list(ictxt,is_bld,is_upd,desc_str,dep_list,&
goto 9999 goto 9999
endif endif
itmp(1:dl_lda) = dep_list(1:dl_lda,me) itmp(1:dl_lda) = dep_list(1:dl_lda,me)
call mpi_allgather(itmp,dl_lda,psb_mpi_integer,& call mpi_allgather(itmp,dl_lda,psb_mpi_ipk_integer,&
& dep_list,dl_lda,psb_mpi_integer,icomm,info) & dep_list,dl_lda,psb_mpi_ipk_integer,icomm,info)
deallocate(itmp,stat=info) deallocate(itmp,stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_alloc_dealloc_ info=psb_err_alloc_dealloc_

30
base/internals/psi_iswapdata.F90
Unescape Escape View File

@ -302,8 +302,8 @@ subroutine psi_iswapidxm(iictxt,iicomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,wo
! swap elements using mpi_alltoallv ! swap elements using mpi_alltoallv
call mpi_alltoallv(sndbuf,sdsz,bsdidx,& call mpi_alltoallv(sndbuf,sdsz,bsdidx,&
& psb_mpi_integer,rcvbuf,rvsz,& & psb_mpi_ipk_integer,rcvbuf,rvsz,&
& brvidx,psb_mpi_integer,icomm,iret) & brvidx,psb_mpi_ipk_integer,icomm,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
@ -363,7 +363,7 @@ subroutine psi_iswapidxm(iictxt,iicomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,wo
if ((nerv>0).and.(proc_to_comm /= me)) then if ((nerv>0).and.(proc_to_comm /= me)) then
p2ptag = psb_int_swap_tag p2ptag = psb_int_swap_tag
call mpi_irecv(rcvbuf(rcv_pt),n*nerv,& call mpi_irecv(rcvbuf(rcv_pt),n*nerv,&
& psb_mpi_integer,prcid(i),& & psb_mpi_ipk_integer,prcid(i),&
& p2ptag, icomm,rvhd(i),iret) & p2ptag, icomm,rvhd(i),iret)
end if end if
rcv_pt = rcv_pt + n*nerv rcv_pt = rcv_pt + n*nerv
@ -388,11 +388,11 @@ subroutine psi_iswapidxm(iictxt,iicomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,wo
if ((nesd>0).and.(proc_to_comm /= me)) then if ((nesd>0).and.(proc_to_comm /= me)) then
if (usersend) then if (usersend) then
call mpi_rsend(sndbuf(snd_pt),n*nesd,& call mpi_rsend(sndbuf(snd_pt),n*nesd,&
& psb_mpi_integer,prcid(i),& & psb_mpi_ipk_integer,prcid(i),&
& p2ptag,icomm,iret) & p2ptag,icomm,iret)
else else
call mpi_send(sndbuf(snd_pt),n*nesd,& call mpi_send(sndbuf(snd_pt),n*nesd,&
& psb_mpi_integer,prcid(i),& & psb_mpi_ipk_integer,prcid(i),&
& p2ptag,icomm,iret) & p2ptag,icomm,iret)
end if end if
@ -801,8 +801,8 @@ subroutine psi_iswapidxv(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,work
! swap elements using mpi_alltoallv ! swap elements using mpi_alltoallv
call mpi_alltoallv(sndbuf,sdsz,bsdidx,& call mpi_alltoallv(sndbuf,sdsz,bsdidx,&
& psb_mpi_integer,rcvbuf,rvsz,& & psb_mpi_ipk_integer,rcvbuf,rvsz,&
& brvidx,psb_mpi_integer,icomm,iret) & brvidx,psb_mpi_ipk_integer,icomm,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
@ -859,7 +859,7 @@ subroutine psi_iswapidxv(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,work
if ((nerv>0).and.(proc_to_comm /= me)) then if ((nerv>0).and.(proc_to_comm /= me)) then
p2ptag = psb_int_swap_tag p2ptag = psb_int_swap_tag
call mpi_irecv(rcvbuf(rcv_pt),nerv,& call mpi_irecv(rcvbuf(rcv_pt),nerv,&
& psb_mpi_integer,prcid(i),& & psb_mpi_ipk_integer,prcid(i),&
& p2ptag, icomm,rvhd(i),iret) & p2ptag, icomm,rvhd(i),iret)
end if end if
rcv_pt = rcv_pt + nerv rcv_pt = rcv_pt + nerv
@ -884,11 +884,11 @@ subroutine psi_iswapidxv(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,work
if ((nesd>0).and.(proc_to_comm /= me)) then if ((nesd>0).and.(proc_to_comm /= me)) then
if (usersend) then if (usersend) then
call mpi_rsend(sndbuf(snd_pt),nesd,& call mpi_rsend(sndbuf(snd_pt),nesd,&
& psb_mpi_integer,prcid(i),& & psb_mpi_ipk_integer,prcid(i),&
& p2ptag,icomm,iret) & p2ptag,icomm,iret)
else else
call mpi_send(sndbuf(snd_pt),nesd,& call mpi_send(sndbuf(snd_pt),nesd,&
& psb_mpi_integer,prcid(i),& & psb_mpi_ipk_integer,prcid(i),&
& p2ptag,icomm,iret) & p2ptag,icomm,iret)
end if end if
@ -1238,8 +1238,8 @@ end subroutine psi_iswapidxv
!!$ !!$
!!$ ! swap elements using mpi_alltoallv !!$ ! swap elements using mpi_alltoallv
!!$ call mpi_alltoallv(sndbuf,sdsz,bsdidx,& !!$ call mpi_alltoallv(sndbuf,sdsz,bsdidx,&
!!$ & psb_mpi_integer,rcvbuf,rvsz,& !!$ & psb_mpi_ipk_integer,rcvbuf,rvsz,&
!!$ & brvidx,psb_mpi_integer,icomm,iret) !!$ & brvidx,psb_mpi_ipk_integer,icomm,iret)
!!$ if(iret /= mpi_success) then !!$ if(iret /= mpi_success) then
!!$ ierr(1) = iret !!$ ierr(1) = iret
!!$ info=psb_err_mpi_error_ !!$ info=psb_err_mpi_error_
@ -1296,7 +1296,7 @@ end subroutine psi_iswapidxv
!!$ if ((nerv>0).and.(proc_to_comm /= me)) then !!$ if ((nerv>0).and.(proc_to_comm /= me)) then
!!$ p2ptag = psb_int_swap_tag !!$ p2ptag = psb_int_swap_tag
!!$ call mpi_irecv(rcvbuf(rcv_pt),nerv,& !!$ call mpi_irecv(rcvbuf(rcv_pt),nerv,&
!!$ & psb_mpi_integer,prcid(i),& !!$ & psb_mpi_ipk_integer,prcid(i),&
!!$ & p2ptag, icomm,rvhd(i),iret) !!$ & p2ptag, icomm,rvhd(i),iret)
!!$ end if !!$ end if
!!$ rcv_pt = rcv_pt + nerv !!$ rcv_pt = rcv_pt + nerv
@ -1321,11 +1321,11 @@ end subroutine psi_iswapidxv
!!$ if ((nesd>0).and.(proc_to_comm /= me)) then !!$ if ((nesd>0).and.(proc_to_comm /= me)) then
!!$ if (usersend) then !!$ if (usersend) then
!!$ call mpi_rsend(sndbuf(snd_pt),nesd,& !!$ call mpi_rsend(sndbuf(snd_pt),nesd,&
!!$ & psb_mpi_integer,prcid(i),& !!$ & psb_mpi_ipk_integer,prcid(i),&
!!$ & p2ptag,icomm,iret) !!$ & p2ptag,icomm,iret)
!!$ else !!$ else
!!$ call mpi_send(sndbuf(snd_pt),nesd,& !!$ call mpi_send(sndbuf(snd_pt),nesd,&
!!$ & psb_mpi_integer,prcid(i),& !!$ & psb_mpi_ipk_integer,prcid(i),&
!!$ & p2ptag,icomm,iret) !!$ & p2ptag,icomm,iret)
!!$ end if !!$ end if
!!$ !!$

30
base/internals/psi_iswaptran.F90
Unescape Escape View File

@ -320,8 +320,8 @@ subroutine psi_itranidxm(iictxt,iicomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,wo
! swap elements using mpi_alltoallv ! swap elements using mpi_alltoallv
call mpi_alltoallv(rcvbuf,rvsz,brvidx,& call mpi_alltoallv(rcvbuf,rvsz,brvidx,&
& psb_mpi_integer,& & psb_mpi_ipk_integer,&
& sndbuf,sdsz,bsdidx,psb_mpi_integer,icomm,iret) & sndbuf,sdsz,bsdidx,psb_mpi_ipk_integer,icomm,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
@ -378,7 +378,7 @@ subroutine psi_itranidxm(iictxt,iicomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,wo
if ((nesd>0).and.(proc_to_comm /= me)) then if ((nesd>0).and.(proc_to_comm /= me)) then
p2ptag = psb_int_swap_tag p2ptag = psb_int_swap_tag
call mpi_irecv(sndbuf(snd_pt),n*nesd,& call mpi_irecv(sndbuf(snd_pt),n*nesd,&
& psb_mpi_integer,prcid(i),& & psb_mpi_ipk_integer,prcid(i),&
& p2ptag,icomm,rvhd(i),iret) & p2ptag,icomm,rvhd(i),iret)
end if end if
rcv_pt = rcv_pt + n*nerv rcv_pt = rcv_pt + n*nerv
@ -402,11 +402,11 @@ subroutine psi_itranidxm(iictxt,iicomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,wo
p2ptag = psb_int_swap_tag p2ptag = psb_int_swap_tag
if (usersend) then if (usersend) then
call mpi_rsend(rcvbuf(rcv_pt),n*nerv,& call mpi_rsend(rcvbuf(rcv_pt),n*nerv,&
& psb_mpi_integer,prcid(i),& & psb_mpi_ipk_integer,prcid(i),&
& p2ptag,icomm,iret) & p2ptag,icomm,iret)
else else
call mpi_send(rcvbuf(rcv_pt),n*nerv,& call mpi_send(rcvbuf(rcv_pt),n*nerv,&
& psb_mpi_integer,prcid(i),& & psb_mpi_ipk_integer,prcid(i),&
& p2ptag,icomm,iret) & p2ptag,icomm,iret)
end if end if
@ -824,8 +824,8 @@ subroutine psi_itranidxv(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,work
! swap elements using mpi_alltoallv ! swap elements using mpi_alltoallv
call mpi_alltoallv(rcvbuf,rvsz,brvidx,& call mpi_alltoallv(rcvbuf,rvsz,brvidx,&
& psb_mpi_integer,& & psb_mpi_ipk_integer,&
& sndbuf,sdsz,bsdidx,psb_mpi_integer,icomm,iret) & sndbuf,sdsz,bsdidx,psb_mpi_ipk_integer,icomm,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
@ -882,7 +882,7 @@ subroutine psi_itranidxv(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,work
if ((nesd>0).and.(proc_to_comm /= me)) then if ((nesd>0).and.(proc_to_comm /= me)) then
p2ptag = psb_int_swap_tag p2ptag = psb_int_swap_tag
call mpi_irecv(sndbuf(snd_pt),nesd,& call mpi_irecv(sndbuf(snd_pt),nesd,&
& psb_mpi_integer,prcid(i),& & psb_mpi_ipk_integer,prcid(i),&
& p2ptag,icomm,rvhd(i),iret) & p2ptag,icomm,rvhd(i),iret)
end if end if
rcv_pt = rcv_pt + nerv rcv_pt = rcv_pt + nerv
@ -906,11 +906,11 @@ subroutine psi_itranidxv(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,work
p2ptag = psb_int_swap_tag p2ptag = psb_int_swap_tag
if (usersend) then if (usersend) then
call mpi_rsend(rcvbuf(rcv_pt),nerv,& call mpi_rsend(rcvbuf(rcv_pt),nerv,&
& psb_mpi_integer,prcid(i),& & psb_mpi_ipk_integer,prcid(i),&
& p2ptag, icomm,iret) & p2ptag, icomm,iret)
else else
call mpi_send(rcvbuf(rcv_pt),nerv,& call mpi_send(rcvbuf(rcv_pt),nerv,&
& psb_mpi_integer,prcid(i),& & psb_mpi_ipk_integer,prcid(i),&
& p2ptag, icomm,iret) & p2ptag, icomm,iret)
end if end if
@ -1273,8 +1273,8 @@ end subroutine psi_itranidxv
!!$ !!$
!!$ ! swap elements using mpi_alltoallv !!$ ! swap elements using mpi_alltoallv
!!$ call mpi_alltoallv(rcvbuf,rvsz,brvidx,& !!$ call mpi_alltoallv(rcvbuf,rvsz,brvidx,&
!!$ & psb_mpi_integer,& !!$ & psb_mpi_ipk_integer,&
!!$ & sndbuf,sdsz,bsdidx,psb_mpi_integer,icomm,iret) !!$ & sndbuf,sdsz,bsdidx,psb_mpi_ipk_integer,icomm,iret)
!!$ if(iret /= mpi_success) then !!$ if(iret /= mpi_success) then
!!$ ierr(1) = iret !!$ ierr(1) = iret
!!$ info=psb_err_mpi_error_ !!$ info=psb_err_mpi_error_
@ -1331,7 +1331,7 @@ end subroutine psi_itranidxv
!!$ if ((nesd>0).and.(proc_to_comm /= me)) then !!$ if ((nesd>0).and.(proc_to_comm /= me)) then
!!$ p2ptag = psb_int_swap_tag !!$ p2ptag = psb_int_swap_tag
!!$ call mpi_irecv(sndbuf(snd_pt),nesd,& !!$ call mpi_irecv(sndbuf(snd_pt),nesd,&
!!$ & psb_mpi_integer,prcid(i),& !!$ & psb_mpi_ipk_integer,prcid(i),&
!!$ & p2ptag,icomm,rvhd(i),iret) !!$ & p2ptag,icomm,rvhd(i),iret)
!!$ end if !!$ end if
!!$ rcv_pt = rcv_pt + nerv !!$ rcv_pt = rcv_pt + nerv
@ -1355,11 +1355,11 @@ end subroutine psi_itranidxv
!!$ p2ptag = psb_int_swap_tag !!$ p2ptag = psb_int_swap_tag
!!$ if (usersend) then !!$ if (usersend) then
!!$ call mpi_rsend(rcvbuf(rcv_pt),nerv,& !!$ call mpi_rsend(rcvbuf(rcv_pt),nerv,&
!!$ & psb_mpi_integer,prcid(i),& !!$ & psb_mpi_ipk_integer,prcid(i),&
!!$ & p2ptag, icomm,iret) !!$ & p2ptag, icomm,iret)
!!$ else !!$ else
!!$ call mpi_send(rcvbuf(rcv_pt),nerv,& !!$ call mpi_send(rcvbuf(rcv_pt),nerv,&
!!$ & psb_mpi_integer,prcid(i),& !!$ & psb_mpi_ipk_integer,prcid(i),&
!!$ & p2ptag, icomm,iret) !!$ & p2ptag, icomm,iret)
!!$ end if !!$ end if
!!$ !!$

11
base/modules/psb_const_mod.F90
Unescape Escape View File

@ -34,14 +34,14 @@ module psb_const_mod
#if defined(HAVE_ISO_FORTRAN_ENV) #if defined(HAVE_ISO_FORTRAN_ENV)
use iso_fortran_env use iso_fortran_env
#endif #endif
! This is the default integer ! This is the default PSBLAS integer, can be 4 or 8 bytes.
#if defined(LONG_INTEGERS) #if defined(LONG_INTEGERS)
integer, parameter :: ndig=12 integer, parameter :: ndig=12
#else #else
integer, parameter :: ndig=8 integer, parameter :: ndig=8
#endif #endif
integer, parameter :: psb_ipk_ = selected_int_kind(ndig) integer, parameter :: psb_ipk_ = selected_int_kind(ndig)
! This is an 8-byte integer, and normally different from default integer. ! This is always an 8-byte integer.
integer, parameter :: longndig=12 integer, parameter :: longndig=12
integer, parameter :: psb_long_int_k_ = selected_int_kind(longndig) integer, parameter :: psb_long_int_k_ = selected_int_kind(longndig)
! This is always a 4-byte integer, for MPI-related stuff ! This is always a 4-byte integer, for MPI-related stuff
@ -55,7 +55,12 @@ module psb_const_mod
integer(psb_ipk_), parameter :: psb_spk_ = kind(1.e0) integer(psb_ipk_), parameter :: psb_spk_ = kind(1.e0)
integer(psb_ipk_), save :: psb_sizeof_dp, psb_sizeof_sp integer(psb_ipk_), save :: psb_sizeof_dp, psb_sizeof_sp
integer(psb_ipk_), save :: psb_sizeof_int, psb_sizeof_long_int integer(psb_ipk_), save :: psb_sizeof_int, psb_sizeof_long_int
integer(psb_mpik_), save :: psb_mpi_integer !
! Integer type identifiers for MPI operations.
!
integer(psb_mpik_), save :: psb_mpi_ipk_integer
integer(psb_mpik_), save :: psb_mpi_def_integer
integer(psb_mpik_), save :: psb_mpi_lng_integer
! !
! Version ! Version
! !

12
base/modules/psi_bcast_mod.F90
Unescape Escape View File

@ -60,7 +60,7 @@ contains
endif endif
call psb_info(ictxt,iam,np) call psb_info(ictxt,iam,np)
call mpi_bcast(dat,1,psb_mpi_integer,root_,ictxt,info) call mpi_bcast(dat,1,psb_mpi_ipk_integer,root_,ictxt,info)
#endif #endif
end subroutine psb_ibcasts end subroutine psb_ibcasts
@ -85,7 +85,7 @@ contains
endif endif
call psb_info(ictxt,iam,np) call psb_info(ictxt,iam,np)
call mpi_bcast(dat,size(dat),psb_mpi_integer,root_,ictxt,info) call mpi_bcast(dat,size(dat),psb_mpi_ipk_integer,root_,ictxt,info)
#endif #endif
end subroutine psb_ibcastv end subroutine psb_ibcastv
@ -111,7 +111,7 @@ contains
endif endif
call psb_info(ictxt,iam,np) call psb_info(ictxt,iam,np)
call mpi_bcast(dat,size(dat),psb_mpi_integer,root_,ictxt,info) call mpi_bcast(dat,size(dat),psb_mpi_ipk_integer,root_,ictxt,info)
#endif #endif
end subroutine psb_ibcastm end subroutine psb_ibcastm
@ -577,7 +577,7 @@ contains
endif endif
call psb_info(ictxt,iam,np) call psb_info(ictxt,iam,np)
call mpi_bcast(dat,1,mpi_integer8,root_,ictxt,info) call mpi_bcast(dat,1,psb_mpi_lng_integer,root_,ictxt,info)
#endif #endif
end subroutine psb_i8bcasts end subroutine psb_i8bcasts
@ -602,7 +602,7 @@ contains
endif endif
call psb_info(ictxt,iam,np) call psb_info(ictxt,iam,np)
call mpi_bcast(dat,size(dat),mpi_integer8,root_,ictxt,info) call mpi_bcast(dat,size(dat),psb_mpi_lng_integer,root_,ictxt,info)
#endif #endif
end subroutine psb_i8bcastv end subroutine psb_i8bcastv
@ -628,7 +628,7 @@ contains
endif endif
call psb_info(ictxt,iam,np) call psb_info(ictxt,iam,np)
call mpi_bcast(dat,size(dat),mpi_integer8,root_,ictxt,info) call mpi_bcast(dat,size(dat),psb_mpi_lng_integer,root_,ictxt,info)
#endif #endif
end subroutine psb_i8bcastm end subroutine psb_i8bcastm

12
base/modules/psi_comm_buffers_mod.F90
Unescape Escape View File

@ -5,15 +5,15 @@ module mpi
integer(psb_mpik_), parameter :: mpi_success = 0 integer(psb_mpik_), parameter :: mpi_success = 0
integer(psb_mpik_), parameter :: mpi_request_null = 0 integer(psb_mpik_), parameter :: mpi_request_null = 0
integer(psb_mpik_), parameter :: mpi_status_size = 1 integer(psb_mpik_), parameter :: mpi_status_size = 1
integer(psb_mpik_), parameter :: mpi_integer = 1 integer(psb_mpik_), parameter :: psb_mpi_def_integer = 1
integer(psb_mpik_), parameter :: mpi_integer8 = 2 integer(psb_mpik_), parameter :: psb_mpi_lng_integer = 2
integer(psb_mpik_), parameter :: mpi_real = 3 integer(psb_mpik_), parameter :: mpi_real = 3
integer(psb_mpik_), parameter :: mpi_double_precision = 4 integer(psb_mpik_), parameter :: mpi_double_precision = 4
integer(psb_mpik_), parameter :: mpi_complex = 5 integer(psb_mpik_), parameter :: mpi_complex = 5
integer(psb_mpik_), parameter :: mpi_double_complex = 6 integer(psb_mpik_), parameter :: mpi_double_complex = 6
integer(psb_mpik_), parameter :: mpi_character = 7 integer(psb_mpik_), parameter :: mpi_character = 7
integer(psb_mpik_), parameter :: mpi_logical = 8 integer(psb_mpik_), parameter :: mpi_logical = 8
integer(psb_mpik_), parameter :: mpi_integer2 = 9 integer(psb_mpik_), parameter :: psb_mpi_def_integer2 = 9
integer(psb_mpik_), parameter :: mpi_comm_null = -1 integer(psb_mpik_), parameter :: mpi_comm_null = -1
integer(psb_mpik_), parameter :: mpi_comm_world = 1 integer(psb_mpik_), parameter :: mpi_comm_world = 1
@ -257,7 +257,7 @@ contains
write(psb_err_unit,*) 'Fatal memory error inside communication subsystem' write(psb_err_unit,*) 'Fatal memory error inside communication subsystem'
return return
end if end if
call mpi_isend(node%intbuf,size(node%intbuf),psb_mpi_integer,& call mpi_isend(node%intbuf,size(node%intbuf),psb_mpi_ipk_integer,&
& dest,tag,icontxt,node%request,minfo) & dest,tag,icontxt,node%request,minfo)
info = minfo info = minfo
call psb_insert_node(mesg_queue,node) call psb_insert_node(mesg_queue,node)
@ -294,7 +294,7 @@ contains
write(psb_err_unit,*) 'Fatal memory error inside communication subsystem' write(psb_err_unit,*) 'Fatal memory error inside communication subsystem'
return return
end if end if
call mpi_isend(node%int8buf,size(node%int8buf),mpi_integer8,& call mpi_isend(node%int8buf,size(node%int8buf),psb_mpi_lng_integer,&
& dest,tag,icontxt,node%request,minfo) & dest,tag,icontxt,node%request,minfo)
info = minfo info = minfo
call psb_insert_node(mesg_queue,node) call psb_insert_node(mesg_queue,node)
@ -332,7 +332,7 @@ contains
write(psb_err_unit,*) 'Fatal memory error inside communication subsystem' write(psb_err_unit,*) 'Fatal memory error inside communication subsystem'
return return
end if end if
call mpi_isend(node%int2buf,size(node%int2buf),mpi_integer2,& call mpi_isend(node%int2buf,size(node%int2buf),psb_mpi_def_integer2,&
& dest,tag,icontxt,node%request,minfo) & dest,tag,icontxt,node%request,minfo)
info = minfo info = minfo
call psb_insert_node(mesg_queue,node) call psb_insert_node(mesg_queue,node)

24
base/modules/psi_p2p_mod.F90
Unescape Escape View File

@ -847,7 +847,7 @@ contains
#if defined(SERIAL_MPI) #if defined(SERIAL_MPI)
! do nothing ! do nothing
#else #else
call mpi_recv(dat,1,psb_mpi_integer,src,psb_int_tag,ictxt,status,info) call mpi_recv(dat,1,psb_mpi_ipk_integer,src,psb_int_tag,ictxt,status,info)
call psb_test_nodes(psb_mesg_queue) call psb_test_nodes(psb_mesg_queue)
#endif #endif
end subroutine psb_ircvs end subroutine psb_ircvs
@ -870,7 +870,7 @@ contains
integer(psb_mpik_) :: status(mpi_status_size) integer(psb_mpik_) :: status(mpi_status_size)
#if defined(SERIAL_MPI) #if defined(SERIAL_MPI)
#else #else
call mpi_recv(dat,size(dat),psb_mpi_integer,src,psb_int_tag,ictxt,status,info) call mpi_recv(dat,size(dat),psb_mpi_ipk_integer,src,psb_int_tag,ictxt,status,info)
call psb_test_nodes(psb_mesg_queue) call psb_test_nodes(psb_mesg_queue)
#endif #endif
@ -901,13 +901,13 @@ contains
m_ = m m_ = m
ld = size(dat,1) ld = size(dat,1)
n_ = size(dat,2) n_ = size(dat,2)
call mpi_type_vector(n_,m_,ld,psb_mpi_integer,mp_rcv_type,info) call mpi_type_vector(n_,m_,ld,psb_mpi_ipk_integer,mp_rcv_type,info)
if (info == mpi_success) call mpi_type_commit(mp_rcv_type,info) if (info == mpi_success) call mpi_type_commit(mp_rcv_type,info)
if (info == mpi_success) call mpi_recv(dat,1,mp_rcv_type,src,& if (info == mpi_success) call mpi_recv(dat,1,mp_rcv_type,src,&
& psb_int_tag,ictxt,status,info) & psb_int_tag,ictxt,status,info)
if (info == mpi_success) call mpi_type_free(mp_rcv_type,info) if (info == mpi_success) call mpi_type_free(mp_rcv_type,info)
else else
call mpi_recv(dat,size(dat),psb_mpi_integer,src,psb_int_tag,ictxt,status,info) call mpi_recv(dat,size(dat),psb_mpi_ipk_integer,src,psb_int_tag,ictxt,status,info)
end if end if
if (info /= mpi_success) then if (info /= mpi_success) then
write(psb_err_unit,*) 'Error in psb_recv', info write(psb_err_unit,*) 'Error in psb_recv', info
@ -1403,7 +1403,7 @@ contains
#if defined(SERIAL_MPI) #if defined(SERIAL_MPI)
! do nothing ! do nothing
#else #else
call mpi_recv(dat,1,mpi_integer8,src,psb_int8_tag,ictxt,status,info) call mpi_recv(dat,1,psb_mpi_lng_integer,src,psb_int8_tag,ictxt,status,info)
call psb_test_nodes(psb_mesg_queue) call psb_test_nodes(psb_mesg_queue)
#endif #endif
end subroutine psb_i8rcvs end subroutine psb_i8rcvs
@ -1425,7 +1425,7 @@ contains
integer(psb_mpik_) :: status(mpi_status_size) integer(psb_mpik_) :: status(mpi_status_size)
#if defined(SERIAL_MPI) #if defined(SERIAL_MPI)
#else #else
call mpi_recv(dat,size(dat),mpi_integer8,src,psb_int8_tag,ictxt,status,info) call mpi_recv(dat,size(dat),psb_mpi_lng_integer,src,psb_int8_tag,ictxt,status,info)
call psb_test_nodes(psb_mesg_queue) call psb_test_nodes(psb_mesg_queue)
#endif #endif
@ -1455,13 +1455,13 @@ contains
m_ = m m_ = m
ld = size(dat,1) ld = size(dat,1)
n_ = size(dat,2) n_ = size(dat,2)
call mpi_type_vector(n_,m_,ld,mpi_integer8,mp_rcv_type,info) call mpi_type_vector(n_,m_,ld,psb_mpi_lng_integer,mp_rcv_type,info)
if (info == mpi_success) call mpi_type_commit(mp_rcv_type,info) if (info == mpi_success) call mpi_type_commit(mp_rcv_type,info)
if (info == mpi_success) call mpi_recv(dat,1,mp_rcv_type,src,& if (info == mpi_success) call mpi_recv(dat,1,mp_rcv_type,src,&
& psb_int8_tag,ictxt,status,info) & psb_int8_tag,ictxt,status,info)
if (info == mpi_success) call mpi_type_free(mp_rcv_type,info) if (info == mpi_success) call mpi_type_free(mp_rcv_type,info)
else else
call mpi_recv(dat,size(dat),mpi_integer8,src,& call mpi_recv(dat,size(dat),psb_mpi_lng_integer,src,&
& psb_int8_tag,ictxt,status,info) & psb_int8_tag,ictxt,status,info)
end if end if
if (info /= mpi_success) then if (info /= mpi_success) then
@ -1492,7 +1492,7 @@ contains
#if defined(SERIAL_MPI) #if defined(SERIAL_MPI)
! do nothing ! do nothing
#else #else
call mpi_recv(dat,1,mpi_integer2,src,psb_int2_tag,ictxt,status,info) call mpi_recv(dat,1,psb_mpi_def_integer2,src,psb_int2_tag,ictxt,status,info)
call psb_test_nodes(psb_mesg_queue) call psb_test_nodes(psb_mesg_queue)
#endif #endif
end subroutine psb_i2rcvs end subroutine psb_i2rcvs
@ -1514,7 +1514,7 @@ contains
integer(psb_mpik_) :: status(mpi_status_size) integer(psb_mpik_) :: status(mpi_status_size)
#if defined(SERIAL_MPI) #if defined(SERIAL_MPI)
#else #else
call mpi_recv(dat,size(dat),mpi_integer2,src,psb_int2_tag,ictxt,status,info) call mpi_recv(dat,size(dat),psb_mpi_def_integer2,src,psb_int2_tag,ictxt,status,info)
call psb_test_nodes(psb_mesg_queue) call psb_test_nodes(psb_mesg_queue)
#endif #endif
@ -1544,13 +1544,13 @@ contains
m_ = m m_ = m
ld = size(dat,1) ld = size(dat,1)
n_ = size(dat,2) n_ = size(dat,2)
call mpi_type_vector(n_,m_,ld,mpi_integer2,mp_rcv_type,info) call mpi_type_vector(n_,m_,ld,psb_mpi_def_integer2,mp_rcv_type,info)
if (info == mpi_success) call mpi_type_commit(mp_rcv_type,info) if (info == mpi_success) call mpi_type_commit(mp_rcv_type,info)
if (info == mpi_success) call mpi_recv(dat,1,mp_rcv_type,src,& if (info == mpi_success) call mpi_recv(dat,1,mp_rcv_type,src,&
& psb_int2_tag,ictxt,status,info) & psb_int2_tag,ictxt,status,info)
if (info == mpi_success) call mpi_type_free(mp_rcv_type,info) if (info == mpi_success) call mpi_type_free(mp_rcv_type,info)
else else
call mpi_recv(dat,size(dat),mpi_integer2,src,& call mpi_recv(dat,size(dat),psb_mpi_def_integer2,src,&
& psb_int2_tag,ictxt,status,info) & psb_int2_tag,ictxt,status,info)
end if end if
if (info /= mpi_success) then if (info /= mpi_success) then

11
base/modules/psi_penv_mod.F90
Unescape Escape View File

@ -109,10 +109,13 @@ contains
integer(psb_mpik_) :: info integer(psb_mpik_) :: info
#if defined(LONG_INTEGERS) #if defined(LONG_INTEGERS)
psb_mpi_integer = mpi_integer8 psb_mpi_ipk_integer = mpi_integer8
#else #else
psb_mpi_integer = mpi_integer psb_mpi_ipk_integer = mpi_integer
#endif #endif
psb_mpi_def_integer = mpi_integer
psb_mpi_lng_integer = mpi_integer8
#if defined(SERIAL_MPI) #if defined(SERIAL_MPI)
#else #else
@ -495,6 +498,8 @@ contains
! !
! Base binary operations ! Base binary operations
! !
! Note: len & type are always default integer.
!
! !!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!
subroutine psi_iamx_op(inv, outv,len,type) subroutine psi_iamx_op(inv, outv,len,type)
integer(psb_ipk_) :: inv(*),outv(*) integer(psb_ipk_) :: inv(*),outv(*)
@ -536,7 +541,7 @@ contains
integer(psb_long_int_k_) :: inv(*),outv(*) integer(psb_long_int_k_) :: inv(*),outv(*)
integer(psb_mpik_) :: len,type integer(psb_mpik_) :: len,type
integer(psb_mpik_) :: i integer(psb_mpik_) :: i
if (type /= mpi_integer8) then if (type /= psb_mpi_lng_integer) then
write(psb_err_unit,*) 'Invalid type !!!' write(psb_err_unit,*) 'Invalid type !!!'
end if end if
do i=1, len do i=1, len

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

@ -168,10 +168,10 @@ contains
root_ = -1 root_ = -1
endif endif
if (root_ == -1) then if (root_ == -1) then
call mpi_allreduce(dat,dat_,1,psb_mpi_integer,mpi_max,ictxt,info) call mpi_allreduce(dat,dat_,1,psb_mpi_ipk_integer,mpi_max,ictxt,info)
dat = dat_ dat = dat_
else else
call mpi_reduce(dat,dat_,1,psb_mpi_integer,mpi_max,root_,ictxt,info) call mpi_reduce(dat,dat_,1,psb_mpi_ipk_integer,mpi_max,root_,ictxt,info)
dat = dat_ dat = dat_
endif endif
#endif #endif
@ -207,15 +207,15 @@ contains
call psb_realloc(size(dat),dat_,iinfo) call psb_realloc(size(dat),dat_,iinfo)
dat_=dat dat_=dat
if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),& if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),&
& psb_mpi_integer,mpi_max,ictxt,info) & psb_mpi_ipk_integer,mpi_max,ictxt,info)
else else
if (iam == root_) then if (iam == root_) then
call psb_realloc(size(dat),dat_,iinfo) call psb_realloc(size(dat),dat_,iinfo)
dat_=dat dat_=dat
call mpi_reduce(dat_,dat,size(dat),psb_mpi_integer,mpi_max,root_,ictxt,info) call mpi_reduce(dat_,dat,size(dat),psb_mpi_ipk_integer,mpi_max,root_,ictxt,info)
else else
call psb_realloc(1,dat_,iinfo) call psb_realloc(1,dat_,iinfo)
call mpi_reduce(dat,dat_,size(dat),psb_mpi_integer,mpi_max,root_,ictxt,info) call mpi_reduce(dat,dat_,size(dat),psb_mpi_ipk_integer,mpi_max,root_,ictxt,info)
end if end if
endif endif
#endif #endif
@ -251,15 +251,15 @@ contains
call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo)
dat_=dat dat_=dat
if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),& if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),&
& psb_mpi_integer,mpi_max,ictxt,info) & psb_mpi_ipk_integer,mpi_max,ictxt,info)
else else
if (iam == root_) then if (iam == root_) then
call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo)
dat_=dat dat_=dat
call mpi_reduce(dat_,dat,size(dat),psb_mpi_integer,mpi_max,root_,ictxt,info) call mpi_reduce(dat_,dat,size(dat),psb_mpi_ipk_integer,mpi_max,root_,ictxt,info)
else else
call psb_realloc(1,1,dat_,iinfo) call psb_realloc(1,1,dat_,iinfo)
call mpi_reduce(dat,dat_,size(dat),psb_mpi_integer,mpi_max,root_,ictxt,info) call mpi_reduce(dat,dat_,size(dat),psb_mpi_ipk_integer,mpi_max,root_,ictxt,info)
end if end if
endif endif
#endif #endif
@ -292,10 +292,10 @@ contains
root_ = -1 root_ = -1
endif endif
if (root_ == -1) then if (root_ == -1) then
call mpi_allreduce(dat,dat_,1,mpi_integer8,mpi_max,ictxt,info) call mpi_allreduce(dat,dat_,1,psb_mpi_lng_integer,mpi_max,ictxt,info)
dat = dat_ dat = dat_
else else
call mpi_reduce(dat,dat_,1,mpi_integer8,mpi_max,root_,ictxt,info) call mpi_reduce(dat,dat_,1,psb_mpi_lng_integer,mpi_max,root_,ictxt,info)
dat = dat_ dat = dat_
endif endif
#endif #endif
@ -331,15 +331,15 @@ contains
call psb_realloc(size(dat),dat_,iinfo) call psb_realloc(size(dat),dat_,iinfo)
dat_=dat dat_=dat
if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),& if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),&
& mpi_integer8,mpi_max,ictxt,info) & psb_mpi_lng_integer,mpi_max,ictxt,info)
else else
if (iam == root_) then if (iam == root_) then
call psb_realloc(size(dat),dat_,iinfo) call psb_realloc(size(dat),dat_,iinfo)
dat_=dat dat_=dat
call mpi_reduce(dat_,dat,size(dat),mpi_integer8,mpi_max,root_,ictxt,info) call mpi_reduce(dat_,dat,size(dat),psb_mpi_lng_integer,mpi_max,root_,ictxt,info)
else else
call psb_realloc(1,dat_,iinfo) call psb_realloc(1,dat_,iinfo)
call mpi_reduce(dat,dat_,size(dat),mpi_integer8,mpi_max,root_,ictxt,info) call mpi_reduce(dat,dat_,size(dat),psb_mpi_lng_integer,mpi_max,root_,ictxt,info)
end if end if
endif endif
#endif #endif
@ -375,15 +375,15 @@ contains
call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo)
dat_=dat dat_=dat
if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),& if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),&
& mpi_integer8,mpi_max,ictxt,info) & psb_mpi_lng_integer,mpi_max,ictxt,info)
else else
if (iam == root_) then if (iam == root_) then
call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo)
dat_=dat dat_=dat
call mpi_reduce(dat_,dat,size(dat),mpi_integer8,mpi_max,root_,ictxt,info) call mpi_reduce(dat_,dat,size(dat),psb_mpi_lng_integer,mpi_max,root_,ictxt,info)
else else
call psb_realloc(1,1,dat_,iinfo) call psb_realloc(1,1,dat_,iinfo)
call mpi_reduce(dat,dat_,size(dat),mpi_integer8,mpi_max,root_,ictxt,info) call mpi_reduce(dat,dat_,size(dat),psb_mpi_lng_integer,mpi_max,root_,ictxt,info)
end if end if
endif endif
#endif #endif
@ -673,10 +673,10 @@ contains
root_ = -1 root_ = -1
endif endif
if (root_ == -1) then if (root_ == -1) then
call mpi_allreduce(dat,dat_,1,psb_mpi_integer,mpi_min,ictxt,info) call mpi_allreduce(dat,dat_,1,psb_mpi_ipk_integer,mpi_min,ictxt,info)
dat = dat_ dat = dat_
else else
call mpi_reduce(dat,dat_,1,psb_mpi_integer,mpi_min,root_,ictxt,info) call mpi_reduce(dat,dat_,1,psb_mpi_ipk_integer,mpi_min,root_,ictxt,info)
dat = dat_ dat = dat_
endif endif
#endif #endif
@ -712,15 +712,15 @@ contains
call psb_realloc(size(dat),dat_,iinfo) call psb_realloc(size(dat),dat_,iinfo)
dat_=dat dat_=dat
if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),& if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),&
& psb_mpi_integer,mpi_min,ictxt,info) & psb_mpi_ipk_integer,mpi_min,ictxt,info)
else else
if (iam == root_) then if (iam == root_) then
call psb_realloc(size(dat),dat_,iinfo) call psb_realloc(size(dat),dat_,iinfo)
dat_=dat dat_=dat
call mpi_reduce(dat_,dat,size(dat),psb_mpi_integer,mpi_min,root_,ictxt,info) call mpi_reduce(dat_,dat,size(dat),psb_mpi_ipk_integer,mpi_min,root_,ictxt,info)
else else
call psb_realloc(1,dat_,iinfo) call psb_realloc(1,dat_,iinfo)
call mpi_reduce(dat,dat_,size(dat),psb_mpi_integer,mpi_min,root_,ictxt,info) call mpi_reduce(dat,dat_,size(dat),psb_mpi_ipk_integer,mpi_min,root_,ictxt,info)
end if end if
endif endif
#endif #endif
@ -756,15 +756,15 @@ contains
call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo)
dat_=dat dat_=dat
if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),& if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),&
& psb_mpi_integer,mpi_min,ictxt,info) & psb_mpi_ipk_integer,mpi_min,ictxt,info)
else else
if (iam == root_) then if (iam == root_) then
call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo)
dat_=dat dat_=dat
call mpi_reduce(dat_,dat,size(dat),psb_mpi_integer,mpi_min,root_,ictxt,info) call mpi_reduce(dat_,dat,size(dat),psb_mpi_ipk_integer,mpi_min,root_,ictxt,info)
else else
call psb_realloc(1,1,dat_,iinfo) call psb_realloc(1,1,dat_,iinfo)
call mpi_reduce(dat,dat_,size(dat),psb_mpi_integer,mpi_min,root_,ictxt,info) call mpi_reduce(dat,dat_,size(dat),psb_mpi_ipk_integer,mpi_min,root_,ictxt,info)
end if end if
endif endif
#endif #endif
@ -797,10 +797,10 @@ contains
root_ = -1 root_ = -1
endif endif
if (root_ == -1) then if (root_ == -1) then
call mpi_allreduce(dat,dat_,1,mpi_integer8,mpi_min,ictxt,info) call mpi_allreduce(dat,dat_,1,psb_mpi_lng_integer,mpi_min,ictxt,info)
dat = dat_ dat = dat_
else else
call mpi_reduce(dat,dat_,1,mpi_integer8,mpi_min,root_,ictxt,info) call mpi_reduce(dat,dat_,1,psb_mpi_lng_integer,mpi_min,root_,ictxt,info)
dat = dat_ dat = dat_
endif endif
#endif #endif
@ -836,15 +836,15 @@ contains
call psb_realloc(size(dat),dat_,iinfo) call psb_realloc(size(dat),dat_,iinfo)
dat_=dat dat_=dat
if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),& if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),&
& mpi_integer8,mpi_min,ictxt,info) & psb_mpi_lng_integer,mpi_min,ictxt,info)
else else
if (iam == root_) then if (iam == root_) then
call psb_realloc(size(dat),dat_,iinfo) call psb_realloc(size(dat),dat_,iinfo)
dat_=dat dat_=dat
call mpi_reduce(dat_,dat,size(dat),mpi_integer8,mpi_min,root_,ictxt,info) call mpi_reduce(dat_,dat,size(dat),psb_mpi_lng_integer,mpi_min,root_,ictxt,info)
else else
call psb_realloc(1,dat_,iinfo) call psb_realloc(1,dat_,iinfo)
call mpi_reduce(dat,dat_,size(dat),mpi_integer8,mpi_min,root_,ictxt,info) call mpi_reduce(dat,dat_,size(dat),psb_mpi_lng_integer,mpi_min,root_,ictxt,info)
end if end if
endif endif
#endif #endif
@ -880,15 +880,15 @@ contains
call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo)
dat_=dat dat_=dat
if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),& if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),&
& mpi_integer8,mpi_min,ictxt,info) & psb_mpi_lng_integer,mpi_min,ictxt,info)
else else
if (iam == root_) then if (iam == root_) then
call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo)
dat_=dat dat_=dat
call mpi_reduce(dat_,dat,size(dat),mpi_integer8,mpi_min,root_,ictxt,info) call mpi_reduce(dat_,dat,size(dat),psb_mpi_lng_integer,mpi_min,root_,ictxt,info)
else else
call psb_realloc(1,1,dat_,iinfo) call psb_realloc(1,1,dat_,iinfo)
call mpi_reduce(dat,dat_,size(dat),mpi_integer8,mpi_min,root_,ictxt,info) call mpi_reduce(dat,dat_,size(dat),psb_mpi_lng_integer,mpi_min,root_,ictxt,info)
end if end if
endif endif
#endif #endif
@ -1180,10 +1180,10 @@ contains
root_ = -1 root_ = -1
endif endif
if (root_ == -1) then if (root_ == -1) then
call mpi_allreduce(dat,dat_,1,psb_mpi_integer,mpi_iamx_op,ictxt,info) call mpi_allreduce(dat,dat_,1,psb_mpi_ipk_integer,mpi_iamx_op,ictxt,info)
dat = dat_ dat = dat_
else else
call mpi_reduce(dat,dat_,1,psb_mpi_integer,mpi_iamx_op,root_,ictxt,info) call mpi_reduce(dat,dat_,1,psb_mpi_ipk_integer,mpi_iamx_op,root_,ictxt,info)
dat = dat_ dat = dat_
endif endif
@ -1220,15 +1220,15 @@ contains
call psb_realloc(size(dat),dat_,iinfo) call psb_realloc(size(dat),dat_,iinfo)
dat_=dat dat_=dat
if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),& if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),&
& psb_mpi_integer,mpi_iamx_op,ictxt,info) & psb_mpi_ipk_integer,mpi_iamx_op,ictxt,info)
else else
if (iam == root_) then if (iam == root_) then
call psb_realloc(size(dat),dat_,iinfo) call psb_realloc(size(dat),dat_,iinfo)
dat_=dat dat_=dat
call mpi_reduce(dat_,dat,size(dat),psb_mpi_integer,mpi_iamx_op,root_,ictxt,info) call mpi_reduce(dat_,dat,size(dat),psb_mpi_ipk_integer,mpi_iamx_op,root_,ictxt,info)
else else
call psb_realloc(1,dat_,iinfo) call psb_realloc(1,dat_,iinfo)
call mpi_reduce(dat,dat_,size(dat),psb_mpi_integer,mpi_iamx_op,root_,ictxt,info) call mpi_reduce(dat,dat_,size(dat),psb_mpi_ipk_integer,mpi_iamx_op,root_,ictxt,info)
end if end if
endif endif
#endif #endif
@ -1264,15 +1264,15 @@ contains
call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo)
dat_=dat dat_=dat
if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),& if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),&
& psb_mpi_integer,mpi_iamx_op,ictxt,info) & psb_mpi_ipk_integer,mpi_iamx_op,ictxt,info)
else else
if (iam == root_) then if (iam == root_) then
call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo)
dat_=dat dat_=dat
call mpi_reduce(dat_,dat,size(dat),psb_mpi_integer,mpi_iamx_op,root_,ictxt,info) call mpi_reduce(dat_,dat,size(dat),psb_mpi_ipk_integer,mpi_iamx_op,root_,ictxt,info)
else else
call psb_realloc(1,1,dat_,iinfo) call psb_realloc(1,1,dat_,iinfo)
call mpi_reduce(dat,dat_,size(dat),psb_mpi_integer,mpi_iamx_op,root_,ictxt,info) call mpi_reduce(dat,dat_,size(dat),psb_mpi_ipk_integer,mpi_iamx_op,root_,ictxt,info)
end if end if
endif endif
#endif #endif
@ -1307,10 +1307,10 @@ contains
root_ = -1 root_ = -1
endif endif
if (root_ == -1) then if (root_ == -1) then
call mpi_allreduce(dat,dat_,1,mpi_integer8,mpi_i8amx_op,ictxt,info) call mpi_allreduce(dat,dat_,1,psb_mpi_lng_integer,mpi_i8amx_op,ictxt,info)
dat = dat_ dat = dat_
else else
call mpi_reduce(dat,dat_,1,mpi_integer8,mpi_i8amx_op,root_,ictxt,info) call mpi_reduce(dat,dat_,1,psb_mpi_lng_integer,mpi_i8amx_op,root_,ictxt,info)
dat = dat_ dat = dat_
endif endif
@ -1347,15 +1347,15 @@ contains
call psb_realloc(size(dat),dat_,iinfo) call psb_realloc(size(dat),dat_,iinfo)
dat_=dat dat_=dat
if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),& if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),&
& mpi_integer8,mpi_i8amx_op,ictxt,info) & psb_mpi_lng_integer,mpi_i8amx_op,ictxt,info)
else else
if (iam == root_) then if (iam == root_) then
call psb_realloc(size(dat),dat_,iinfo) call psb_realloc(size(dat),dat_,iinfo)
dat_=dat dat_=dat
call mpi_reduce(dat_,dat,size(dat),mpi_integer8,mpi_i8amx_op,root_,ictxt,info) call mpi_reduce(dat_,dat,size(dat),psb_mpi_lng_integer,mpi_i8amx_op,root_,ictxt,info)
else else
call psb_realloc(1,dat_,iinfo) call psb_realloc(1,dat_,iinfo)
call mpi_reduce(dat,dat_,size(dat),mpi_integer8,mpi_i8amx_op,root_,ictxt,info) call mpi_reduce(dat,dat_,size(dat),psb_mpi_lng_integer,mpi_i8amx_op,root_,ictxt,info)
end if end if
endif endif
#endif #endif
@ -1391,15 +1391,15 @@ contains
call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo)
dat_=dat dat_=dat
if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),& if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),&
& mpi_integer8,mpi_i8amx_op,ictxt,info) & psb_mpi_lng_integer,mpi_i8amx_op,ictxt,info)
else else
if (iam == root_) then if (iam == root_) then
call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo)
dat_=dat dat_=dat
call mpi_reduce(dat_,dat,size(dat),mpi_integer8,mpi_i8amx_op,root_,ictxt,info) call mpi_reduce(dat_,dat,size(dat),psb_mpi_lng_integer,mpi_i8amx_op,root_,ictxt,info)
else else
call psb_realloc(1,1,dat_,iinfo) call psb_realloc(1,1,dat_,iinfo)
call mpi_reduce(dat,dat_,size(dat),mpi_integer8,mpi_i8amx_op,root_,ictxt,info) call mpi_reduce(dat,dat_,size(dat),psb_mpi_lng_integer,mpi_i8amx_op,root_,ictxt,info)
end if end if
endif endif
#endif #endif
@ -1939,10 +1939,10 @@ contains
root_ = -1 root_ = -1
endif endif
if (root_ == -1) then if (root_ == -1) then
call mpi_allreduce(dat,dat_,1,psb_mpi_integer,mpi_iamn_op,ictxt,info) call mpi_allreduce(dat,dat_,1,psb_mpi_ipk_integer,mpi_iamn_op,ictxt,info)
dat = dat_ dat = dat_
else else
call mpi_reduce(dat,dat_,1,psb_mpi_integer,mpi_iamn_op,root_,ictxt,info) call mpi_reduce(dat,dat_,1,psb_mpi_ipk_integer,mpi_iamn_op,root_,ictxt,info)
dat = dat_ dat = dat_
endif endif
@ -1979,15 +1979,15 @@ contains
call psb_realloc(size(dat),dat_,iinfo) call psb_realloc(size(dat),dat_,iinfo)
dat_=dat dat_=dat
if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),& if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),&
& psb_mpi_integer,mpi_iamn_op,ictxt,info) & psb_mpi_ipk_integer,mpi_iamn_op,ictxt,info)
else else
if (iam == root_) then if (iam == root_) then
call psb_realloc(size(dat),dat_,iinfo) call psb_realloc(size(dat),dat_,iinfo)
dat_=dat dat_=dat
call mpi_reduce(dat_,dat,size(dat),psb_mpi_integer,mpi_iamn_op,root_,ictxt,info) call mpi_reduce(dat_,dat,size(dat),psb_mpi_ipk_integer,mpi_iamn_op,root_,ictxt,info)
else else
call psb_realloc(1,dat_,iinfo) call psb_realloc(1,dat_,iinfo)
call mpi_reduce(dat,dat_,size(dat),psb_mpi_integer,mpi_iamn_op,root_,ictxt,info) call mpi_reduce(dat,dat_,size(dat),psb_mpi_ipk_integer,mpi_iamn_op,root_,ictxt,info)
end if end if
endif endif
#endif #endif
@ -2023,15 +2023,15 @@ contains
call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo)
dat_=dat dat_=dat
if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),& if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),&
& psb_mpi_integer,mpi_iamn_op,ictxt,info) & psb_mpi_ipk_integer,mpi_iamn_op,ictxt,info)
else else
if (iam == root_) then if (iam == root_) then
call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo)
dat_=dat dat_=dat
call mpi_reduce(dat_,dat,size(dat),psb_mpi_integer,mpi_iamn_op,root_,ictxt,info) call mpi_reduce(dat_,dat,size(dat),psb_mpi_ipk_integer,mpi_iamn_op,root_,ictxt,info)
else else
call psb_realloc(1,1,dat_,iinfo) call psb_realloc(1,1,dat_,iinfo)
call mpi_reduce(dat,dat_,size(dat),psb_mpi_integer,mpi_iamn_op,root_,ictxt,info) call mpi_reduce(dat,dat_,size(dat),psb_mpi_ipk_integer,mpi_iamn_op,root_,ictxt,info)
end if end if
endif endif
#endif #endif
@ -2066,10 +2066,10 @@ contains
root_ = -1 root_ = -1
endif endif
if (root_ == -1) then if (root_ == -1) then
call mpi_allreduce(dat,dat_,1,mpi_integer8,mpi_i8amn_op,ictxt,info) call mpi_allreduce(dat,dat_,1,psb_mpi_lng_integer,mpi_i8amn_op,ictxt,info)
dat = dat_ dat = dat_
else else
call mpi_reduce(dat,dat_,1,mpi_integer8,mpi_i8amn_op,root_,ictxt,info) call mpi_reduce(dat,dat_,1,psb_mpi_lng_integer,mpi_i8amn_op,root_,ictxt,info)
dat = dat_ dat = dat_
endif endif
@ -2106,15 +2106,15 @@ contains
call psb_realloc(size(dat),dat_,iinfo) call psb_realloc(size(dat),dat_,iinfo)
dat_=dat dat_=dat
if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),& if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),&
& mpi_integer8,mpi_i8amn_op,ictxt,info) & psb_mpi_lng_integer,mpi_i8amn_op,ictxt,info)
else else
if (iam == root_) then if (iam == root_) then
call psb_realloc(size(dat),dat_,iinfo) call psb_realloc(size(dat),dat_,iinfo)
dat_=dat dat_=dat
call mpi_reduce(dat_,dat,size(dat),mpi_integer8,mpi_i8amn_op,root_,ictxt,info) call mpi_reduce(dat_,dat,size(dat),psb_mpi_lng_integer,mpi_i8amn_op,root_,ictxt,info)
else else
call psb_realloc(1,dat_,iinfo) call psb_realloc(1,dat_,iinfo)
call mpi_reduce(dat,dat_,size(dat),mpi_integer8,mpi_i8amn_op,root_,ictxt,info) call mpi_reduce(dat,dat_,size(dat),psb_mpi_lng_integer,mpi_i8amn_op,root_,ictxt,info)
end if end if
endif endif
#endif #endif
@ -2150,15 +2150,15 @@ contains
call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo)
dat_=dat dat_=dat
if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),& if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),&
& mpi_integer8,mpi_i8amn_op,ictxt,info) & psb_mpi_lng_integer,mpi_i8amn_op,ictxt,info)
else else
if (iam == root_) then if (iam == root_) then
call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo)
dat_=dat dat_=dat
call mpi_reduce(dat_,dat,size(dat),mpi_integer8,mpi_i8amn_op,root_,ictxt,info) call mpi_reduce(dat_,dat,size(dat),psb_mpi_lng_integer,mpi_i8amn_op,root_,ictxt,info)
else else
call psb_realloc(1,1,dat_,iinfo) call psb_realloc(1,1,dat_,iinfo)
call mpi_reduce(dat,dat_,size(dat),mpi_integer8,mpi_i8amn_op,root_,ictxt,info) call mpi_reduce(dat,dat_,size(dat),psb_mpi_lng_integer,mpi_i8amn_op,root_,ictxt,info)
end if end if
endif endif
#endif #endif
@ -2697,10 +2697,10 @@ contains
root_ = -1 root_ = -1
endif endif
if (root_ == -1) then if (root_ == -1) then
call mpi_allreduce(dat,dat_,1,psb_mpi_integer,mpi_sum,ictxt,info) call mpi_allreduce(dat,dat_,1,psb_mpi_ipk_integer,mpi_sum,ictxt,info)
dat = dat_ dat = dat_
else else
call mpi_reduce(dat,dat_,1,psb_mpi_integer,mpi_sum,root_,ictxt,info) call mpi_reduce(dat,dat_,1,psb_mpi_ipk_integer,mpi_sum,root_,ictxt,info)
dat = dat_ dat = dat_
endif endif
@ -2738,15 +2738,15 @@ contains
dat_=dat dat_=dat
if (iinfo == psb_success_)& if (iinfo == psb_success_)&
& call mpi_allreduce(dat_,dat,size(dat),& & call mpi_allreduce(dat_,dat,size(dat),&
& psb_mpi_integer,mpi_sum,ictxt,info) & psb_mpi_ipk_integer,mpi_sum,ictxt,info)
else else
if (iam == root_) then if (iam == root_) then
call psb_realloc(size(dat),dat_,iinfo) call psb_realloc(size(dat),dat_,iinfo)
dat_=dat dat_=dat
call mpi_reduce(dat_,dat,size(dat),psb_mpi_integer,mpi_sum,root_,ictxt,info) call mpi_reduce(dat_,dat,size(dat),psb_mpi_ipk_integer,mpi_sum,root_,ictxt,info)
else else
call psb_realloc(1,dat_,iinfo) call psb_realloc(1,dat_,iinfo)
call mpi_reduce(dat,dat_,size(dat),psb_mpi_integer,mpi_sum,root_,ictxt,info) call mpi_reduce(dat,dat_,size(dat),psb_mpi_ipk_integer,mpi_sum,root_,ictxt,info)
end if end if
endif endif
#endif #endif
@ -2782,15 +2782,15 @@ contains
call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo)
dat_=dat dat_=dat
if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),& if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),&
& psb_mpi_integer,mpi_sum,ictxt,info) & psb_mpi_ipk_integer,mpi_sum,ictxt,info)
else else
if (iam == root_) then if (iam == root_) then
call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo)
dat_=dat dat_=dat
call mpi_reduce(dat_,dat,size(dat),psb_mpi_integer,mpi_sum,root_,ictxt,info) call mpi_reduce(dat_,dat,size(dat),psb_mpi_ipk_integer,mpi_sum,root_,ictxt,info)
else else
call psb_realloc(1,1,dat_,iinfo) call psb_realloc(1,1,dat_,iinfo)
call mpi_reduce(dat,dat_,size(dat),psb_mpi_integer,mpi_sum,root_,ictxt,info) call mpi_reduce(dat,dat_,size(dat),psb_mpi_ipk_integer,mpi_sum,root_,ictxt,info)
end if end if
endif endif
#endif #endif
@ -2825,10 +2825,10 @@ contains
root_ = -1 root_ = -1
endif endif
if (root_ == -1) then if (root_ == -1) then
call mpi_allreduce(dat,dat_,1,mpi_integer2,mpi_sum,ictxt,info) call mpi_allreduce(dat,dat_,1,psb_mpi_def_integer2,mpi_sum,ictxt,info)
dat = dat_ dat = dat_
else else
call mpi_reduce(dat,dat_,1,mpi_integer2,mpi_sum,root_,ictxt,info) call mpi_reduce(dat,dat_,1,psb_mpi_def_integer2,mpi_sum,root_,ictxt,info)
dat = dat_ dat = dat_
endif endif
@ -2865,14 +2865,14 @@ contains
call psb_realloc(size(dat),dat_,iinfo) call psb_realloc(size(dat),dat_,iinfo)
dat_=dat dat_=dat
if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),& if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),&
& mpi_integer2,mpi_sum,ictxt,info) & psb_mpi_def_integer2,mpi_sum,ictxt,info)
else else
if (iam == root_) then if (iam == root_) then
call psb_realloc(size(dat),dat_,iinfo) call psb_realloc(size(dat),dat_,iinfo)
dat_=dat dat_=dat
call mpi_reduce(dat_,dat,size(dat),mpi_integer2,mpi_sum,root_,ictxt,info) call mpi_reduce(dat_,dat,size(dat),psb_mpi_def_integer2,mpi_sum,root_,ictxt,info)
else else
call mpi_reduce(dat,dat_,size(dat),mpi_integer2,mpi_sum,root_,ictxt,info) call mpi_reduce(dat,dat_,size(dat),psb_mpi_def_integer2,mpi_sum,root_,ictxt,info)
end if end if
endif endif
#endif #endif
@ -2908,14 +2908,14 @@ contains
call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo)
dat_=dat dat_=dat
if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),& if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),&
& mpi_integer2,mpi_sum,ictxt,info) & psb_mpi_def_integer2,mpi_sum,ictxt,info)
else else
if (iam == root_) then if (iam == root_) then
call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo)
dat_=dat dat_=dat
call mpi_reduce(dat_,dat,size(dat),mpi_integer2,mpi_sum,root_,ictxt,info) call mpi_reduce(dat_,dat,size(dat),psb_mpi_def_integer2,mpi_sum,root_,ictxt,info)
else else
call mpi_reduce(dat,dat_,size(dat),mpi_integer2,mpi_sum,root_,ictxt,info) call mpi_reduce(dat,dat_,size(dat),psb_mpi_def_integer2,mpi_sum,root_,ictxt,info)
end if end if
endif endif
#endif #endif
@ -2952,10 +2952,10 @@ contains
root_ = -1 root_ = -1
endif endif
if (root_ == -1) then if (root_ == -1) then
call mpi_allreduce(dat,dat_,1,mpi_integer8,mpi_sum,ictxt,info) call mpi_allreduce(dat,dat_,1,psb_mpi_lng_integer,mpi_sum,ictxt,info)
dat = dat_ dat = dat_
else else
call mpi_reduce(dat,dat_,1,mpi_integer8,mpi_sum,root_,ictxt,info) call mpi_reduce(dat,dat_,1,psb_mpi_lng_integer,mpi_sum,root_,ictxt,info)
dat = dat_ dat = dat_
endif endif
@ -2992,15 +2992,15 @@ contains
call psb_realloc(size(dat),dat_,iinfo) call psb_realloc(size(dat),dat_,iinfo)
dat_=dat dat_=dat
if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),& if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),&
& mpi_integer8,mpi_sum,ictxt,info) & psb_mpi_lng_integer,mpi_sum,ictxt,info)
else else
if (iam == root_) then if (iam == root_) then
call psb_realloc(size(dat),dat_,iinfo) call psb_realloc(size(dat),dat_,iinfo)
dat_=dat dat_=dat
call mpi_reduce(dat_,dat,size(dat),mpi_integer8,mpi_sum,root_,ictxt,info) call mpi_reduce(dat_,dat,size(dat),psb_mpi_lng_integer,mpi_sum,root_,ictxt,info)
else else
call psb_realloc(1,dat_,iinfo) call psb_realloc(1,dat_,iinfo)
call mpi_reduce(dat,dat_,size(dat),mpi_integer8,mpi_sum,root_,ictxt,info) call mpi_reduce(dat,dat_,size(dat),psb_mpi_lng_integer,mpi_sum,root_,ictxt,info)
end if end if
endif endif
#endif #endif
@ -3036,15 +3036,15 @@ contains
call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo)
dat_=dat dat_=dat
if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),& if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),&
& mpi_integer8,mpi_sum,ictxt,info) & psb_mpi_lng_integer,mpi_sum,ictxt,info)
else else
if (iam == root_) then if (iam == root_) then
call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo)
dat_=dat dat_=dat
call mpi_reduce(dat_,dat,size(dat),mpi_integer8,mpi_sum,root_,ictxt,info) call mpi_reduce(dat_,dat,size(dat),psb_mpi_lng_integer,mpi_sum,root_,ictxt,info)
else else
call psb_realloc(1,1,dat_,iinfo) call psb_realloc(1,1,dat_,iinfo)
call mpi_reduce(dat,dat_,size(dat),mpi_integer8,mpi_sum,root_,ictxt,info) call mpi_reduce(dat,dat_,size(dat),psb_mpi_lng_integer,mpi_sum,root_,ictxt,info)
end if end if
endif endif
#endif #endif

6
base/tools/psb_ccdbldext.F90
Unescape Escape View File

@ -467,7 +467,7 @@ Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info, extype)
! accumulated RECV requests, we have an all-to-all to build ! accumulated RECV requests, we have an all-to-all to build
! matchings SENDs. ! matchings SENDs.
! !
call mpi_alltoall(sdsz,1,mpi_integer,rvsz,1,mpi_integer,icomm,minfo) call mpi_alltoall(sdsz,1,psb_mpi_def_integer,rvsz,1,psb_mpi_def_integer,icomm,minfo)
if (minfo /= psb_success_) then if (minfo /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='mpi_alltoall') call psb_errpush(info,name,a_err='mpi_alltoall')
@ -502,8 +502,8 @@ Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info, extype)
lworkr = max(iszr,1) lworkr = max(iszr,1)
end if end if
call mpi_alltoallv(works,sdsz,bsdindx,psb_mpi_integer,& call mpi_alltoallv(works,sdsz,bsdindx,psb_mpi_ipk_integer,&
& workr,rvsz,brvindx,psb_mpi_integer,icomm,minfo) & workr,rvsz,brvindx,psb_mpi_ipk_integer,icomm,minfo)
if (minfo /= psb_success_) then if (minfo /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='mpi_alltoallv') call psb_errpush(info,name,a_err='mpi_alltoallv')

10
base/tools/psb_csphalo.F90
Unescape Escape View File

@ -189,7 +189,7 @@ Subroutine psb_csphalo(a,desc_a,blk,info,rowcnv,colcnv,&
counter = counter+n_el_send+3 counter = counter+n_el_send+3
Enddo Enddo
call mpi_alltoall(sdsz,1,psb_mpi_integer,rvsz,1,psb_mpi_integer,icomm,info) call mpi_alltoall(sdsz,1,psb_mpi_ipk_integer,rvsz,1,psb_mpi_ipk_integer,icomm,info)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
ch_err='mpi_alltoall' ch_err='mpi_alltoall'
@ -274,10 +274,10 @@ Subroutine psb_csphalo(a,desc_a,blk,info,rowcnv,colcnv,&
call mpi_alltoallv(valsnd,sdsz,bsdindx,mpi_complex,& call mpi_alltoallv(valsnd,sdsz,bsdindx,mpi_complex,&
& acoo%val,rvsz,brvindx,mpi_complex,icomm,info) & acoo%val,rvsz,brvindx,mpi_complex,icomm,info)
call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_integer,& call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_ipk_integer,&
& acoo%ia,rvsz,brvindx,psb_mpi_integer,icomm,info) & acoo%ia,rvsz,brvindx,psb_mpi_ipk_integer,icomm,info)
call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_integer,& call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_ipk_integer,&
& acoo%ja,rvsz,brvindx,psb_mpi_integer,icomm,info) & acoo%ja,rvsz,brvindx,psb_mpi_ipk_integer,icomm,info)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
ch_err='mpi_alltoallv' ch_err='mpi_alltoallv'

6
base/tools/psb_dcdbldext.F90
Unescape Escape View File

@ -467,7 +467,7 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype)
! accumulated RECV requests, we have an all-to-all to build ! accumulated RECV requests, we have an all-to-all to build
! matchings SENDs. ! matchings SENDs.
! !
call mpi_alltoall(sdsz,1,mpi_integer,rvsz,1,mpi_integer,icomm,minfo) call mpi_alltoall(sdsz,1,psb_mpi_def_integer,rvsz,1,psb_mpi_def_integer,icomm,minfo)
if (minfo /= psb_success_) then if (minfo /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='mpi_alltoall') call psb_errpush(info,name,a_err='mpi_alltoall')
@ -502,8 +502,8 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype)
lworkr = max(iszr,1) lworkr = max(iszr,1)
end if end if
call mpi_alltoallv(works,sdsz,bsdindx,psb_mpi_integer,& call mpi_alltoallv(works,sdsz,bsdindx,psb_mpi_ipk_integer,&
& workr,rvsz,brvindx,psb_mpi_integer,icomm,minfo) & workr,rvsz,brvindx,psb_mpi_ipk_integer,icomm,minfo)
if (minfo /= psb_success_) then if (minfo /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='mpi_alltoallv') call psb_errpush(info,name,a_err='mpi_alltoallv')

10
base/tools/psb_dsphalo.F90
Unescape Escape View File

@ -189,7 +189,7 @@ Subroutine psb_dsphalo(a,desc_a,blk,info,rowcnv,colcnv,&
counter = counter+n_el_send+3 counter = counter+n_el_send+3
Enddo Enddo
call mpi_alltoall(sdsz,1,psb_mpi_integer,rvsz,1,psb_mpi_integer,icomm,info) call mpi_alltoall(sdsz,1,psb_mpi_ipk_integer,rvsz,1,psb_mpi_ipk_integer,icomm,info)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
ch_err='mpi_alltoall' ch_err='mpi_alltoall'
@ -274,10 +274,10 @@ Subroutine psb_dsphalo(a,desc_a,blk,info,rowcnv,colcnv,&
call mpi_alltoallv(valsnd,sdsz,bsdindx,mpi_double_precision,& call mpi_alltoallv(valsnd,sdsz,bsdindx,mpi_double_precision,&
& acoo%val,rvsz,brvindx,mpi_double_precision,icomm,info) & acoo%val,rvsz,brvindx,mpi_double_precision,icomm,info)
call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_integer,& call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_ipk_integer,&
& acoo%ia,rvsz,brvindx,psb_mpi_integer,icomm,info) & acoo%ia,rvsz,brvindx,psb_mpi_ipk_integer,icomm,info)
call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_integer,& call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_ipk_integer,&
& acoo%ja,rvsz,brvindx,psb_mpi_integer,icomm,info) & acoo%ja,rvsz,brvindx,psb_mpi_ipk_integer,icomm,info)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
ch_err='mpi_alltoallv' ch_err='mpi_alltoallv'

6
base/tools/psb_scdbldext.F90
Unescape Escape View File

@ -467,7 +467,7 @@ Subroutine psb_scdbldext(a,desc_a,novr,desc_ov,info, extype)
! accumulated RECV requests, we have an all-to-all to build ! accumulated RECV requests, we have an all-to-all to build
! matchings SENDs. ! matchings SENDs.
! !
call mpi_alltoall(sdsz,1,mpi_integer,rvsz,1,mpi_integer,icomm,minfo) call mpi_alltoall(sdsz,1,psb_mpi_def_integer,rvsz,1,psb_mpi_def_integer,icomm,minfo)
if (minfo /= psb_success_) then if (minfo /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='mpi_alltoall') call psb_errpush(info,name,a_err='mpi_alltoall')
@ -502,8 +502,8 @@ Subroutine psb_scdbldext(a,desc_a,novr,desc_ov,info, extype)
lworkr = max(iszr,1) lworkr = max(iszr,1)
end if end if
call mpi_alltoallv(works,sdsz,bsdindx,psb_mpi_integer,& call mpi_alltoallv(works,sdsz,bsdindx,psb_mpi_ipk_integer,&
& workr,rvsz,brvindx,psb_mpi_integer,icomm,minfo) & workr,rvsz,brvindx,psb_mpi_ipk_integer,icomm,minfo)
if (minfo /= psb_success_) then if (minfo /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='mpi_alltoallv') call psb_errpush(info,name,a_err='mpi_alltoallv')

10
base/tools/psb_ssphalo.F90
Unescape Escape View File

@ -189,7 +189,7 @@ Subroutine psb_ssphalo(a,desc_a,blk,info,rowcnv,colcnv,&
counter = counter+n_el_send+3 counter = counter+n_el_send+3
Enddo Enddo
call mpi_alltoall(sdsz,1,psb_mpi_integer,rvsz,1,psb_mpi_integer,icomm,info) call mpi_alltoall(sdsz,1,psb_mpi_ipk_integer,rvsz,1,psb_mpi_ipk_integer,icomm,info)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
ch_err='mpi_alltoall' ch_err='mpi_alltoall'
@ -274,10 +274,10 @@ Subroutine psb_ssphalo(a,desc_a,blk,info,rowcnv,colcnv,&
call mpi_alltoallv(valsnd,sdsz,bsdindx,mpi_real,& call mpi_alltoallv(valsnd,sdsz,bsdindx,mpi_real,&
& acoo%val,rvsz,brvindx,mpi_real,icomm,info) & acoo%val,rvsz,brvindx,mpi_real,icomm,info)
call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_integer,& call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_ipk_integer,&
& acoo%ia,rvsz,brvindx,psb_mpi_integer,icomm,info) & acoo%ia,rvsz,brvindx,psb_mpi_ipk_integer,icomm,info)
call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_integer,& call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_ipk_integer,&
& acoo%ja,rvsz,brvindx,psb_mpi_integer,icomm,info) & acoo%ja,rvsz,brvindx,psb_mpi_ipk_integer,icomm,info)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
ch_err='mpi_alltoallv' ch_err='mpi_alltoallv'

6
base/tools/psb_zcdbldext.F90
Unescape Escape View File

@ -467,7 +467,7 @@ Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info, extype)
! accumulated RECV requests, we have an all-to-all to build ! accumulated RECV requests, we have an all-to-all to build
! matchings SENDs. ! matchings SENDs.
! !
call mpi_alltoall(sdsz,1,mpi_integer,rvsz,1,mpi_integer,icomm,minfo) call mpi_alltoall(sdsz,1,psb_mpi_def_integer,rvsz,1,psb_mpi_def_integer,icomm,minfo)
if (minfo /= psb_success_) then if (minfo /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='mpi_alltoall') call psb_errpush(info,name,a_err='mpi_alltoall')
@ -502,8 +502,8 @@ Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info, extype)
lworkr = max(iszr,1) lworkr = max(iszr,1)
end if end if
call mpi_alltoallv(works,sdsz,bsdindx,psb_mpi_integer,& call mpi_alltoallv(works,sdsz,bsdindx,psb_mpi_ipk_integer,&
& workr,rvsz,brvindx,psb_mpi_integer,icomm,minfo) & workr,rvsz,brvindx,psb_mpi_ipk_integer,icomm,minfo)
if (minfo /= psb_success_) then if (minfo /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='mpi_alltoallv') call psb_errpush(info,name,a_err='mpi_alltoallv')

10
base/tools/psb_zsphalo.F90
Unescape Escape View File

@ -189,7 +189,7 @@ Subroutine psb_zsphalo(a,desc_a,blk,info,rowcnv,colcnv,&
counter = counter+n_el_send+3 counter = counter+n_el_send+3
Enddo Enddo
call mpi_alltoall(sdsz,1,psb_mpi_integer,rvsz,1,psb_mpi_integer,icomm,info) call mpi_alltoall(sdsz,1,psb_mpi_ipk_integer,rvsz,1,psb_mpi_ipk_integer,icomm,info)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
ch_err='mpi_alltoall' ch_err='mpi_alltoall'
@ -274,10 +274,10 @@ Subroutine psb_zsphalo(a,desc_a,blk,info,rowcnv,colcnv,&
call mpi_alltoallv(valsnd,sdsz,bsdindx,mpi_double_complex,& call mpi_alltoallv(valsnd,sdsz,bsdindx,mpi_double_complex,&
& acoo%val,rvsz,brvindx,mpi_double_complex,icomm,info) & acoo%val,rvsz,brvindx,mpi_double_complex,icomm,info)
call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_integer,& call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_ipk_integer,&
& acoo%ia,rvsz,brvindx,psb_mpi_integer,icomm,info) & acoo%ia,rvsz,brvindx,psb_mpi_ipk_integer,icomm,info)
call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_integer,& call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_ipk_integer,&
& acoo%ja,rvsz,brvindx,psb_mpi_integer,icomm,info) & acoo%ja,rvsz,brvindx,psb_mpi_ipk_integer,icomm,info)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
ch_err='mpi_alltoallv' ch_err='mpi_alltoallv'

Write Preview
Loading…
Cancel
Save