fdurastante/psblas3
1
0
Fork 0
mirror of https://github.com/sfilippone/psblas3.git synced 2026-10-10 07:59:05 +00:00
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.
This commit is contained in:
Salvatore Filippone
2012-02-05 17:17:32 +00:00
parent b41af4a30a
commit 0b2b2e5bad
28 changed files with 260 additions and 250 deletions
Download Patch File Download Diff File Expand all files Collapse all files
base/comm/psb_cscatter.F90
+8 -8
View File
@@ -169,8 +169,8 @@ subroutine psb_cscatterm(globx, locx, desc_a, info, iroot)
end do
call psb_loc_to_glob(ltg(1:nrow),desc_a,info)
call mpi_gather(nrow,1,psb_mpi_integer,all_dim,&
& 1,psb_mpi_integer,rootrank,icomm,info)
call mpi_gather(nrow,1,psb_mpi_ipk_integer,all_dim,&
& 1,psb_mpi_ipk_integer,rootrank,icomm,info)
if (me == root) then
displ(1)=0
@@ -190,8 +190,8 @@ subroutine psb_cscatterm(globx, locx, desc_a, info, iroot)
end if
call mpi_gatherv(ltg,nrow,&
& psb_mpi_integer,l_t_g_all,all_dim,&
& displ,psb_mpi_integer,rootrank,icomm,info)
& psb_mpi_ipk_integer,l_t_g_all,all_dim,&
& displ,psb_mpi_ipk_integer,rootrank,icomm,info)
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 mpi_gather(nrow,1,psb_mpi_integer,all_dim,&
& 1,psb_mpi_integer,rootrank,icomm,info)
call mpi_gather(nrow,1,psb_mpi_ipk_integer,all_dim,&
& 1,psb_mpi_ipk_integer,rootrank,icomm,info)
if(me == root) then
displ(1)=0
@@ -401,8 +401,8 @@ subroutine psb_cscatterv(globx, locx, desc_a, info, iroot)
end if
call mpi_gatherv(ltg,nrow,&
& psb_mpi_integer,l_t_g_all,all_dim,&
& displ,psb_mpi_integer,rootrank,icomm,info)
& psb_mpi_ipk_integer,l_t_g_all,all_dim,&
& displ,psb_mpi_ipk_integer,rootrank,icomm,info)
! prepare vector to scatter
if (me == root) then
base/comm/psb_cspgather.F90
+4 -4
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,&
& glob_coo%val,nzbr,idisp,&
& 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,&
& psb_mpi_integer,icomm,minfo)
if (minfo == psb_success_) call mpi_allgatherv(loc_coo%ja,ndx,psb_mpi_integer,&
& psb_mpi_ipk_integer,icomm,minfo)
if (minfo == psb_success_) call mpi_allgatherv(loc_coo%ja,ndx,psb_mpi_ipk_integer,&
& glob_coo%ja,nzbr,idisp,&
& psb_mpi_integer,icomm,minfo)
& psb_mpi_ipk_integer,icomm,minfo)
if (minfo /= psb_success_) then
info = minfo
base/comm/psb_dscatter.F90
+8 -8
View File
@@ -169,8 +169,8 @@ subroutine psb_dscatterm(globx, locx, desc_a, info, iroot)
end do
call psb_loc_to_glob(ltg(1:nrow),desc_a,info)
call mpi_gather(nrow,1,psb_mpi_integer,all_dim,&
& 1,psb_mpi_integer,rootrank,icomm,info)
call mpi_gather(nrow,1,psb_mpi_ipk_integer,all_dim,&
& 1,psb_mpi_ipk_integer,rootrank,icomm,info)
if (me == root) then
displ(1)=0
@@ -190,8 +190,8 @@ subroutine psb_dscatterm(globx, locx, desc_a, info, iroot)
end if
call mpi_gatherv(ltg,nrow,&
& psb_mpi_integer,l_t_g_all,all_dim,&
& displ,psb_mpi_integer,rootrank,icomm,info)
& psb_mpi_ipk_integer,l_t_g_all,all_dim,&
& displ,psb_mpi_ipk_integer,rootrank,icomm,info)
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 mpi_gather(nrow,1,psb_mpi_integer,all_dim,&
& 1,psb_mpi_integer,rootrank,icomm,info)
call mpi_gather(nrow,1,psb_mpi_ipk_integer,all_dim,&
& 1,psb_mpi_ipk_integer,rootrank,icomm,info)
if(me == root) then
displ(1)=0
@@ -401,8 +401,8 @@ subroutine psb_dscatterv(globx, locx, desc_a, info, iroot)
end if
call mpi_gatherv(ltg,nrow,&
& psb_mpi_integer,l_t_g_all,all_dim,&
& displ,psb_mpi_integer,rootrank,icomm,info)
& psb_mpi_ipk_integer,l_t_g_all,all_dim,&
& displ,psb_mpi_ipk_integer,rootrank,icomm,info)
! prepare vector to scatter
if (me == root) then
base/comm/psb_dspgather.F90
+4 -4
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,&
& glob_coo%val,nzbr,idisp,&
& 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,&
& psb_mpi_integer,icomm,minfo)
if (minfo == psb_success_) call mpi_allgatherv(loc_coo%ja,ndx,psb_mpi_integer,&
& psb_mpi_ipk_integer,icomm,minfo)
if (minfo == psb_success_) call mpi_allgatherv(loc_coo%ja,ndx,psb_mpi_ipk_integer,&
& glob_coo%ja,nzbr,idisp,&
& psb_mpi_integer,icomm,minfo)
& psb_mpi_ipk_integer,icomm,minfo)
if (minfo /= psb_success_) then
info = minfo
base/comm/psb_iscatter.F90
+12 -12
View File
@@ -167,8 +167,8 @@ subroutine psb_iscatterm(globx, locx, desc_a, info, iroot)
end do
call psb_loc_to_glob(ltg(1:nrow),desc_a,info)
call mpi_gather(nrow,1,psb_mpi_integer,all_dim,&
& 1,psb_mpi_integer,rootrank,icomm,info)
call mpi_gather(nrow,1,psb_mpi_ipk_integer,all_dim,&
& 1,psb_mpi_ipk_integer,rootrank,icomm,info)
if (me == root) then
displ(1)=0
@@ -188,8 +188,8 @@ subroutine psb_iscatterm(globx, locx, desc_a, info, iroot)
end if
call mpi_gatherv(ltg,nrow,&
& psb_mpi_integer,l_t_g_all,all_dim,&
& displ,psb_mpi_integer,rootrank,icomm,info)
& psb_mpi_ipk_integer,l_t_g_all,all_dim,&
& displ,psb_mpi_ipk_integer,rootrank,icomm,info)
do c=1, k
@@ -206,8 +206,8 @@ subroutine psb_iscatterm(globx, locx, desc_a, info, iroot)
! scatter !!!
call mpi_scatterv(scatterv,all_dim,displ,&
& psb_mpi_integer,locx(1,jlocx+c-1),nrow,&
& psb_mpi_integer,rootrank,icomm,info)
& psb_mpi_ipk_integer,locx(1,jlocx+c-1),nrow,&
& psb_mpi_ipk_integer,rootrank,icomm,info)
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 mpi_gather(nrow,1,psb_mpi_integer,all_dim,&
& 1,psb_mpi_integer,rootrank,icomm,info)
call mpi_gather(nrow,1,psb_mpi_ipk_integer,all_dim,&
& 1,psb_mpi_ipk_integer,rootrank,icomm,info)
if(me == root) then
displ(1)=0
@@ -399,8 +399,8 @@ subroutine psb_iscatterv(globx, locx, desc_a, info, iroot)
end if
call mpi_gatherv(ltg,nrow,&
& psb_mpi_integer,l_t_g_all,all_dim,&
& displ,psb_mpi_integer,rootrank,icomm,info)
& psb_mpi_ipk_integer,l_t_g_all,all_dim,&
& displ,psb_mpi_ipk_integer,rootrank,icomm,info)
! prepare vector to scatter
if (me == root) then
@@ -415,8 +415,8 @@ subroutine psb_iscatterv(globx, locx, desc_a, info, iroot)
end if
call mpi_scatterv(scatterv,all_dim,displ,&
& psb_mpi_integer,locx,nrow,&
& psb_mpi_integer,rootrank,icomm,info)
& psb_mpi_ipk_integer,locx,nrow,&
& psb_mpi_ipk_integer,rootrank,icomm,info)
if (me == root) deallocate(all_dim, l_t_g_all, displ, scatterv)
end if
base/comm/psb_sscatter.F90
+8 -8
View File
@@ -169,8 +169,8 @@ subroutine psb_sscatterm(globx, locx, desc_a, info, iroot)
end do
call psb_loc_to_glob(ltg(1:nrow),desc_a,info)
call mpi_gather(nrow,1,psb_mpi_integer,all_dim,&
& 1,psb_mpi_integer,rootrank,icomm,info)
call mpi_gather(nrow,1,psb_mpi_ipk_integer,all_dim,&
& 1,psb_mpi_ipk_integer,rootrank,icomm,info)
if (me == root) then
displ(1)=0
@@ -190,8 +190,8 @@ subroutine psb_sscatterm(globx, locx, desc_a, info, iroot)
end if
call mpi_gatherv(ltg,nrow,&
& psb_mpi_integer,l_t_g_all,all_dim,&
& displ,psb_mpi_integer,rootrank,icomm,info)
& psb_mpi_ipk_integer,l_t_g_all,all_dim,&
& displ,psb_mpi_ipk_integer,rootrank,icomm,info)
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 mpi_gather(nrow,1,psb_mpi_integer,all_dim,&
& 1,psb_mpi_integer,rootrank,icomm,info)
call mpi_gather(nrow,1,psb_mpi_ipk_integer,all_dim,&
& 1,psb_mpi_ipk_integer,rootrank,icomm,info)
if(me == root) then
displ(1)=0
@@ -401,8 +401,8 @@ subroutine psb_sscatterv(globx, locx, desc_a, info, iroot)
end if
call mpi_gatherv(ltg,nrow,&
& psb_mpi_integer,l_t_g_all,all_dim,&
& displ,psb_mpi_integer,rootrank,icomm,info)
& psb_mpi_ipk_integer,l_t_g_all,all_dim,&
& displ,psb_mpi_ipk_integer,rootrank,icomm,info)
! prepare vector to scatter
if (me == root) then
base/comm/psb_sspgather.F90
+4 -4
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,&
& glob_coo%val,nzbr,idisp,&
& 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,&
& psb_mpi_integer,icomm,minfo)
if (minfo == psb_success_) call mpi_allgatherv(loc_coo%ja,ndx,psb_mpi_integer,&
& psb_mpi_ipk_integer,icomm,minfo)
if (minfo == psb_success_) call mpi_allgatherv(loc_coo%ja,ndx,psb_mpi_ipk_integer,&
& glob_coo%ja,nzbr,idisp,&
& psb_mpi_integer,icomm,minfo)
& psb_mpi_ipk_integer,icomm,minfo)
if (minfo /= psb_success_) then
info = minfo
base/comm/psb_zscatter.F90
+8 -8
View File
@@ -169,8 +169,8 @@ subroutine psb_zscatterm(globx, locx, desc_a, info, iroot)
end do
call psb_loc_to_glob(ltg(1:nrow),desc_a,info)
call mpi_gather(nrow,1,psb_mpi_integer,all_dim,&
& 1,psb_mpi_integer,rootrank,icomm,info)
call mpi_gather(nrow,1,psb_mpi_ipk_integer,all_dim,&
& 1,psb_mpi_ipk_integer,rootrank,icomm,info)
if (me == root) then
displ(1)=0
@@ -190,8 +190,8 @@ subroutine psb_zscatterm(globx, locx, desc_a, info, iroot)
end if
call mpi_gatherv(ltg,nrow,&
& psb_mpi_integer,l_t_g_all,all_dim,&
& displ,psb_mpi_integer,rootrank,icomm,info)
& psb_mpi_ipk_integer,l_t_g_all,all_dim,&
& displ,psb_mpi_ipk_integer,rootrank,icomm,info)
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 mpi_gather(nrow,1,psb_mpi_integer,all_dim,&
& 1,psb_mpi_integer,rootrank,icomm,info)
call mpi_gather(nrow,1,psb_mpi_ipk_integer,all_dim,&
& 1,psb_mpi_ipk_integer,rootrank,icomm,info)
if(me == root) then
displ(1)=0
@@ -401,8 +401,8 @@ subroutine psb_zscatterv(globx, locx, desc_a, info, iroot)
end if
call mpi_gatherv(ltg,nrow,&
& psb_mpi_integer,l_t_g_all,all_dim,&
& displ,psb_mpi_integer,rootrank,icomm,info)
& psb_mpi_ipk_integer,l_t_g_all,all_dim,&
& displ,psb_mpi_ipk_integer,rootrank,icomm,info)
! prepare vector to scatter
if (me == root) then
base/comm/psb_zspgather.F90
+4 -4
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,&
& glob_coo%val,nzbr,idisp,&
& 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,&
& psb_mpi_integer,icomm,minfo)
if (minfo == psb_success_) call mpi_allgatherv(loc_coo%ja,ndx,psb_mpi_integer,&
& psb_mpi_ipk_integer,icomm,minfo)
if (minfo == psb_success_) call mpi_allgatherv(loc_coo%ja,ndx,psb_mpi_ipk_integer,&
& glob_coo%ja,nzbr,idisp,&
& psb_mpi_integer,icomm,minfo)
& psb_mpi_ipk_integer,icomm,minfo)
if (minfo /= psb_success_) then
info = minfo
base/internals/psb_indx_map_fnd_owner.F90
+5 -5
View File
@@ -134,8 +134,8 @@ subroutine psb_indx_map_fnd_owner(idx,iprc,idxmap,info)
t3 = psb_wtime()
end if
call mpi_allgatherv(idx,hsz(me+1),psb_mpi_integer,&
& hproc,hsz,hidx,psb_mpi_integer,&
call mpi_allgatherv(idx,hsz(me+1),psb_mpi_ipk_integer,&
& hproc,hsz,hidx,psb_mpi_ipk_integer,&
& icomm,info)
if (gettime) then
tamx = psb_wtime() - t3
@@ -178,7 +178,7 @@ 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_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)
@@ -192,8 +192,8 @@ subroutine psb_indx_map_fnd_owner(idx,iprc,idxmap,info)
rvidx(ip) = j
j = j + rvsz(ip)
end do
call mpi_alltoallv(hproc,sdsz,sdidx,psb_mpi_integer,&
& answers(:,1),rvsz,rvidx,psb_mpi_integer,&
call mpi_alltoallv(hproc,sdsz,sdidx,psb_mpi_ipk_integer,&
& answers(:,1),rvsz,rvidx,psb_mpi_ipk_integer,&
& icomm,info)
if (gettime) then
tamx = psb_wtime() - t3 + tamx
base/internals/psi_desc_index.F90
+3 -3
View File
@@ -186,7 +186,7 @@ subroutine psi_desc_index(desc,index_in,dep_list,&
i = i + nerv + 1
end do
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
call psb_errpush(psb_err_from_subroutine_,name,a_err='mpi_alltoall')
goto 9999
@@ -292,8 +292,8 @@ subroutine psi_desc_index(desc,index_in,dep_list,&
idxr = idxr + rvsz(proc+1)
end do
call mpi_alltoallv(sndbuf,sdsz,bsdindx,psb_mpi_integer,&
& rcvbuf,rvsz,brvindx,psb_mpi_integer,icomm,minfo)
call mpi_alltoallv(sndbuf,sdsz,bsdindx,psb_mpi_ipk_integer,&
& rcvbuf,rvsz,brvindx,psb_mpi_ipk_integer,icomm,minfo)
if (minfo /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='mpi_alltoallv')
goto 9999
base/internals/psi_extrct_dl.F90
+2 -2
View File
@@ -271,8 +271,8 @@ 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_integer,&
& dep_list,dl_lda,psb_mpi_integer,icomm,info)
call mpi_allgather(itmp,dl_lda,psb_mpi_ipk_integer,&
& dep_list,dl_lda,psb_mpi_ipk_integer,icomm,info)
deallocate(itmp,stat=info)
if (info /= psb_success_) then
info=psb_err_alloc_dealloc_
base/internals/psi_iswapdata.F90
+15 -15
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
call mpi_alltoallv(sndbuf,sdsz,bsdidx,&
& psb_mpi_integer,rcvbuf,rvsz,&
& brvidx,psb_mpi_integer,icomm,iret)
& psb_mpi_ipk_integer,rcvbuf,rvsz,&
& brvidx,psb_mpi_ipk_integer,icomm,iret)
if(iret /= mpi_success) then
ierr(1) = iret
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
p2ptag = psb_int_swap_tag
call mpi_irecv(rcvbuf(rcv_pt),n*nerv,&
& psb_mpi_integer,prcid(i),&
& psb_mpi_ipk_integer,prcid(i),&
& p2ptag, icomm,rvhd(i),iret)
end if
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 (usersend) then
call mpi_rsend(sndbuf(snd_pt),n*nesd,&
& psb_mpi_integer,prcid(i),&
& psb_mpi_ipk_integer,prcid(i),&
& p2ptag,icomm,iret)
else
call mpi_send(sndbuf(snd_pt),n*nesd,&
& psb_mpi_integer,prcid(i),&
& psb_mpi_ipk_integer,prcid(i),&
& p2ptag,icomm,iret)
end if
@@ -801,8 +801,8 @@ subroutine psi_iswapidxv(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,work
! swap elements using mpi_alltoallv
call mpi_alltoallv(sndbuf,sdsz,bsdidx,&
& psb_mpi_integer,rcvbuf,rvsz,&
& brvidx,psb_mpi_integer,icomm,iret)
& psb_mpi_ipk_integer,rcvbuf,rvsz,&
& brvidx,psb_mpi_ipk_integer,icomm,iret)
if(iret /= mpi_success) then
ierr(1) = iret
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
p2ptag = psb_int_swap_tag
call mpi_irecv(rcvbuf(rcv_pt),nerv,&
& psb_mpi_integer,prcid(i),&
& psb_mpi_ipk_integer,prcid(i),&
& p2ptag, icomm,rvhd(i),iret)
end if
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 (usersend) then
call mpi_rsend(sndbuf(snd_pt),nesd,&
& psb_mpi_integer,prcid(i),&
& psb_mpi_ipk_integer,prcid(i),&
& p2ptag,icomm,iret)
else
call mpi_send(sndbuf(snd_pt),nesd,&
& psb_mpi_integer,prcid(i),&
& psb_mpi_ipk_integer,prcid(i),&
& p2ptag,icomm,iret)
end if
@@ -1238,8 +1238,8 @@ end subroutine psi_iswapidxv
!!$
!!$ ! swap elements using mpi_alltoallv
!!$ call mpi_alltoallv(sndbuf,sdsz,bsdidx,&
!!$ & psb_mpi_integer,rcvbuf,rvsz,&
!!$ & brvidx,psb_mpi_integer,icomm,iret)
!!$ & psb_mpi_ipk_integer,rcvbuf,rvsz,&
!!$ & brvidx,psb_mpi_ipk_integer,icomm,iret)
!!$ if(iret /= mpi_success) then
!!$ ierr(1) = iret
!!$ info=psb_err_mpi_error_
@@ -1296,7 +1296,7 @@ end subroutine psi_iswapidxv
!!$ if ((nerv>0).and.(proc_to_comm /= me)) then
!!$ p2ptag = psb_int_swap_tag
!!$ call mpi_irecv(rcvbuf(rcv_pt),nerv,&
!!$ & psb_mpi_integer,prcid(i),&
!!$ & psb_mpi_ipk_integer,prcid(i),&
!!$ & p2ptag, icomm,rvhd(i),iret)
!!$ end if
!!$ rcv_pt = rcv_pt + nerv
@@ -1321,11 +1321,11 @@ end subroutine psi_iswapidxv
!!$ if ((nesd>0).and.(proc_to_comm /= me)) then
!!$ if (usersend) then
!!$ call mpi_rsend(sndbuf(snd_pt),nesd,&
!!$ & psb_mpi_integer,prcid(i),&
!!$ & psb_mpi_ipk_integer,prcid(i),&
!!$ & p2ptag,icomm,iret)
!!$ else
!!$ call mpi_send(sndbuf(snd_pt),nesd,&
!!$ & psb_mpi_integer,prcid(i),&
!!$ & psb_mpi_ipk_integer,prcid(i),&
!!$ & p2ptag,icomm,iret)
!!$ end if
!!$
base/internals/psi_iswaptran.F90
+15 -15
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
call mpi_alltoallv(rcvbuf,rvsz,brvidx,&
& psb_mpi_integer,&
& sndbuf,sdsz,bsdidx,psb_mpi_integer,icomm,iret)
& psb_mpi_ipk_integer,&
& sndbuf,sdsz,bsdidx,psb_mpi_ipk_integer,icomm,iret)
if(iret /= mpi_success) then
ierr(1) = iret
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
p2ptag = psb_int_swap_tag
call mpi_irecv(sndbuf(snd_pt),n*nesd,&
& psb_mpi_integer,prcid(i),&
& psb_mpi_ipk_integer,prcid(i),&
& p2ptag,icomm,rvhd(i),iret)
end if
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
if (usersend) then
call mpi_rsend(rcvbuf(rcv_pt),n*nerv,&
& psb_mpi_integer,prcid(i),&
& psb_mpi_ipk_integer,prcid(i),&
& p2ptag,icomm,iret)
else
call mpi_send(rcvbuf(rcv_pt),n*nerv,&
& psb_mpi_integer,prcid(i),&
& psb_mpi_ipk_integer,prcid(i),&
& p2ptag,icomm,iret)
end if
@@ -824,8 +824,8 @@ subroutine psi_itranidxv(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,work
! swap elements using mpi_alltoallv
call mpi_alltoallv(rcvbuf,rvsz,brvidx,&
& psb_mpi_integer,&
& sndbuf,sdsz,bsdidx,psb_mpi_integer,icomm,iret)
& psb_mpi_ipk_integer,&
& sndbuf,sdsz,bsdidx,psb_mpi_ipk_integer,icomm,iret)
if(iret /= mpi_success) then
ierr(1) = iret
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
p2ptag = psb_int_swap_tag
call mpi_irecv(sndbuf(snd_pt),nesd,&
& psb_mpi_integer,prcid(i),&
& psb_mpi_ipk_integer,prcid(i),&
& p2ptag,icomm,rvhd(i),iret)
end if
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
if (usersend) then
call mpi_rsend(rcvbuf(rcv_pt),nerv,&
& psb_mpi_integer,prcid(i),&
& psb_mpi_ipk_integer,prcid(i),&
& p2ptag, icomm,iret)
else
call mpi_send(rcvbuf(rcv_pt),nerv,&
& psb_mpi_integer,prcid(i),&
& psb_mpi_ipk_integer,prcid(i),&
& p2ptag, icomm,iret)
end if
@@ -1273,8 +1273,8 @@ end subroutine psi_itranidxv
!!$
!!$ ! swap elements using mpi_alltoallv
!!$ call mpi_alltoallv(rcvbuf,rvsz,brvidx,&
!!$ & psb_mpi_integer,&
!!$ & sndbuf,sdsz,bsdidx,psb_mpi_integer,icomm,iret)
!!$ & psb_mpi_ipk_integer,&
!!$ & sndbuf,sdsz,bsdidx,psb_mpi_ipk_integer,icomm,iret)
!!$ if(iret /= mpi_success) then
!!$ ierr(1) = iret
!!$ info=psb_err_mpi_error_
@@ -1331,7 +1331,7 @@ end subroutine psi_itranidxv
!!$ if ((nesd>0).and.(proc_to_comm /= me)) then
!!$ p2ptag = psb_int_swap_tag
!!$ call mpi_irecv(sndbuf(snd_pt),nesd,&
!!$ & psb_mpi_integer,prcid(i),&
!!$ & psb_mpi_ipk_integer,prcid(i),&
!!$ & p2ptag,icomm,rvhd(i),iret)
!!$ end if
!!$ rcv_pt = rcv_pt + nerv
@@ -1355,11 +1355,11 @@ end subroutine psi_itranidxv
!!$ p2ptag = psb_int_swap_tag
!!$ if (usersend) then
!!$ call mpi_rsend(rcvbuf(rcv_pt),nerv,&
!!$ & psb_mpi_integer,prcid(i),&
!!$ & psb_mpi_ipk_integer,prcid(i),&
!!$ & p2ptag, icomm,iret)
!!$ else
!!$ call mpi_send(rcvbuf(rcv_pt),nerv,&
!!$ & psb_mpi_integer,prcid(i),&
!!$ & psb_mpi_ipk_integer,prcid(i),&
!!$ & p2ptag, icomm,iret)
!!$ end if
!!$
base/modules/psb_const_mod.F90
+8 -3
View File
@@ -34,14 +34,14 @@ module psb_const_mod
#if defined(HAVE_ISO_FORTRAN_ENV)
use iso_fortran_env
#endif
! This is the default integer
! This is the default PSBLAS integer, can be 4 or 8 bytes.
#if defined(LONG_INTEGERS)
integer, parameter :: ndig=12
#else
integer, parameter :: ndig=8
#endif
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 :: psb_long_int_k_ = selected_int_kind(longndig)
! 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_), save :: psb_sizeof_dp, psb_sizeof_sp
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
!
base/modules/psi_bcast_mod.F90
+6 -6
View File
@@ -60,7 +60,7 @@ contains
endif
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
end subroutine psb_ibcasts
@@ -85,7 +85,7 @@ contains
endif
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
end subroutine psb_ibcastv
@@ -111,7 +111,7 @@ contains
endif
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
end subroutine psb_ibcastm
@@ -577,7 +577,7 @@ contains
endif
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
end subroutine psb_i8bcasts
@@ -602,7 +602,7 @@ contains
endif
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
end subroutine psb_i8bcastv
@@ -628,7 +628,7 @@ contains
endif
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
end subroutine psb_i8bcastm
base/modules/psi_comm_buffers_mod.F90
+6 -6
View File
@@ -5,15 +5,15 @@ module mpi
integer(psb_mpik_), parameter :: mpi_success = 0
integer(psb_mpik_), parameter :: mpi_request_null = 0
integer(psb_mpik_), parameter :: mpi_status_size = 1
integer(psb_mpik_), parameter :: mpi_integer = 1
integer(psb_mpik_), parameter :: mpi_integer8 = 2
integer(psb_mpik_), parameter :: psb_mpi_def_integer = 1
integer(psb_mpik_), parameter :: psb_mpi_lng_integer = 2
integer(psb_mpik_), parameter :: mpi_real = 3
integer(psb_mpik_), parameter :: mpi_double_precision = 4
integer(psb_mpik_), parameter :: mpi_complex = 5
integer(psb_mpik_), parameter :: mpi_double_complex = 6
integer(psb_mpik_), parameter :: mpi_character = 7
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_world = 1
@@ -257,7 +257,7 @@ contains
write(psb_err_unit,*) 'Fatal memory error inside communication subsystem'
return
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)
info = minfo
call psb_insert_node(mesg_queue,node)
@@ -294,7 +294,7 @@ contains
write(psb_err_unit,*) 'Fatal memory error inside communication subsystem'
return
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)
info = minfo
call psb_insert_node(mesg_queue,node)
@@ -332,7 +332,7 @@ contains
write(psb_err_unit,*) 'Fatal memory error inside communication subsystem'
return
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)
info = minfo
call psb_insert_node(mesg_queue,node)
base/modules/psi_p2p_mod.F90
+12 -12
View File
@@ -847,7 +847,7 @@ contains
#if defined(SERIAL_MPI)
! do nothing
#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)
#endif
end subroutine psb_ircvs
@@ -870,7 +870,7 @@ contains
integer(psb_mpik_) :: status(mpi_status_size)
#if defined(SERIAL_MPI)
#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)
#endif
@@ -901,13 +901,13 @@ contains
m_ = m
ld = size(dat,1)
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_recv(dat,1,mp_rcv_type,src,&
& psb_int_tag,ictxt,status,info)
if (info == mpi_success) call mpi_type_free(mp_rcv_type,info)
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
if (info /= mpi_success) then
write(psb_err_unit,*) 'Error in psb_recv', info
@@ -1403,7 +1403,7 @@ contains
#if defined(SERIAL_MPI)
! do nothing
#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)
#endif
end subroutine psb_i8rcvs
@@ -1425,7 +1425,7 @@ contains
integer(psb_mpik_) :: status(mpi_status_size)
#if defined(SERIAL_MPI)
#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)
#endif
@@ -1455,13 +1455,13 @@ contains
m_ = m
ld = size(dat,1)
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_recv(dat,1,mp_rcv_type,src,&
& psb_int8_tag,ictxt,status,info)
if (info == mpi_success) call mpi_type_free(mp_rcv_type,info)
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)
end if
if (info /= mpi_success) then
@@ -1492,7 +1492,7 @@ contains
#if defined(SERIAL_MPI)
! do nothing
#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)
#endif
end subroutine psb_i2rcvs
@@ -1514,7 +1514,7 @@ contains
integer(psb_mpik_) :: status(mpi_status_size)
#if defined(SERIAL_MPI)
#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)
#endif
@@ -1544,13 +1544,13 @@ contains
m_ = m
ld = size(dat,1)
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_recv(dat,1,mp_rcv_type,src,&
& psb_int2_tag,ictxt,status,info)
if (info == mpi_success) call mpi_type_free(mp_rcv_type,info)
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)
end if
if (info /= mpi_success) then
base/modules/psi_penv_mod.F90
+8 -3
View File
@@ -109,10 +109,13 @@ contains
integer(psb_mpik_) :: info
#if defined(LONG_INTEGERS)
psb_mpi_integer = mpi_integer8
psb_mpi_ipk_integer = mpi_integer8
#else
psb_mpi_integer = mpi_integer
psb_mpi_ipk_integer = mpi_integer
#endif
psb_mpi_def_integer = mpi_integer
psb_mpi_lng_integer = mpi_integer8
#if defined(SERIAL_MPI)
#else
@@ -495,6 +498,8 @@ contains
!
! Base binary operations
!
! Note: len & type are always default integer.
!
! !!!!!!!!!!!!!!!!!!!!!!
subroutine psi_iamx_op(inv, outv,len,type)
integer(psb_ipk_) :: inv(*),outv(*)
@@ -536,7 +541,7 @@ contains
integer(psb_long_int_k_) :: inv(*),outv(*)
integer(psb_mpik_) :: len,type
integer(psb_mpik_) :: i
if (type /= mpi_integer8) then
if (type /= psb_mpi_lng_integer) then
write(psb_err_unit,*) 'Invalid type !!!'
end if
do i=1, len
base/modules/psi_reduce_mod.F90
+88 -88
View File
@@ -168,10 +168,10 @@ contains
root_ = -1
endif
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_
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_
endif
#endif
@@ -207,15 +207,15 @@ contains
call psb_realloc(size(dat),dat_,iinfo)
dat_=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
if (iam == root_) then
call psb_realloc(size(dat),dat_,iinfo)
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
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
endif
#endif
@@ -251,15 +251,15 @@ contains
call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo)
dat_=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
if (iam == root_) then
call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo)
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
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
endif
#endif
@@ -292,10 +292,10 @@ contains
root_ = -1
endif
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_
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_
endif
#endif
@@ -331,15 +331,15 @@ contains
call psb_realloc(size(dat),dat_,iinfo)
dat_=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
if (iam == root_) then
call psb_realloc(size(dat),dat_,iinfo)
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
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
endif
#endif
@@ -375,15 +375,15 @@ contains
call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo)
dat_=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
if (iam == root_) then
call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo)
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
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
endif
#endif
@@ -673,10 +673,10 @@ contains
root_ = -1
endif
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_
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_
endif
#endif
@@ -712,15 +712,15 @@ contains
call psb_realloc(size(dat),dat_,iinfo)
dat_=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
if (iam == root_) then
call psb_realloc(size(dat),dat_,iinfo)
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
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
endif
#endif
@@ -756,15 +756,15 @@ contains
call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo)
dat_=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
if (iam == root_) then
call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo)
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
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
endif
#endif
@@ -797,10 +797,10 @@ contains
root_ = -1
endif
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_
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_
endif
#endif
@@ -836,15 +836,15 @@ contains
call psb_realloc(size(dat),dat_,iinfo)
dat_=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
if (iam == root_) then
call psb_realloc(size(dat),dat_,iinfo)
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
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
endif
#endif
@@ -880,15 +880,15 @@ contains
call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo)
dat_=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
if (iam == root_) then
call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo)
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
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
endif
#endif
@@ -1180,10 +1180,10 @@ contains
root_ = -1
endif
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_
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_
endif
@@ -1220,15 +1220,15 @@ contains
call psb_realloc(size(dat),dat_,iinfo)
dat_=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
if (iam == root_) then
call psb_realloc(size(dat),dat_,iinfo)
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
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
endif
#endif
@@ -1264,15 +1264,15 @@ contains
call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo)
dat_=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
if (iam == root_) then
call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo)
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
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
endif
#endif
@@ -1307,10 +1307,10 @@ contains
root_ = -1
endif
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_
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_
endif
@@ -1347,15 +1347,15 @@ contains
call psb_realloc(size(dat),dat_,iinfo)
dat_=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
if (iam == root_) then
call psb_realloc(size(dat),dat_,iinfo)
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
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
endif
#endif
@@ -1391,15 +1391,15 @@ contains
call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo)
dat_=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
if (iam == root_) then
call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo)
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
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
endif
#endif
@@ -1939,10 +1939,10 @@ contains
root_ = -1
endif
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_
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_
endif
@@ -1979,15 +1979,15 @@ contains
call psb_realloc(size(dat),dat_,iinfo)
dat_=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
if (iam == root_) then
call psb_realloc(size(dat),dat_,iinfo)
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
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
endif
#endif
@@ -2023,15 +2023,15 @@ contains
call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo)
dat_=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
if (iam == root_) then
call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo)
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
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
endif
#endif
@@ -2066,10 +2066,10 @@ contains
root_ = -1
endif
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_
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_
endif
@@ -2106,15 +2106,15 @@ contains
call psb_realloc(size(dat),dat_,iinfo)
dat_=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
if (iam == root_) then
call psb_realloc(size(dat),dat_,iinfo)
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
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
endif
#endif
@@ -2150,15 +2150,15 @@ contains
call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo)
dat_=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
if (iam == root_) then
call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo)
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
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
endif
#endif
@@ -2697,10 +2697,10 @@ contains
root_ = -1
endif
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_
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_
endif
@@ -2738,15 +2738,15 @@ contains
dat_=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
if (iam == root_) then
call psb_realloc(size(dat),dat_,iinfo)
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
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
endif
#endif
@@ -2782,15 +2782,15 @@ contains
call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo)
dat_=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
if (iam == root_) then
call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo)
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
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
endif
#endif
@@ -2825,10 +2825,10 @@ contains
root_ = -1
endif
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_
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_
endif
@@ -2865,14 +2865,14 @@ contains
call psb_realloc(size(dat),dat_,iinfo)
dat_=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
if (iam == root_) then
call psb_realloc(size(dat),dat_,iinfo)
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
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
endif
#endif
@@ -2908,14 +2908,14 @@ contains
call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo)
dat_=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
if (iam == root_) then
call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo)
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
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
endif
#endif
@@ -2952,10 +2952,10 @@ contains
root_ = -1
endif
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_
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_
endif
@@ -2992,15 +2992,15 @@ contains
call psb_realloc(size(dat),dat_,iinfo)
dat_=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
if (iam == root_) then
call psb_realloc(size(dat),dat_,iinfo)
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
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
endif
#endif
@@ -3036,15 +3036,15 @@ contains
call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo)
dat_=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
if (iam == root_) then
call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo)
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
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
endif
#endif
base/tools/psb_ccdbldext.F90
+3 -3
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
! 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
info=psb_err_from_subroutine_
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)
end if
call mpi_alltoallv(works,sdsz,bsdindx,psb_mpi_integer,&
& workr,rvsz,brvindx,psb_mpi_integer,icomm,minfo)
call mpi_alltoallv(works,sdsz,bsdindx,psb_mpi_ipk_integer,&
& workr,rvsz,brvindx,psb_mpi_ipk_integer,icomm,minfo)
if (minfo /= psb_success_) then
info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='mpi_alltoallv')
base/tools/psb_csphalo.F90
+5 -5
View File
@@ -189,7 +189,7 @@ Subroutine psb_csphalo(a,desc_a,blk,info,rowcnv,colcnv,&
counter = counter+n_el_send+3
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
info=psb_err_from_subroutine_
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,&
& acoo%val,rvsz,brvindx,mpi_complex,icomm,info)
call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_integer,&
& acoo%ia,rvsz,brvindx,psb_mpi_integer,icomm,info)
call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_integer,&
& acoo%ja,rvsz,brvindx,psb_mpi_integer,icomm,info)
call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_ipk_integer,&
& acoo%ia,rvsz,brvindx,psb_mpi_ipk_integer,icomm,info)
call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_ipk_integer,&
& acoo%ja,rvsz,brvindx,psb_mpi_ipk_integer,icomm,info)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='mpi_alltoallv'
base/tools/psb_dcdbldext.F90
+3 -3
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
! 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
info=psb_err_from_subroutine_
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)
end if
call mpi_alltoallv(works,sdsz,bsdindx,psb_mpi_integer,&
& workr,rvsz,brvindx,psb_mpi_integer,icomm,minfo)
call mpi_alltoallv(works,sdsz,bsdindx,psb_mpi_ipk_integer,&
& workr,rvsz,brvindx,psb_mpi_ipk_integer,icomm,minfo)
if (minfo /= psb_success_) then
info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='mpi_alltoallv')
base/tools/psb_dsphalo.F90
+5 -5
View File
@@ -189,7 +189,7 @@ Subroutine psb_dsphalo(a,desc_a,blk,info,rowcnv,colcnv,&
counter = counter+n_el_send+3
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
info=psb_err_from_subroutine_
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,&
& acoo%val,rvsz,brvindx,mpi_double_precision,icomm,info)
call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_integer,&
& acoo%ia,rvsz,brvindx,psb_mpi_integer,icomm,info)
call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_integer,&
& acoo%ja,rvsz,brvindx,psb_mpi_integer,icomm,info)
call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_ipk_integer,&
& acoo%ia,rvsz,brvindx,psb_mpi_ipk_integer,icomm,info)
call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_ipk_integer,&
& acoo%ja,rvsz,brvindx,psb_mpi_ipk_integer,icomm,info)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='mpi_alltoallv'
base/tools/psb_scdbldext.F90
+3 -3
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
! 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
info=psb_err_from_subroutine_
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)
end if
call mpi_alltoallv(works,sdsz,bsdindx,psb_mpi_integer,&
& workr,rvsz,brvindx,psb_mpi_integer,icomm,minfo)
call mpi_alltoallv(works,sdsz,bsdindx,psb_mpi_ipk_integer,&
& workr,rvsz,brvindx,psb_mpi_ipk_integer,icomm,minfo)
if (minfo /= psb_success_) then
info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='mpi_alltoallv')
base/tools/psb_ssphalo.F90
+5 -5
View File
@@ -189,7 +189,7 @@ Subroutine psb_ssphalo(a,desc_a,blk,info,rowcnv,colcnv,&
counter = counter+n_el_send+3
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
info=psb_err_from_subroutine_
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,&
& acoo%val,rvsz,brvindx,mpi_real,icomm,info)
call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_integer,&
& acoo%ia,rvsz,brvindx,psb_mpi_integer,icomm,info)
call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_integer,&
& acoo%ja,rvsz,brvindx,psb_mpi_integer,icomm,info)
call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_ipk_integer,&
& acoo%ia,rvsz,brvindx,psb_mpi_ipk_integer,icomm,info)
call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_ipk_integer,&
& acoo%ja,rvsz,brvindx,psb_mpi_ipk_integer,icomm,info)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='mpi_alltoallv'
base/tools/psb_zcdbldext.F90
+3 -3
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
! 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
info=psb_err_from_subroutine_
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)
end if
call mpi_alltoallv(works,sdsz,bsdindx,psb_mpi_integer,&
& workr,rvsz,brvindx,psb_mpi_integer,icomm,minfo)
call mpi_alltoallv(works,sdsz,bsdindx,psb_mpi_ipk_integer,&
& workr,rvsz,brvindx,psb_mpi_ipk_integer,icomm,minfo)
if (minfo /= psb_success_) then
info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='mpi_alltoallv')
base/tools/psb_zsphalo.F90
+5 -5
View File
@@ -189,7 +189,7 @@ Subroutine psb_zsphalo(a,desc_a,blk,info,rowcnv,colcnv,&
counter = counter+n_el_send+3
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
info=psb_err_from_subroutine_
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,&
& acoo%val,rvsz,brvindx,mpi_double_complex,icomm,info)
call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_integer,&
& acoo%ia,rvsz,brvindx,psb_mpi_integer,icomm,info)
call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_integer,&
& acoo%ja,rvsz,brvindx,psb_mpi_integer,icomm,info)
call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_ipk_integer,&
& acoo%ia,rvsz,brvindx,psb_mpi_ipk_integer,icomm,info)
call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_ipk_integer,&
& acoo%ja,rvsz,brvindx,psb_mpi_ipk_integer,icomm,info)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='mpi_alltoallv'