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

psblas3:

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_sscatter.F90
 base/comm/psb_sspgather.F90
 base/comm/psb_zscatter.F90
 base/comm/psb_zspgather.F90
 base/internals/psi_cswapdata.F90
 base/internals/psi_cswaptran.F90
 base/internals/psi_dswapdata.F90
 base/internals/psi_dswaptran.F90
 base/internals/psi_sswapdata.F90
 base/internals/psi_sswaptran.F90
 base/internals/psi_zswapdata.F90
 base/internals/psi_zswaptran.F90
 base/modules/psb_const_mod.F90
 base/modules/psb_i_tools_mod.f90
 base/modules/psi_bcast_mod.F90
 base/modules/psi_comm_buffers_mod.F90
 base/modules/psi_p2p_mod.F90
 base/modules/psi_reduce_mod.F90
 base/tools/psb_csphalo.F90
 base/tools/psb_dsphalo.F90
 base/tools/psb_glob_to_loc.f90
 base/tools/psb_loc_to_glob.f90
 base/tools/psb_ssphalo.F90
 base/tools/psb_zsphalo.F90

Parametrixe type identifiers in MPI operations.
psblas3-final
Salvatore Filippone 14 years ago
parent c384478d41
commit 57957c3f97
28 changed files with 362 additions and 365 deletions
Show Stats Download Patch File Download Diff File

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

@ -208,8 +208,8 @@ subroutine psb_cscatterm(globx, locx, desc_a, info, iroot)
! scatter !!! ! scatter !!!
call mpi_scatterv(scatterv,all_dim,displ,& call mpi_scatterv(scatterv,all_dim,displ,&
& mpi_complex,locx(1,jlocx+c-1),nrow,& & psb_mpi_c_spk_,locx(1,jlocx+c-1),nrow,&
& mpi_complex,rootrank,icomm,info) & psb_mpi_c_spk_,rootrank,icomm,info)
end do end do
@ -417,8 +417,8 @@ subroutine psb_cscatterv(globx, locx, desc_a, info, iroot)
end if end if
call mpi_scatterv(scatterv,all_dim,displ,& call mpi_scatterv(scatterv,all_dim,displ,&
& mpi_complex,locx,nrow,& & psb_mpi_c_spk_,locx,nrow,&
& mpi_complex,rootrank,icomm,info) & psb_mpi_c_spk_,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

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

@ -112,9 +112,9 @@ subroutine psb_csp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep
idisp(ip) = sum(nzbr(1:ip-1)) idisp(ip) = sum(nzbr(1:ip-1))
enddo enddo
ndx = nzbr(me+1) ndx = nzbr(me+1)
call mpi_allgatherv(loc_coo%val,ndx,mpi_complex,& call mpi_allgatherv(loc_coo%val,ndx,psb_mpi_c_spk_,&
& glob_coo%val,nzbr,idisp,& & glob_coo%val,nzbr,idisp,&
& mpi_complex,icomm,minfo) & psb_mpi_c_spk_,icomm,minfo)
if (minfo == psb_success_) call mpi_allgatherv(loc_coo%ia,ndx,psb_mpi_ipk_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_ipk_integer,icomm,minfo) & psb_mpi_ipk_integer,icomm,minfo)

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

@ -208,8 +208,8 @@ subroutine psb_dscatterm(globx, locx, desc_a, info, iroot)
! scatter !!! ! scatter !!!
call mpi_scatterv(scatterv,all_dim,displ,& call mpi_scatterv(scatterv,all_dim,displ,&
& mpi_double_precision,locx(1,jlocx+c-1),nrow,& & psb_mpi_r_dpk_,locx(1,jlocx+c-1),nrow,&
& mpi_double_precision,rootrank,icomm,info) & psb_mpi_r_dpk_,rootrank,icomm,info)
end do end do
@ -417,8 +417,8 @@ subroutine psb_dscatterv(globx, locx, desc_a, info, iroot)
end if end if
call mpi_scatterv(scatterv,all_dim,displ,& call mpi_scatterv(scatterv,all_dim,displ,&
& mpi_double_precision,locx,nrow,& & psb_mpi_r_dpk_,locx,nrow,&
& mpi_double_precision,rootrank,icomm,info) & psb_mpi_r_dpk_,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

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

@ -112,9 +112,9 @@ subroutine psb_dsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep
idisp(ip) = sum(nzbr(1:ip-1)) idisp(ip) = sum(nzbr(1:ip-1))
enddo enddo
ndx = nzbr(me+1) ndx = nzbr(me+1)
call mpi_allgatherv(loc_coo%val,ndx,mpi_double_precision,& call mpi_allgatherv(loc_coo%val,ndx,psb_mpi_r_dpk_,&
& glob_coo%val,nzbr,idisp,& & glob_coo%val,nzbr,idisp,&
& mpi_double_precision,icomm,minfo) & psb_mpi_r_dpk_,icomm,minfo)
if (minfo == psb_success_) call mpi_allgatherv(loc_coo%ia,ndx,psb_mpi_ipk_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_ipk_integer,icomm,minfo) & psb_mpi_ipk_integer,icomm,minfo)

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

@ -208,8 +208,8 @@ subroutine psb_sscatterm(globx, locx, desc_a, info, iroot)
! scatter !!! ! scatter !!!
call mpi_scatterv(scatterv,all_dim,displ,& call mpi_scatterv(scatterv,all_dim,displ,&
& mpi_real,locx(1,jlocx+c-1),nrow,& & psb_mpi_r_spk_,locx(1,jlocx+c-1),nrow,&
& mpi_real,rootrank,icomm,info) & psb_mpi_r_spk_,rootrank,icomm,info)
end do end do
@ -417,8 +417,8 @@ subroutine psb_sscatterv(globx, locx, desc_a, info, iroot)
end if end if
call mpi_scatterv(scatterv,all_dim,displ,& call mpi_scatterv(scatterv,all_dim,displ,&
& mpi_real,locx,nrow,& & psb_mpi_r_spk_,locx,nrow,&
& mpi_real,rootrank,icomm,info) & psb_mpi_r_spk_,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

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

@ -112,9 +112,9 @@ subroutine psb_ssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep
idisp(ip) = sum(nzbr(1:ip-1)) idisp(ip) = sum(nzbr(1:ip-1))
enddo enddo
ndx = nzbr(me+1) ndx = nzbr(me+1)
call mpi_allgatherv(loc_coo%val,ndx,mpi_real,& call mpi_allgatherv(loc_coo%val,ndx,psb_mpi_r_spk_,&
& glob_coo%val,nzbr,idisp,& & glob_coo%val,nzbr,idisp,&
& mpi_real,icomm,minfo) & psb_mpi_r_spk_,icomm,minfo)
if (minfo == psb_success_) call mpi_allgatherv(loc_coo%ia,ndx,psb_mpi_ipk_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_ipk_integer,icomm,minfo) & psb_mpi_ipk_integer,icomm,minfo)

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

@ -208,8 +208,8 @@ subroutine psb_zscatterm(globx, locx, desc_a, info, iroot)
! scatter !!! ! scatter !!!
call mpi_scatterv(scatterv,all_dim,displ,& call mpi_scatterv(scatterv,all_dim,displ,&
& mpi_double_complex,locx(1,jlocx+c-1),nrow,& & psb_mpi_c_dpk_,locx(1,jlocx+c-1),nrow,&
& mpi_double_complex,rootrank,icomm,info) & psb_mpi_c_dpk_,rootrank,icomm,info)
end do end do
@ -417,8 +417,8 @@ subroutine psb_zscatterv(globx, locx, desc_a, info, iroot)
end if end if
call mpi_scatterv(scatterv,all_dim,displ,& call mpi_scatterv(scatterv,all_dim,displ,&
& mpi_double_complex,locx,nrow,& & psb_mpi_c_dpk_,locx,nrow,&
& mpi_double_complex,rootrank,icomm,info) & psb_mpi_c_dpk_,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

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

@ -112,9 +112,9 @@ subroutine psb_zsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep
idisp(ip) = sum(nzbr(1:ip-1)) idisp(ip) = sum(nzbr(1:ip-1))
enddo enddo
ndx = nzbr(me+1) ndx = nzbr(me+1)
call mpi_allgatherv(loc_coo%val,ndx,mpi_double_complex,& call mpi_allgatherv(loc_coo%val,ndx,psb_mpi_c_dpk_,&
& glob_coo%val,nzbr,idisp,& & glob_coo%val,nzbr,idisp,&
& mpi_double_complex,icomm,minfo) & psb_mpi_c_dpk_,icomm,minfo)
if (minfo == psb_success_) call mpi_allgatherv(loc_coo%ia,ndx,psb_mpi_ipk_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_ipk_integer,icomm,minfo) & psb_mpi_ipk_integer,icomm,minfo)

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

@ -302,8 +302,8 @@ subroutine psi_cswapidxm(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,&
& mpi_complex,rcvbuf,rvsz,& & psb_mpi_c_spk_,rcvbuf,rvsz,&
& brvidx,mpi_complex,icomm,iret) & brvidx,psb_mpi_c_spk_,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_cswapidxm(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_complex_swap_tag p2ptag = psb_complex_swap_tag
call mpi_irecv(rcvbuf(rcv_pt),n*nerv,& call mpi_irecv(rcvbuf(rcv_pt),n*nerv,&
& mpi_complex,prcid(i),& & psb_mpi_c_spk_,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_cswapidxm(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,&
& mpi_complex,prcid(i),& & psb_mpi_c_spk_,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,&
& mpi_complex,prcid(i),& & psb_mpi_c_spk_,prcid(i),&
& p2ptag,icomm,iret) & p2ptag,icomm,iret)
end if end if
@ -801,8 +801,8 @@ subroutine psi_cswapidxv(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,&
& mpi_complex,rcvbuf,rvsz,& & psb_mpi_c_spk_,rcvbuf,rvsz,&
& brvidx,mpi_complex,icomm,iret) & brvidx,psb_mpi_c_spk_,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_cswapidxv(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_complex_swap_tag p2ptag = psb_complex_swap_tag
call mpi_irecv(rcvbuf(rcv_pt),nerv,& call mpi_irecv(rcvbuf(rcv_pt),nerv,&
& mpi_complex,prcid(i),& & psb_mpi_c_spk_,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_cswapidxv(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,&
& mpi_complex,prcid(i),& & psb_mpi_c_spk_,prcid(i),&
& p2ptag,icomm,iret) & p2ptag,icomm,iret)
else else
call mpi_send(sndbuf(snd_pt),nesd,& call mpi_send(sndbuf(snd_pt),nesd,&
& mpi_complex,prcid(i),& & psb_mpi_c_spk_,prcid(i),&
& p2ptag,icomm,iret) & p2ptag,icomm,iret)
end if end if
@ -1238,8 +1238,8 @@ subroutine psi_cswapidx_vect(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,
! swap elements using mpi_alltoallv ! swap elements using mpi_alltoallv
call mpi_alltoallv(sndbuf,sdsz,bsdidx,& call mpi_alltoallv(sndbuf,sdsz,bsdidx,&
& mpi_complex,rcvbuf,rvsz,& & psb_mpi_c_spk_,rcvbuf,rvsz,&
& brvidx,mpi_complex,icomm,iret) & brvidx,psb_mpi_c_spk_,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 @@ subroutine psi_cswapidx_vect(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,
if ((nerv>0).and.(proc_to_comm /= me)) then if ((nerv>0).and.(proc_to_comm /= me)) then
p2ptag = psb_complex_swap_tag p2ptag = psb_complex_swap_tag
call mpi_irecv(rcvbuf(rcv_pt),nerv,& call mpi_irecv(rcvbuf(rcv_pt),nerv,&
& mpi_complex,prcid(i),& & psb_mpi_c_spk_,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 @@ subroutine psi_cswapidx_vect(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,
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,&
& mpi_complex,prcid(i),& & psb_mpi_c_spk_,prcid(i),&
& p2ptag,icomm,iret) & p2ptag,icomm,iret)
else else
call mpi_send(sndbuf(snd_pt),nesd,& call mpi_send(sndbuf(snd_pt),nesd,&
& mpi_complex,prcid(i),& & psb_mpi_c_spk_,prcid(i),&
& p2ptag,icomm,iret) & p2ptag,icomm,iret)
end if end if

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

@ -320,8 +320,8 @@ subroutine psi_ctranidxm(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,&
& mpi_complex,& & psb_mpi_c_spk_,&
& sndbuf,sdsz,bsdidx,mpi_complex,icomm,iret) & sndbuf,sdsz,bsdidx,psb_mpi_c_spk_,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_ctranidxm(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_complex_swap_tag p2ptag = psb_complex_swap_tag
call mpi_irecv(sndbuf(snd_pt),n*nesd,& call mpi_irecv(sndbuf(snd_pt),n*nesd,&
& mpi_complex,prcid(i),& & psb_mpi_c_spk_,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_ctranidxm(iictxt,iicomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,wo
p2ptag = psb_complex_swap_tag p2ptag = psb_complex_swap_tag
if (usersend) then if (usersend) then
call mpi_rsend(rcvbuf(rcv_pt),n*nerv,& call mpi_rsend(rcvbuf(rcv_pt),n*nerv,&
& mpi_complex,prcid(i),& & psb_mpi_c_spk_,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,&
& mpi_complex,prcid(i),& & psb_mpi_c_spk_,prcid(i),&
& p2ptag,icomm,iret) & p2ptag,icomm,iret)
end if end if
@ -824,8 +824,8 @@ subroutine psi_ctranidxv(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,&
& mpi_complex,& & psb_mpi_c_spk_,&
& sndbuf,sdsz,bsdidx,mpi_complex,icomm,iret) & sndbuf,sdsz,bsdidx,psb_mpi_c_spk_,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_ctranidxv(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_complex_swap_tag p2ptag = psb_complex_swap_tag
call mpi_irecv(sndbuf(snd_pt),nesd,& call mpi_irecv(sndbuf(snd_pt),nesd,&
& mpi_complex,prcid(i),& & psb_mpi_c_spk_,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_ctranidxv(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,work
p2ptag = psb_complex_swap_tag p2ptag = psb_complex_swap_tag
if (usersend) then if (usersend) then
call mpi_rsend(rcvbuf(rcv_pt),nerv,& call mpi_rsend(rcvbuf(rcv_pt),nerv,&
& mpi_complex,prcid(i),& & psb_mpi_c_spk_,prcid(i),&
& p2ptag, icomm,iret) & p2ptag, icomm,iret)
else else
call mpi_send(rcvbuf(rcv_pt),nerv,& call mpi_send(rcvbuf(rcv_pt),nerv,&
& mpi_complex,prcid(i),& & psb_mpi_c_spk_,prcid(i),&
& p2ptag, icomm,iret) & p2ptag, icomm,iret)
end if end if
@ -1273,8 +1273,8 @@ subroutine psi_ctranidx_vect(iictxt,iicomm,flag,beta,y,idx,&
! swap elements using mpi_alltoallv ! swap elements using mpi_alltoallv
call mpi_alltoallv(rcvbuf,rvsz,brvidx,& call mpi_alltoallv(rcvbuf,rvsz,brvidx,&
& mpi_complex,& & psb_mpi_c_spk_,&
& sndbuf,sdsz,bsdidx,mpi_complex,icomm,iret) & sndbuf,sdsz,bsdidx,psb_mpi_c_spk_,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 @@ subroutine psi_ctranidx_vect(iictxt,iicomm,flag,beta,y,idx,&
if ((nesd>0).and.(proc_to_comm /= me)) then if ((nesd>0).and.(proc_to_comm /= me)) then
p2ptag = psb_complex_swap_tag p2ptag = psb_complex_swap_tag
call mpi_irecv(sndbuf(snd_pt),nesd,& call mpi_irecv(sndbuf(snd_pt),nesd,&
& mpi_complex,prcid(i),& & psb_mpi_c_spk_,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 @@ subroutine psi_ctranidx_vect(iictxt,iicomm,flag,beta,y,idx,&
p2ptag = psb_complex_swap_tag p2ptag = psb_complex_swap_tag
if (usersend) then if (usersend) then
call mpi_rsend(rcvbuf(rcv_pt),nerv,& call mpi_rsend(rcvbuf(rcv_pt),nerv,&
& mpi_complex,prcid(i),& & psb_mpi_c_spk_,prcid(i),&
& p2ptag, icomm,iret) & p2ptag, icomm,iret)
else else
call mpi_send(rcvbuf(rcv_pt),nerv,& call mpi_send(rcvbuf(rcv_pt),nerv,&
& mpi_complex,prcid(i),& & psb_mpi_c_spk_,prcid(i),&
& p2ptag, icomm,iret) & p2ptag, icomm,iret)
end if end if

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

@ -302,8 +302,8 @@ subroutine psi_dswapidxm(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,&
& mpi_double_precision,rcvbuf,rvsz,& & psb_mpi_r_dpk_,rcvbuf,rvsz,&
& brvidx,mpi_double_precision,icomm,iret) & brvidx,psb_mpi_r_dpk_,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_dswapidxm(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_double_swap_tag p2ptag = psb_double_swap_tag
call mpi_irecv(rcvbuf(rcv_pt),n*nerv,& call mpi_irecv(rcvbuf(rcv_pt),n*nerv,&
& mpi_double_precision,prcid(i),& & psb_mpi_r_dpk_,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_dswapidxm(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,&
& mpi_double_precision,prcid(i),& & psb_mpi_r_dpk_,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,&
& mpi_double_precision,prcid(i),& & psb_mpi_r_dpk_,prcid(i),&
& p2ptag,icomm,iret) & p2ptag,icomm,iret)
end if end if
@ -801,8 +801,8 @@ subroutine psi_dswapidxv(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,&
& mpi_double_precision,rcvbuf,rvsz,& & psb_mpi_r_dpk_,rcvbuf,rvsz,&
& brvidx,mpi_double_precision,icomm,iret) & brvidx,psb_mpi_r_dpk_,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_dswapidxv(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_double_swap_tag p2ptag = psb_double_swap_tag
call mpi_irecv(rcvbuf(rcv_pt),nerv,& call mpi_irecv(rcvbuf(rcv_pt),nerv,&
& mpi_double_precision,prcid(i),& & psb_mpi_r_dpk_,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_dswapidxv(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,&
& mpi_double_precision,prcid(i),& & psb_mpi_r_dpk_,prcid(i),&
& p2ptag,icomm,iret) & p2ptag,icomm,iret)
else else
call mpi_send(sndbuf(snd_pt),nesd,& call mpi_send(sndbuf(snd_pt),nesd,&
& mpi_double_precision,prcid(i),& & psb_mpi_r_dpk_,prcid(i),&
& p2ptag,icomm,iret) & p2ptag,icomm,iret)
end if end if
@ -1238,8 +1238,8 @@ subroutine psi_dswapidx_vect(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,
! swap elements using mpi_alltoallv ! swap elements using mpi_alltoallv
call mpi_alltoallv(sndbuf,sdsz,bsdidx,& call mpi_alltoallv(sndbuf,sdsz,bsdidx,&
& mpi_double_precision,rcvbuf,rvsz,& & psb_mpi_r_dpk_,rcvbuf,rvsz,&
& brvidx,mpi_double_precision,icomm,iret) & brvidx,psb_mpi_r_dpk_,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 @@ subroutine psi_dswapidx_vect(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,
if ((nerv>0).and.(proc_to_comm /= me)) then if ((nerv>0).and.(proc_to_comm /= me)) then
p2ptag = psb_double_swap_tag p2ptag = psb_double_swap_tag
call mpi_irecv(rcvbuf(rcv_pt),nerv,& call mpi_irecv(rcvbuf(rcv_pt),nerv,&
& mpi_double_precision,prcid(i),& & psb_mpi_r_dpk_,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 @@ subroutine psi_dswapidx_vect(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,
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,&
& mpi_double_precision,prcid(i),& & psb_mpi_r_dpk_,prcid(i),&
& p2ptag,icomm,iret) & p2ptag,icomm,iret)
else else
call mpi_send(sndbuf(snd_pt),nesd,& call mpi_send(sndbuf(snd_pt),nesd,&
& mpi_double_precision,prcid(i),& & psb_mpi_r_dpk_,prcid(i),&
& p2ptag,icomm,iret) & p2ptag,icomm,iret)
end if end if

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

@ -320,8 +320,8 @@ subroutine psi_dtranidxm(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,&
& mpi_double_precision,& & psb_mpi_r_dpk_,&
& sndbuf,sdsz,bsdidx,mpi_double_precision,icomm,iret) & sndbuf,sdsz,bsdidx,psb_mpi_r_dpk_,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_dtranidxm(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_double_swap_tag p2ptag = psb_double_swap_tag
call mpi_irecv(sndbuf(snd_pt),n*nesd,& call mpi_irecv(sndbuf(snd_pt),n*nesd,&
& mpi_double_precision,prcid(i),& & psb_mpi_r_dpk_,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_dtranidxm(iictxt,iicomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,wo
p2ptag = psb_double_swap_tag p2ptag = psb_double_swap_tag
if (usersend) then if (usersend) then
call mpi_rsend(rcvbuf(rcv_pt),n*nerv,& call mpi_rsend(rcvbuf(rcv_pt),n*nerv,&
& mpi_double_precision,prcid(i),& & psb_mpi_r_dpk_,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,&
& mpi_double_precision,prcid(i),& & psb_mpi_r_dpk_,prcid(i),&
& p2ptag,icomm,iret) & p2ptag,icomm,iret)
end if end if
@ -824,8 +824,8 @@ subroutine psi_dtranidxv(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,&
& mpi_double_precision,& & psb_mpi_r_dpk_,&
& sndbuf,sdsz,bsdidx,mpi_double_precision,icomm,iret) & sndbuf,sdsz,bsdidx,psb_mpi_r_dpk_,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_dtranidxv(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_double_swap_tag p2ptag = psb_double_swap_tag
call mpi_irecv(sndbuf(snd_pt),nesd,& call mpi_irecv(sndbuf(snd_pt),nesd,&
& mpi_double_precision,prcid(i),& & psb_mpi_r_dpk_,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_dtranidxv(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,work
p2ptag = psb_double_swap_tag p2ptag = psb_double_swap_tag
if (usersend) then if (usersend) then
call mpi_rsend(rcvbuf(rcv_pt),nerv,& call mpi_rsend(rcvbuf(rcv_pt),nerv,&
& mpi_double_precision,prcid(i),& & psb_mpi_r_dpk_,prcid(i),&
& p2ptag, icomm,iret) & p2ptag, icomm,iret)
else else
call mpi_send(rcvbuf(rcv_pt),nerv,& call mpi_send(rcvbuf(rcv_pt),nerv,&
& mpi_double_precision,prcid(i),& & psb_mpi_r_dpk_,prcid(i),&
& p2ptag, icomm,iret) & p2ptag, icomm,iret)
end if end if
@ -1273,8 +1273,8 @@ subroutine psi_dtranidx_vect(iictxt,iicomm,flag,beta,y,idx,&
! swap elements using mpi_alltoallv ! swap elements using mpi_alltoallv
call mpi_alltoallv(rcvbuf,rvsz,brvidx,& call mpi_alltoallv(rcvbuf,rvsz,brvidx,&
& mpi_double_precision,& & psb_mpi_r_dpk_,&
& sndbuf,sdsz,bsdidx,mpi_double_precision,icomm,iret) & sndbuf,sdsz,bsdidx,psb_mpi_r_dpk_,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 @@ subroutine psi_dtranidx_vect(iictxt,iicomm,flag,beta,y,idx,&
if ((nesd>0).and.(proc_to_comm /= me)) then if ((nesd>0).and.(proc_to_comm /= me)) then
p2ptag = psb_double_swap_tag p2ptag = psb_double_swap_tag
call mpi_irecv(sndbuf(snd_pt),nesd,& call mpi_irecv(sndbuf(snd_pt),nesd,&
& mpi_double_precision,prcid(i),& & psb_mpi_r_dpk_,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 @@ subroutine psi_dtranidx_vect(iictxt,iicomm,flag,beta,y,idx,&
p2ptag = psb_double_swap_tag p2ptag = psb_double_swap_tag
if (usersend) then if (usersend) then
call mpi_rsend(rcvbuf(rcv_pt),nerv,& call mpi_rsend(rcvbuf(rcv_pt),nerv,&
& mpi_double_precision,prcid(i),& & psb_mpi_r_dpk_,prcid(i),&
& p2ptag, icomm,iret) & p2ptag, icomm,iret)
else else
call mpi_send(rcvbuf(rcv_pt),nerv,& call mpi_send(rcvbuf(rcv_pt),nerv,&
& mpi_double_precision,prcid(i),& & psb_mpi_r_dpk_,prcid(i),&
& p2ptag, icomm,iret) & p2ptag, icomm,iret)
end if end if

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

@ -302,8 +302,8 @@ subroutine psi_sswapidxm(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,&
& mpi_real,rcvbuf,rvsz,& & psb_mpi_r_spk_,rcvbuf,rvsz,&
& brvidx,mpi_real,icomm,iret) & brvidx,psb_mpi_r_spk_,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_sswapidxm(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_real_swap_tag p2ptag = psb_real_swap_tag
call mpi_irecv(rcvbuf(rcv_pt),n*nerv,& call mpi_irecv(rcvbuf(rcv_pt),n*nerv,&
& mpi_real,prcid(i),& & psb_mpi_r_spk_,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_sswapidxm(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,&
& mpi_real,prcid(i),& & psb_mpi_r_spk_,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,&
& mpi_real,prcid(i),& & psb_mpi_r_spk_,prcid(i),&
& p2ptag,icomm,iret) & p2ptag,icomm,iret)
end if end if
@ -801,8 +801,8 @@ subroutine psi_sswapidxv(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,&
& mpi_real,rcvbuf,rvsz,& & psb_mpi_r_spk_,rcvbuf,rvsz,&
& brvidx,mpi_real,icomm,iret) & brvidx,psb_mpi_r_spk_,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_sswapidxv(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_real_swap_tag p2ptag = psb_real_swap_tag
call mpi_irecv(rcvbuf(rcv_pt),nerv,& call mpi_irecv(rcvbuf(rcv_pt),nerv,&
& mpi_real,prcid(i),& & psb_mpi_r_spk_,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_sswapidxv(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,&
& mpi_real,prcid(i),& & psb_mpi_r_spk_,prcid(i),&
& p2ptag,icomm,iret) & p2ptag,icomm,iret)
else else
call mpi_send(sndbuf(snd_pt),nesd,& call mpi_send(sndbuf(snd_pt),nesd,&
& mpi_real,prcid(i),& & psb_mpi_r_spk_,prcid(i),&
& p2ptag,icomm,iret) & p2ptag,icomm,iret)
end if end if
@ -1238,8 +1238,8 @@ subroutine psi_sswapidx_vect(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,
! swap elements using mpi_alltoallv ! swap elements using mpi_alltoallv
call mpi_alltoallv(sndbuf,sdsz,bsdidx,& call mpi_alltoallv(sndbuf,sdsz,bsdidx,&
& mpi_real,rcvbuf,rvsz,& & psb_mpi_r_spk_,rcvbuf,rvsz,&
& brvidx,mpi_real,icomm,iret) & brvidx,psb_mpi_r_spk_,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 @@ subroutine psi_sswapidx_vect(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,
if ((nerv>0).and.(proc_to_comm /= me)) then if ((nerv>0).and.(proc_to_comm /= me)) then
p2ptag = psb_real_swap_tag p2ptag = psb_real_swap_tag
call mpi_irecv(rcvbuf(rcv_pt),nerv,& call mpi_irecv(rcvbuf(rcv_pt),nerv,&
& mpi_real,prcid(i),& & psb_mpi_r_spk_,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 @@ subroutine psi_sswapidx_vect(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,
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,&
& mpi_real,prcid(i),& & psb_mpi_r_spk_,prcid(i),&
& p2ptag,icomm,iret) & p2ptag,icomm,iret)
else else
call mpi_send(sndbuf(snd_pt),nesd,& call mpi_send(sndbuf(snd_pt),nesd,&
& mpi_real,prcid(i),& & psb_mpi_r_spk_,prcid(i),&
& p2ptag,icomm,iret) & p2ptag,icomm,iret)
end if end if

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

@ -320,8 +320,8 @@ subroutine psi_stranidxm(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,&
& mpi_real,& & psb_mpi_r_spk_,&
& sndbuf,sdsz,bsdidx,mpi_real,icomm,iret) & sndbuf,sdsz,bsdidx,psb_mpi_r_spk_,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_stranidxm(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_real_swap_tag p2ptag = psb_real_swap_tag
call mpi_irecv(sndbuf(snd_pt),n*nesd,& call mpi_irecv(sndbuf(snd_pt),n*nesd,&
& mpi_real,prcid(i),& & psb_mpi_r_spk_,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_stranidxm(iictxt,iicomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,wo
p2ptag = psb_real_swap_tag p2ptag = psb_real_swap_tag
if (usersend) then if (usersend) then
call mpi_rsend(rcvbuf(rcv_pt),n*nerv,& call mpi_rsend(rcvbuf(rcv_pt),n*nerv,&
& mpi_real,prcid(i),& & psb_mpi_r_spk_,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,&
& mpi_real,prcid(i),& & psb_mpi_r_spk_,prcid(i),&
& p2ptag,icomm,iret) & p2ptag,icomm,iret)
end if end if
@ -824,8 +824,8 @@ subroutine psi_stranidxv(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,&
& mpi_real,& & psb_mpi_r_spk_,&
& sndbuf,sdsz,bsdidx,mpi_real,icomm,iret) & sndbuf,sdsz,bsdidx,psb_mpi_r_spk_,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_stranidxv(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_real_swap_tag p2ptag = psb_real_swap_tag
call mpi_irecv(sndbuf(snd_pt),nesd,& call mpi_irecv(sndbuf(snd_pt),nesd,&
& mpi_real,prcid(i),& & psb_mpi_r_spk_,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_stranidxv(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,work
p2ptag = psb_real_swap_tag p2ptag = psb_real_swap_tag
if (usersend) then if (usersend) then
call mpi_rsend(rcvbuf(rcv_pt),nerv,& call mpi_rsend(rcvbuf(rcv_pt),nerv,&
& mpi_real,prcid(i),& & psb_mpi_r_spk_,prcid(i),&
& p2ptag, icomm,iret) & p2ptag, icomm,iret)
else else
call mpi_send(rcvbuf(rcv_pt),nerv,& call mpi_send(rcvbuf(rcv_pt),nerv,&
& mpi_real,prcid(i),& & psb_mpi_r_spk_,prcid(i),&
& p2ptag, icomm,iret) & p2ptag, icomm,iret)
end if end if
@ -1273,8 +1273,8 @@ subroutine psi_stranidx_vect(iictxt,iicomm,flag,beta,y,idx,&
! swap elements using mpi_alltoallv ! swap elements using mpi_alltoallv
call mpi_alltoallv(rcvbuf,rvsz,brvidx,& call mpi_alltoallv(rcvbuf,rvsz,brvidx,&
& mpi_real,& & psb_mpi_r_spk_,&
& sndbuf,sdsz,bsdidx,mpi_real,icomm,iret) & sndbuf,sdsz,bsdidx,psb_mpi_r_spk_,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 @@ subroutine psi_stranidx_vect(iictxt,iicomm,flag,beta,y,idx,&
if ((nesd>0).and.(proc_to_comm /= me)) then if ((nesd>0).and.(proc_to_comm /= me)) then
p2ptag = psb_real_swap_tag p2ptag = psb_real_swap_tag
call mpi_irecv(sndbuf(snd_pt),nesd,& call mpi_irecv(sndbuf(snd_pt),nesd,&
& mpi_real,prcid(i),& & psb_mpi_r_spk_,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 @@ subroutine psi_stranidx_vect(iictxt,iicomm,flag,beta,y,idx,&
p2ptag = psb_real_swap_tag p2ptag = psb_real_swap_tag
if (usersend) then if (usersend) then
call mpi_rsend(rcvbuf(rcv_pt),nerv,& call mpi_rsend(rcvbuf(rcv_pt),nerv,&
& mpi_real,prcid(i),& & psb_mpi_r_spk_,prcid(i),&
& p2ptag, icomm,iret) & p2ptag, icomm,iret)
else else
call mpi_send(rcvbuf(rcv_pt),nerv,& call mpi_send(rcvbuf(rcv_pt),nerv,&
& mpi_real,prcid(i),& & psb_mpi_r_spk_,prcid(i),&
& p2ptag, icomm,iret) & p2ptag, icomm,iret)
end if end if

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

@ -302,8 +302,8 @@ subroutine psi_zswapidxm(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,&
& mpi_double_complex,rcvbuf,rvsz,& & psb_mpi_c_dpk_,rcvbuf,rvsz,&
& brvidx,mpi_double_complex,icomm,iret) & brvidx,psb_mpi_c_dpk_,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_zswapidxm(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_dcomplex_swap_tag p2ptag = psb_dcomplex_swap_tag
call mpi_irecv(rcvbuf(rcv_pt),n*nerv,& call mpi_irecv(rcvbuf(rcv_pt),n*nerv,&
& mpi_double_complex,prcid(i),& & psb_mpi_c_dpk_,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_zswapidxm(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,&
& mpi_double_complex,prcid(i),& & psb_mpi_c_dpk_,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,&
& mpi_double_complex,prcid(i),& & psb_mpi_c_dpk_,prcid(i),&
& p2ptag,icomm,iret) & p2ptag,icomm,iret)
end if end if
@ -801,8 +801,8 @@ subroutine psi_zswapidxv(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,&
& mpi_double_complex,rcvbuf,rvsz,& & psb_mpi_c_dpk_,rcvbuf,rvsz,&
& brvidx,mpi_double_complex,icomm,iret) & brvidx,psb_mpi_c_dpk_,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_zswapidxv(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_dcomplex_swap_tag p2ptag = psb_dcomplex_swap_tag
call mpi_irecv(rcvbuf(rcv_pt),nerv,& call mpi_irecv(rcvbuf(rcv_pt),nerv,&
& mpi_double_complex,prcid(i),& & psb_mpi_c_dpk_,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_zswapidxv(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,&
& mpi_double_complex,prcid(i),& & psb_mpi_c_dpk_,prcid(i),&
& p2ptag,icomm,iret) & p2ptag,icomm,iret)
else else
call mpi_send(sndbuf(snd_pt),nesd,& call mpi_send(sndbuf(snd_pt),nesd,&
& mpi_double_complex,prcid(i),& & psb_mpi_c_dpk_,prcid(i),&
& p2ptag,icomm,iret) & p2ptag,icomm,iret)
end if end if
@ -1238,8 +1238,8 @@ subroutine psi_zswapidx_vect(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,
! swap elements using mpi_alltoallv ! swap elements using mpi_alltoallv
call mpi_alltoallv(sndbuf,sdsz,bsdidx,& call mpi_alltoallv(sndbuf,sdsz,bsdidx,&
& mpi_double_complex,rcvbuf,rvsz,& & psb_mpi_c_dpk_,rcvbuf,rvsz,&
& brvidx,mpi_double_complex,icomm,iret) & brvidx,psb_mpi_c_dpk_,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 @@ subroutine psi_zswapidx_vect(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,
if ((nerv>0).and.(proc_to_comm /= me)) then if ((nerv>0).and.(proc_to_comm /= me)) then
p2ptag = psb_dcomplex_swap_tag p2ptag = psb_dcomplex_swap_tag
call mpi_irecv(rcvbuf(rcv_pt),nerv,& call mpi_irecv(rcvbuf(rcv_pt),nerv,&
& mpi_double_complex,prcid(i),& & psb_mpi_c_dpk_,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 @@ subroutine psi_zswapidx_vect(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,
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,&
& mpi_double_complex,prcid(i),& & psb_mpi_c_dpk_,prcid(i),&
& p2ptag,icomm,iret) & p2ptag,icomm,iret)
else else
call mpi_send(sndbuf(snd_pt),nesd,& call mpi_send(sndbuf(snd_pt),nesd,&
& mpi_double_complex,prcid(i),& & psb_mpi_c_dpk_,prcid(i),&
& p2ptag,icomm,iret) & p2ptag,icomm,iret)
end if end if

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

@ -320,8 +320,8 @@ subroutine psi_ztranidxm(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,&
& mpi_double_complex,& & psb_mpi_c_dpk_,&
& sndbuf,sdsz,bsdidx,mpi_double_complex,icomm,iret) & sndbuf,sdsz,bsdidx,psb_mpi_c_dpk_,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_ztranidxm(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_dcomplex_swap_tag p2ptag = psb_dcomplex_swap_tag
call mpi_irecv(sndbuf(snd_pt),n*nesd,& call mpi_irecv(sndbuf(snd_pt),n*nesd,&
& mpi_double_complex,prcid(i),& & psb_mpi_c_dpk_,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_ztranidxm(iictxt,iicomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,wo
p2ptag = psb_dcomplex_swap_tag p2ptag = psb_dcomplex_swap_tag
if (usersend) then if (usersend) then
call mpi_rsend(rcvbuf(rcv_pt),n*nerv,& call mpi_rsend(rcvbuf(rcv_pt),n*nerv,&
& mpi_double_complex,prcid(i),& & psb_mpi_c_dpk_,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,&
& mpi_double_complex,prcid(i),& & psb_mpi_c_dpk_,prcid(i),&
& p2ptag,icomm,iret) & p2ptag,icomm,iret)
end if end if
@ -824,8 +824,8 @@ subroutine psi_ztranidxv(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,&
& mpi_double_complex,& & psb_mpi_c_dpk_,&
& sndbuf,sdsz,bsdidx,mpi_double_complex,icomm,iret) & sndbuf,sdsz,bsdidx,psb_mpi_c_dpk_,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_ztranidxv(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_dcomplex_swap_tag p2ptag = psb_dcomplex_swap_tag
call mpi_irecv(sndbuf(snd_pt),nesd,& call mpi_irecv(sndbuf(snd_pt),nesd,&
& mpi_double_complex,prcid(i),& & psb_mpi_c_dpk_,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_ztranidxv(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,work
p2ptag = psb_dcomplex_swap_tag p2ptag = psb_dcomplex_swap_tag
if (usersend) then if (usersend) then
call mpi_rsend(rcvbuf(rcv_pt),nerv,& call mpi_rsend(rcvbuf(rcv_pt),nerv,&
& mpi_double_complex,prcid(i),& & psb_mpi_c_dpk_,prcid(i),&
& p2ptag, icomm,iret) & p2ptag, icomm,iret)
else else
call mpi_send(rcvbuf(rcv_pt),nerv,& call mpi_send(rcvbuf(rcv_pt),nerv,&
& mpi_double_complex,prcid(i),& & psb_mpi_c_dpk_,prcid(i),&
& p2ptag, icomm,iret) & p2ptag, icomm,iret)
end if end if
@ -1273,8 +1273,8 @@ subroutine psi_ztranidx_vect(iictxt,iicomm,flag,beta,y,idx,&
! swap elements using mpi_alltoallv ! swap elements using mpi_alltoallv
call mpi_alltoallv(rcvbuf,rvsz,brvidx,& call mpi_alltoallv(rcvbuf,rvsz,brvidx,&
& mpi_double_complex,& & psb_mpi_c_dpk_,&
& sndbuf,sdsz,bsdidx,mpi_double_complex,icomm,iret) & sndbuf,sdsz,bsdidx,psb_mpi_c_dpk_,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 @@ subroutine psi_ztranidx_vect(iictxt,iicomm,flag,beta,y,idx,&
if ((nesd>0).and.(proc_to_comm /= me)) then if ((nesd>0).and.(proc_to_comm /= me)) then
p2ptag = psb_dcomplex_swap_tag p2ptag = psb_dcomplex_swap_tag
call mpi_irecv(sndbuf(snd_pt),nesd,& call mpi_irecv(sndbuf(snd_pt),nesd,&
& mpi_double_complex,prcid(i),& & psb_mpi_c_dpk_,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 @@ subroutine psi_ztranidx_vect(iictxt,iicomm,flag,beta,y,idx,&
p2ptag = psb_dcomplex_swap_tag p2ptag = psb_dcomplex_swap_tag
if (usersend) then if (usersend) then
call mpi_rsend(rcvbuf(rcv_pt),nerv,& call mpi_rsend(rcvbuf(rcv_pt),nerv,&
& mpi_double_complex,prcid(i),& & psb_mpi_c_dpk_,prcid(i),&
& p2ptag, icomm,iret) & p2ptag, icomm,iret)
else else
call mpi_send(rcvbuf(rcv_pt),nerv,& call mpi_send(rcvbuf(rcv_pt),nerv,&
& mpi_double_complex,prcid(i),& & psb_mpi_c_dpk_,prcid(i),&
& p2ptag, icomm,iret) & p2ptag, icomm,iret)
end if end if

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

@ -47,8 +47,8 @@ module psb_const_mod
! This is always a 4-byte integer, for MPI-related stuff ! This is always a 4-byte integer, for MPI-related stuff
integer, parameter :: psb_mpik_ = kind(1) integer, parameter :: psb_mpik_ = kind(1)
! !
! These must be the kind parameter corresponding to MPI_DOUBLE_PRECISION ! These must be the kind parameter corresponding to psb_mpi_r_dpk_
! and MPI_REAL ! and psb_mpi_r_spk_
! !
integer(psb_mpik_), parameter :: psb_spk_p_ = 6 integer(psb_mpik_), parameter :: psb_spk_p_ = 6
integer(psb_mpik_), parameter :: psb_spk_r_ = 37 integer(psb_mpik_), parameter :: psb_spk_r_ = 37

27
base/modules/psb_i_tools_mod.f90
Unescape Escape View File

@ -146,7 +146,7 @@ module psb_i_tools_mod
interface psb_glob_to_loc interface psb_glob_to_loc
subroutine psb_glob_to_loc2(x,y,desc_a,info,iact,owned) subroutine psb_glob_to_loc2v(x,y,desc_a,info,iact,owned)
import :: psb_ipk_, psb_desc_type import :: psb_ipk_, psb_desc_type
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_),intent(in) :: x(:) integer(psb_ipk_),intent(in) :: x(:)
@ -154,15 +154,15 @@ module psb_i_tools_mod
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: owned logical, intent(in), optional :: owned
character, intent(in), optional :: iact character, intent(in), optional :: iact
end subroutine psb_glob_to_loc2 end subroutine psb_glob_to_loc2v
subroutine psb_glob_to_loc(x,desc_a,info,iact,owned) subroutine psb_glob_to_loc1v(x,desc_a,info,iact,owned)
import :: psb_ipk_, psb_desc_type import :: psb_ipk_, psb_desc_type
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_),intent(inout) :: x(:) integer(psb_ipk_),intent(inout) :: x(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: owned logical, intent(in), optional :: owned
character, intent(in), optional :: iact character, intent(in), optional :: iact
end subroutine psb_glob_to_loc end subroutine psb_glob_to_loc1v
subroutine psb_glob_to_loc2s(x,y,desc_a,info,iact,owned) subroutine psb_glob_to_loc2s(x,y,desc_a,info,iact,owned)
import :: psb_ipk_, psb_desc_type import :: psb_ipk_, psb_desc_type
implicit none implicit none
@ -172,10 +172,8 @@ module psb_i_tools_mod
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: iact character, intent(in), optional :: iact
logical, intent(in), optional :: owned logical, intent(in), optional :: owned
end subroutine psb_glob_to_loc2s end subroutine psb_glob_to_loc2s
subroutine psb_glob_to_loc1s(x,desc_a,info,iact,owned)
subroutine psb_glob_to_locs(x,desc_a,info,iact,owned)
import :: psb_ipk_, psb_desc_type import :: psb_ipk_, psb_desc_type
implicit none implicit none
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
@ -183,25 +181,25 @@ module psb_i_tools_mod
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: iact character, intent(in), optional :: iact
logical, intent(in), optional :: owned logical, intent(in), optional :: owned
end subroutine psb_glob_to_locs end subroutine psb_glob_to_loc1s
end interface end interface
interface psb_loc_to_glob interface psb_loc_to_glob
subroutine psb_loc_to_glob2(x,y,desc_a,info,iact) subroutine psb_loc_to_glob2v(x,y,desc_a,info,iact)
import :: psb_ipk_, psb_desc_type import :: psb_ipk_, psb_desc_type
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_),intent(in) :: x(:) integer(psb_ipk_),intent(in) :: x(:)
integer(psb_ipk_),intent(out) :: y(:) integer(psb_ipk_),intent(out) :: y(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: iact character, intent(in), optional :: iact
end subroutine psb_loc_to_glob2 end subroutine psb_loc_to_glob2v
subroutine psb_loc_to_glob(x,desc_a,info,iact) subroutine psb_loc_to_glob1v(x,desc_a,info,iact)
import :: psb_ipk_, psb_desc_type import :: psb_ipk_, psb_desc_type
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_),intent(inout) :: x(:) integer(psb_ipk_),intent(inout) :: x(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: iact character, intent(in), optional :: iact
end subroutine psb_loc_to_glob end subroutine psb_loc_to_glob1v
subroutine psb_loc_to_glob2s(x,y,desc_a,info,iact) subroutine psb_loc_to_glob2s(x,y,desc_a,info,iact)
import :: psb_ipk_, psb_desc_type import :: psb_ipk_, psb_desc_type
implicit none implicit none
@ -210,15 +208,14 @@ module psb_i_tools_mod
integer(psb_ipk_),intent(out) :: y integer(psb_ipk_),intent(out) :: y
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: iact character, intent(in), optional :: iact
end subroutine psb_loc_to_glob2s end subroutine psb_loc_to_glob2s
subroutine psb_loc_to_globs(x,desc_a,info,iact) subroutine psb_loc_to_glob1s(x,desc_a,info,iact)
import :: psb_ipk_, psb_desc_type import :: psb_ipk_, psb_desc_type
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_),intent(inout) :: x integer(psb_ipk_),intent(inout) :: x
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: iact character, intent(in), optional :: iact
end subroutine psb_loc_to_globs end subroutine psb_loc_to_glob1s
end interface end interface

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

@ -169,7 +169,7 @@ contains
endif endif
call psb_info(ictxt,iam,np) call psb_info(ictxt,iam,np)
call mpi_bcast(dat,1,mpi_real,root_,ictxt,info) call mpi_bcast(dat,1,psb_mpi_r_spk_,root_,ictxt,info)
#endif #endif
end subroutine psb_sbcasts end subroutine psb_sbcasts
@ -196,7 +196,7 @@ contains
endif endif
call psb_info(ictxt,iam,np) call psb_info(ictxt,iam,np)
call mpi_bcast(dat,size(dat),mpi_real,root_,ictxt,info) call mpi_bcast(dat,size(dat),psb_mpi_r_spk_,root_,ictxt,info)
#endif #endif
end subroutine psb_sbcastv end subroutine psb_sbcastv
@ -223,7 +223,7 @@ contains
endif endif
call psb_info(ictxt,iam,np) call psb_info(ictxt,iam,np)
call mpi_bcast(dat,size(dat),mpi_real,root_,ictxt,info) call mpi_bcast(dat,size(dat),psb_mpi_r_spk_,root_,ictxt,info)
#endif #endif
end subroutine psb_sbcastm end subroutine psb_sbcastm
@ -251,7 +251,7 @@ contains
endif endif
call psb_info(ictxt,iam,np) call psb_info(ictxt,iam,np)
call mpi_bcast(dat,1,mpi_double_precision,root_,ictxt,info) call mpi_bcast(dat,1,psb_mpi_r_dpk_,root_,ictxt,info)
#endif #endif
end subroutine psb_dbcasts end subroutine psb_dbcasts
@ -278,7 +278,7 @@ contains
endif endif
call psb_info(ictxt,iam,np) call psb_info(ictxt,iam,np)
call mpi_bcast(dat,size(dat),mpi_double_precision,root_,ictxt,info) call mpi_bcast(dat,size(dat),psb_mpi_r_dpk_,root_,ictxt,info)
#endif #endif
end subroutine psb_dbcastv end subroutine psb_dbcastv
@ -304,7 +304,7 @@ contains
endif endif
call psb_info(ictxt,iam,np) call psb_info(ictxt,iam,np)
call mpi_bcast(dat,size(dat),mpi_double_precision,root_,ictxt,info) call mpi_bcast(dat,size(dat),psb_mpi_r_dpk_,root_,ictxt,info)
#endif #endif
end subroutine psb_dbcastm end subroutine psb_dbcastm
@ -330,7 +330,7 @@ contains
endif endif
call psb_info(ictxt,iam,np) call psb_info(ictxt,iam,np)
call mpi_bcast(dat,1,mpi_complex,root_,ictxt,info) call mpi_bcast(dat,1,psb_mpi_c_spk_,root_,ictxt,info)
#endif #endif
end subroutine psb_cbcasts end subroutine psb_cbcasts
@ -356,7 +356,7 @@ contains
endif endif
call psb_info(ictxt,iam,np) call psb_info(ictxt,iam,np)
call mpi_bcast(dat,size(dat),mpi_complex,root_,ictxt,info) call mpi_bcast(dat,size(dat),psb_mpi_c_spk_,root_,ictxt,info)
#endif #endif
end subroutine psb_cbcastv end subroutine psb_cbcastv
@ -382,7 +382,7 @@ contains
endif endif
call psb_info(ictxt,iam,np) call psb_info(ictxt,iam,np)
call mpi_bcast(dat,size(dat),mpi_complex,root_,ictxt,info) call mpi_bcast(dat,size(dat),psb_mpi_c_spk_,root_,ictxt,info)
#endif #endif
end subroutine psb_cbcastm end subroutine psb_cbcastm
@ -408,7 +408,7 @@ contains
endif endif
call psb_info(ictxt,iam,np) call psb_info(ictxt,iam,np)
call mpi_bcast(dat,1,mpi_double_complex,root_,ictxt,info) call mpi_bcast(dat,1,psb_mpi_c_dpk_,root_,ictxt,info)
#endif #endif
end subroutine psb_zbcasts end subroutine psb_zbcasts
@ -434,7 +434,7 @@ contains
endif endif
call psb_info(ictxt,iam,np) call psb_info(ictxt,iam,np)
call mpi_bcast(dat,size(dat),mpi_double_complex,root_,ictxt,info) call mpi_bcast(dat,size(dat),psb_mpi_c_dpk_,root_,ictxt,info)
#endif #endif
end subroutine psb_zbcastv end subroutine psb_zbcastv
@ -460,7 +460,7 @@ contains
endif endif
call psb_info(ictxt,iam,np) call psb_info(ictxt,iam,np)
call mpi_bcast(dat,size(dat),mpi_double_complex,root_,ictxt,info) call mpi_bcast(dat,size(dat),psb_mpi_c_dpk_,root_,ictxt,info)
#endif #endif
end subroutine psb_zbcastm end subroutine psb_zbcastm

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

@ -38,10 +38,10 @@ module mpi
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 :: mpi_integer = 1
integer(psb_mpik_), parameter :: mpi_integer8 = 2 integer(psb_mpik_), parameter :: mpi_integer8 = 2
integer(psb_mpik_), parameter :: mpi_real = 3 integer(psb_mpik_), parameter :: psb_mpi_r_spk_ = 3
integer(psb_mpik_), parameter :: mpi_double_precision = 4 integer(psb_mpik_), parameter :: psb_mpi_r_dpk_ = 4
integer(psb_mpik_), parameter :: mpi_complex = 5 integer(psb_mpik_), parameter :: psb_mpi_c_spk_ = 5
integer(psb_mpik_), parameter :: mpi_double_complex = 6 integer(psb_mpik_), parameter :: psb_mpi_c_dpk_ = 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 :: mpi_integer2 = 9
@ -446,7 +446,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%realbuf,size(node%realbuf),mpi_real,& call mpi_isend(node%realbuf,size(node%realbuf),psb_mpi_r_spk_,&
& 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)
@ -482,7 +482,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%doublebuf,size(node%doublebuf),mpi_double_precision,& call mpi_isend(node%doublebuf,size(node%doublebuf),psb_mpi_r_dpk_,&
& 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)
@ -518,7 +518,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%complexbuf,size(node%complexbuf),mpi_complex,& call mpi_isend(node%complexbuf,size(node%complexbuf),psb_mpi_c_spk_,&
& 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)
@ -554,7 +554,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%dcomplbuf,size(node%dcomplbuf),mpi_double_complex,& call mpi_isend(node%dcomplbuf,size(node%dcomplbuf),psb_mpi_c_dpk_,&
& 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)

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

@ -1067,7 +1067,7 @@ contains
#if defined(SERIAL_MPI) #if defined(SERIAL_MPI)
! do nothing ! do nothing
#else #else
call mpi_recv(dat,1,mpi_real,src,psb_real_tag,ictxt,status,info) call mpi_recv(dat,1,psb_mpi_r_spk_,src,psb_real_tag,ictxt,status,info)
call psb_test_nodes(psb_mesg_queue) call psb_test_nodes(psb_mesg_queue)
#endif #endif
end subroutine psb_srcvs end subroutine psb_srcvs
@ -1090,7 +1090,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_real,src,psb_real_tag,ictxt,status,info) call mpi_recv(dat,size(dat),psb_mpi_r_spk_,src,psb_real_tag,ictxt,status,info)
call psb_test_nodes(psb_mesg_queue) call psb_test_nodes(psb_mesg_queue)
#endif #endif
@ -1121,13 +1121,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_real,mp_rcv_type,info) call mpi_type_vector(n_,m_,ld,psb_mpi_r_spk_,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_real_tag,ictxt,status,info) & psb_real_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_real,src,psb_real_tag,ictxt,status,info) call mpi_recv(dat,size(dat),psb_mpi_r_spk_,src,psb_real_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
@ -1154,7 +1154,7 @@ contains
#if defined(SERIAL_MPI) #if defined(SERIAL_MPI)
! do nothing ! do nothing
#else #else
call mpi_recv(dat,1,mpi_double_precision,src,psb_double_tag,ictxt,status,info) call mpi_recv(dat,1,psb_mpi_r_dpk_,src,psb_double_tag,ictxt,status,info)
call psb_test_nodes(psb_mesg_queue) call psb_test_nodes(psb_mesg_queue)
#endif #endif
end subroutine psb_drcvs end subroutine psb_drcvs
@ -1177,7 +1177,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_double_precision,src,psb_double_tag,ictxt,status,info) call mpi_recv(dat,size(dat),psb_mpi_r_dpk_,src,psb_double_tag,ictxt,status,info)
call psb_test_nodes(psb_mesg_queue) call psb_test_nodes(psb_mesg_queue)
#endif #endif
@ -1208,13 +1208,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_double_precision,mp_rcv_type,info) call mpi_type_vector(n_,m_,ld,psb_mpi_r_dpk_,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_double_tag,ictxt,status,info) & psb_double_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_double_precision,src,& call mpi_recv(dat,size(dat),psb_mpi_r_dpk_,src,&
& psb_double_tag,ictxt,status,info) & psb_double_tag,ictxt,status,info)
end if end if
if (info /= mpi_success) then if (info /= mpi_success) then
@ -1242,7 +1242,7 @@ contains
#if defined(SERIAL_MPI) #if defined(SERIAL_MPI)
! do nothing ! do nothing
#else #else
call mpi_recv(dat,1,mpi_complex,src,psb_complex_tag,ictxt,status,info) call mpi_recv(dat,1,psb_mpi_c_spk_,src,psb_complex_tag,ictxt,status,info)
call psb_test_nodes(psb_mesg_queue) call psb_test_nodes(psb_mesg_queue)
#endif #endif
end subroutine psb_crcvs end subroutine psb_crcvs
@ -1265,7 +1265,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_complex,src,psb_complex_tag,ictxt,status,info) call mpi_recv(dat,size(dat),psb_mpi_c_spk_,src,psb_complex_tag,ictxt,status,info)
call psb_test_nodes(psb_mesg_queue) call psb_test_nodes(psb_mesg_queue)
#endif #endif
@ -1296,13 +1296,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_complex,mp_rcv_type,info) call mpi_type_vector(n_,m_,ld,psb_mpi_c_spk_,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_complex_tag,ictxt,status,info) & psb_complex_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_complex,src,& call mpi_recv(dat,size(dat),psb_mpi_c_spk_,src,&
& psb_complex_tag,ictxt,status,info) & psb_complex_tag,ictxt,status,info)
end if end if
if (info /= mpi_success) then if (info /= mpi_success) then
@ -1330,7 +1330,7 @@ contains
#if defined(SERIAL_MPI) #if defined(SERIAL_MPI)
! do nothing ! do nothing
#else #else
call mpi_recv(dat,1,mpi_double_complex,src,psb_dcomplex_tag,ictxt,status,info) call mpi_recv(dat,1,psb_mpi_c_dpk_,src,psb_dcomplex_tag,ictxt,status,info)
call psb_test_nodes(psb_mesg_queue) call psb_test_nodes(psb_mesg_queue)
#endif #endif
end subroutine psb_zrcvs end subroutine psb_zrcvs
@ -1353,7 +1353,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_double_complex,src,psb_dcomplex_tag,ictxt,status,info) call mpi_recv(dat,size(dat),psb_mpi_c_dpk_,src,psb_dcomplex_tag,ictxt,status,info)
call psb_test_nodes(psb_mesg_queue) call psb_test_nodes(psb_mesg_queue)
#endif #endif
@ -1384,13 +1384,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_double_complex,mp_rcv_type,info) call mpi_type_vector(n_,m_,ld,psb_mpi_c_dpk_,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_dcomplex_tag,ictxt,status,info) & psb_dcomplex_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_double_complex,src,& call mpi_recv(dat,size(dat),psb_mpi_c_dpk_,src,&
& psb_dcomplex_tag,ictxt,status,info) & psb_dcomplex_tag,ictxt,status,info)
end if end if
if (info /= mpi_success) then if (info /= mpi_success) then

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

@ -601,10 +601,10 @@ contains
root_ = -1 root_ = -1
endif endif
if (root_ == -1) then if (root_ == -1) then
call mpi_allreduce(dat,dat_,1,mpi_real,mpi_max,ictxt,info) call mpi_allreduce(dat,dat_,1,psb_mpi_r_spk_,mpi_max,ictxt,info)
dat = dat_ dat = dat_
else else
call mpi_reduce(dat,dat_,1,mpi_real,mpi_max,root_,ictxt,info) call mpi_reduce(dat,dat_,1,psb_mpi_r_spk_,mpi_max,root_,ictxt,info)
dat = dat_ dat = dat_
endif endif
#endif #endif
@ -640,15 +640,15 @@ contains
call psb_realloc(size(dat),dat_,iinfo) call psb_realloc(size(dat),dat_,iinfo)
dat_ = dat dat_ = dat
if (iinfo == psb_success_) & if (iinfo == psb_success_) &
& call mpi_allreduce(dat_,dat,size(dat),mpi_real,mpi_max,ictxt,info) & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_spk_,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_real,mpi_max,root_,ictxt,info) call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_spk_,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_real,mpi_max,root_,ictxt,info) call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_spk_,mpi_max,root_,ictxt,info)
end if end if
endif endif
#endif #endif
@ -684,15 +684,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_)& if (iinfo == psb_success_)&
& call mpi_allreduce(dat_,dat,size(dat),mpi_real,mpi_max,ictxt,info) & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_spk_,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_real,mpi_max,root_,ictxt,info) call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_spk_,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_real,mpi_max,root_,ictxt,info) call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_spk_,mpi_max,root_,ictxt,info)
end if end if
endif endif
#endif #endif
@ -724,10 +724,10 @@ contains
root_ = -1 root_ = -1
endif endif
if (root_ == -1) then if (root_ == -1) then
call mpi_allreduce(dat,dat_,1,mpi_double_precision,mpi_max,ictxt,info) call mpi_allreduce(dat,dat_,1,psb_mpi_r_dpk_,mpi_max,ictxt,info)
dat = dat_ dat = dat_
else else
call mpi_reduce(dat,dat_,1,mpi_double_precision,mpi_max,root_,ictxt,info) call mpi_reduce(dat,dat_,1,psb_mpi_r_dpk_,mpi_max,root_,ictxt,info)
dat = dat_ dat = dat_
endif endif
#endif #endif
@ -763,16 +763,16 @@ contains
call psb_realloc(size(dat),dat_,iinfo) call psb_realloc(size(dat),dat_,iinfo)
dat_ = dat dat_ = dat
if (iinfo == psb_success_) & if (iinfo == psb_success_) &
& call mpi_allreduce(dat_,dat,size(dat),mpi_double_precision,& & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_dpk_,&
& mpi_max,ictxt,info) & 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_double_precision,mpi_max,root_,ictxt,info) call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_dpk_,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_double_precision,mpi_max,root_,ictxt,info) call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_dpk_,mpi_max,root_,ictxt,info)
end if end if
endif endif
#endif #endif
@ -808,15 +808,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_)& if (iinfo == psb_success_)&
& call mpi_allreduce(dat_,dat,size(dat),mpi_double_precision,mpi_max,ictxt,info) & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_dpk_,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_double_precision,mpi_max,root_,ictxt,info) call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_dpk_,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_double_precision,mpi_max,root_,ictxt,info) call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_dpk_,mpi_max,root_,ictxt,info)
end if end if
endif endif
#endif #endif
@ -1233,10 +1233,10 @@ contains
root_ = -1 root_ = -1
endif endif
if (root_ == -1) then if (root_ == -1) then
call mpi_allreduce(dat,dat_,1,mpi_real,mpi_min,ictxt,info) call mpi_allreduce(dat,dat_,1,psb_mpi_r_spk_,mpi_min,ictxt,info)
dat = dat_ dat = dat_
else else
call mpi_reduce(dat,dat_,1,mpi_real,mpi_min,root_,ictxt,info) call mpi_reduce(dat,dat_,1,psb_mpi_r_spk_,mpi_min,root_,ictxt,info)
dat = dat_ dat = dat_
endif endif
#endif #endif
@ -1272,15 +1272,15 @@ contains
call psb_realloc(size(dat),dat_,iinfo) call psb_realloc(size(dat),dat_,iinfo)
dat_ = dat dat_ = dat
if (iinfo == psb_success_) & if (iinfo == psb_success_) &
& call mpi_allreduce(dat_,dat,size(dat),mpi_real,mpi_min,ictxt,info) & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_spk_,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_real,mpi_min,root_,ictxt,info) call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_spk_,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_real,mpi_min,root_,ictxt,info) call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_spk_,mpi_min,root_,ictxt,info)
end if end if
endif endif
#endif #endif
@ -1316,15 +1316,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_)& if (iinfo == psb_success_)&
& call mpi_allreduce(dat_,dat,size(dat),mpi_real,mpi_min,ictxt,info) & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_spk_,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_real,mpi_min,root_,ictxt,info) call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_spk_,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_real,mpi_min,root_,ictxt,info) call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_spk_,mpi_min,root_,ictxt,info)
end if end if
endif endif
#endif #endif
@ -1356,10 +1356,10 @@ contains
root_ = -1 root_ = -1
endif endif
if (root_ == -1) then if (root_ == -1) then
call mpi_allreduce(dat,dat_,1,mpi_double_precision,mpi_min,ictxt,info) call mpi_allreduce(dat,dat_,1,psb_mpi_r_dpk_,mpi_min,ictxt,info)
dat = dat_ dat = dat_
else else
call mpi_reduce(dat,dat_,1,mpi_double_precision,mpi_min,root_,ictxt,info) call mpi_reduce(dat,dat_,1,psb_mpi_r_dpk_,mpi_min,root_,ictxt,info)
dat = dat_ dat = dat_
endif endif
#endif #endif
@ -1395,16 +1395,16 @@ contains
call psb_realloc(size(dat),dat_,iinfo) call psb_realloc(size(dat),dat_,iinfo)
dat_ = dat dat_ = dat
if (iinfo == psb_success_) & if (iinfo == psb_success_) &
& call mpi_allreduce(dat_,dat,size(dat),mpi_double_precision,& & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_dpk_,&
& mpi_min,ictxt,info) & 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_double_precision,mpi_min,root_,ictxt,info) call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_dpk_,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_double_precision,mpi_min,root_,ictxt,info) call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_dpk_,mpi_min,root_,ictxt,info)
end if end if
endif endif
#endif #endif
@ -1440,15 +1440,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_)& if (iinfo == psb_success_)&
& call mpi_allreduce(dat_,dat,size(dat),mpi_double_precision,mpi_min,ictxt,info) & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_dpk_,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_double_precision,mpi_min,root_,ictxt,info) call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_dpk_,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_double_precision,mpi_min,root_,ictxt,info) call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_dpk_,mpi_min,root_,ictxt,info)
end if end if
endif endif
#endif #endif
@ -1872,10 +1872,10 @@ contains
root_ = -1 root_ = -1
endif endif
if (root_ == -1) then if (root_ == -1) then
call mpi_allreduce(dat,dat_,1,mpi_real,mpi_samx_op,ictxt,info) call mpi_allreduce(dat,dat_,1,psb_mpi_r_spk_,mpi_samx_op,ictxt,info)
dat = dat_ dat = dat_
else else
call mpi_reduce(dat,dat_,1,mpi_real,mpi_samx_op,root_,ictxt,info) call mpi_reduce(dat,dat_,1,psb_mpi_r_spk_,mpi_samx_op,root_,ictxt,info)
dat = dat_ dat = dat_
endif endif
#endif #endif
@ -1911,15 +1911,15 @@ contains
call psb_realloc(size(dat),dat_,iinfo) call psb_realloc(size(dat),dat_,iinfo)
dat_ = dat dat_ = dat
if (iinfo == psb_success_) & if (iinfo == psb_success_) &
& call mpi_allreduce(dat_,dat,size(dat),mpi_real,mpi_samx_op,ictxt,info) & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_samx_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_real,mpi_samx_op,root_,ictxt,info) call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_samx_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_real,mpi_samx_op,root_,ictxt,info) call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_spk_,mpi_samx_op,root_,ictxt,info)
end if end if
endif endif
#endif #endif
@ -1955,15 +1955,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_)& if (iinfo == psb_success_)&
& call mpi_allreduce(dat_,dat,size(dat),mpi_real,mpi_samx_op,ictxt,info) & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_samx_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_real,mpi_samx_op,root_,ictxt,info) call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_samx_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_real,mpi_samx_op,root_,ictxt,info) call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_spk_,mpi_samx_op,root_,ictxt,info)
end if end if
endif endif
#endif #endif
@ -1995,10 +1995,10 @@ contains
root_ = -1 root_ = -1
endif endif
if (root_ == -1) then if (root_ == -1) then
call mpi_allreduce(dat,dat_,1,mpi_double_precision,mpi_damx_op,ictxt,info) call mpi_allreduce(dat,dat_,1,psb_mpi_r_dpk_,mpi_damx_op,ictxt,info)
dat = dat_ dat = dat_
else else
call mpi_reduce(dat,dat_,1,mpi_double_precision,mpi_damx_op,root_,ictxt,info) call mpi_reduce(dat,dat_,1,psb_mpi_r_dpk_,mpi_damx_op,root_,ictxt,info)
dat = dat_ dat = dat_
endif endif
#endif #endif
@ -2034,16 +2034,16 @@ contains
call psb_realloc(size(dat),dat_,iinfo) call psb_realloc(size(dat),dat_,iinfo)
dat_ = dat dat_ = dat
if (iinfo == psb_success_) & if (iinfo == psb_success_) &
& call mpi_allreduce(dat_,dat,size(dat),mpi_double_precision,& & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_dpk_,&
& mpi_damx_op,ictxt,info) & mpi_damx_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_double_precision,mpi_damx_op,root_,ictxt,info) call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_dpk_,mpi_damx_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_double_precision,mpi_damx_op,root_,ictxt,info) call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_dpk_,mpi_damx_op,root_,ictxt,info)
end if end if
endif endif
#endif #endif
@ -2079,15 +2079,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_)& if (iinfo == psb_success_)&
& call mpi_allreduce(dat_,dat,size(dat),mpi_double_precision,mpi_damx_op,ictxt,info) & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_dpk_,mpi_damx_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_double_precision,mpi_damx_op,root_,ictxt,info) call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_dpk_,mpi_damx_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_double_precision,mpi_damx_op,root_,ictxt,info) call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_dpk_,mpi_damx_op,root_,ictxt,info)
end if end if
endif endif
#endif #endif
@ -2120,10 +2120,10 @@ contains
root_ = -1 root_ = -1
endif endif
if (root_ == -1) then if (root_ == -1) then
call mpi_allreduce(dat,dat_,1,mpi_complex,mpi_camx_op,ictxt,info) call mpi_allreduce(dat,dat_,1,psb_mpi_c_spk_,mpi_camx_op,ictxt,info)
dat = dat_ dat = dat_
else else
call mpi_reduce(dat,dat_,1,mpi_complex,mpi_camx_op,root_,ictxt,info) call mpi_reduce(dat,dat_,1,psb_mpi_c_spk_,mpi_camx_op,root_,ictxt,info)
dat = dat_ dat = dat_
endif endif
#endif #endif
@ -2159,15 +2159,15 @@ contains
call psb_realloc(size(dat),dat_,iinfo) call psb_realloc(size(dat),dat_,iinfo)
dat_ = dat dat_ = dat
if (iinfo == psb_success_) & if (iinfo == psb_success_) &
& call mpi_allreduce(dat_,dat,size(dat),mpi_complex,mpi_camx_op,ictxt,info) & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_camx_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_complex,mpi_camx_op,root_,ictxt,info) call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_camx_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_complex,mpi_camx_op,root_,ictxt,info) call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_spk_,mpi_camx_op,root_,ictxt,info)
end if end if
endif endif
#endif #endif
@ -2203,15 +2203,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_)& if (iinfo == psb_success_)&
& call mpi_allreduce(dat_,dat,size(dat),mpi_complex,mpi_camx_op,ictxt,info) & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_camx_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_complex,mpi_camx_op,root_,ictxt,info) call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_camx_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_complex,mpi_camx_op,root_,ictxt,info) call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_spk_,mpi_camx_op,root_,ictxt,info)
end if end if
endif endif
#endif #endif
@ -2243,10 +2243,10 @@ contains
root_ = -1 root_ = -1
endif endif
if (root_ == -1) then if (root_ == -1) then
call mpi_allreduce(dat,dat_,1,mpi_double_complex,mpi_zamx_op,ictxt,info) call mpi_allreduce(dat,dat_,1,psb_mpi_c_dpk_,mpi_zamx_op,ictxt,info)
dat = dat_ dat = dat_
else else
call mpi_reduce(dat,dat_,1,mpi_double_complex,mpi_zamx_op,root_,ictxt,info) call mpi_reduce(dat,dat_,1,psb_mpi_c_dpk_,mpi_zamx_op,root_,ictxt,info)
dat = dat_ dat = dat_
endif endif
#endif #endif
@ -2282,16 +2282,16 @@ contains
call psb_realloc(size(dat),dat_,iinfo) call psb_realloc(size(dat),dat_,iinfo)
dat_ = dat dat_ = dat
if (iinfo == psb_success_) & if (iinfo == psb_success_) &
& call mpi_allreduce(dat_,dat,size(dat),mpi_double_complex,& & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_dpk_,&
& mpi_zamx_op,ictxt,info) & mpi_zamx_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_double_complex,mpi_zamx_op,root_,ictxt,info) call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_zamx_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_double_complex,mpi_zamx_op,root_,ictxt,info) call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_dpk_,mpi_zamx_op,root_,ictxt,info)
end if end if
endif endif
#endif #endif
@ -2327,15 +2327,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_)& if (iinfo == psb_success_)&
& call mpi_allreduce(dat_,dat,size(dat),mpi_double_complex,mpi_zamx_op,ictxt,info) & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_zamx_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_double_complex,mpi_zamx_op,root_,ictxt,info) call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_zamx_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_double_complex,mpi_zamx_op,root_,ictxt,info) call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_dpk_,mpi_zamx_op,root_,ictxt,info)
end if end if
endif endif
#endif #endif
@ -2759,10 +2759,10 @@ contains
root_ = -1 root_ = -1
endif endif
if (root_ == -1) then if (root_ == -1) then
call mpi_allreduce(dat,dat_,1,mpi_real,mpi_samn_op,ictxt,info) call mpi_allreduce(dat,dat_,1,psb_mpi_r_spk_,mpi_samn_op,ictxt,info)
dat = dat_ dat = dat_
else else
call mpi_reduce(dat,dat_,1,mpi_real,mpi_samn_op,root_,ictxt,info) call mpi_reduce(dat,dat_,1,psb_mpi_r_spk_,mpi_samn_op,root_,ictxt,info)
dat = dat_ dat = dat_
endif endif
#endif #endif
@ -2798,15 +2798,15 @@ contains
call psb_realloc(size(dat),dat_,iinfo) call psb_realloc(size(dat),dat_,iinfo)
dat_ = dat dat_ = dat
if (iinfo == psb_success_) & if (iinfo == psb_success_) &
& call mpi_allreduce(dat_,dat,size(dat),mpi_real,mpi_samn_op,ictxt,info) & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_samn_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_real,mpi_samn_op,root_,ictxt,info) call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_samn_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_real,mpi_samn_op,root_,ictxt,info) call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_spk_,mpi_samn_op,root_,ictxt,info)
end if end if
endif endif
#endif #endif
@ -2842,15 +2842,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_)& if (iinfo == psb_success_)&
& call mpi_allreduce(dat_,dat,size(dat),mpi_real,mpi_samn_op,ictxt,info) & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_samn_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_real,mpi_samn_op,root_,ictxt,info) call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_samn_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_real,mpi_samn_op,root_,ictxt,info) call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_spk_,mpi_samn_op,root_,ictxt,info)
end if end if
endif endif
#endif #endif
@ -2882,10 +2882,10 @@ contains
root_ = -1 root_ = -1
endif endif
if (root_ == -1) then if (root_ == -1) then
call mpi_allreduce(dat,dat_,1,mpi_double_precision,mpi_damn_op,ictxt,info) call mpi_allreduce(dat,dat_,1,psb_mpi_r_dpk_,mpi_damn_op,ictxt,info)
dat = dat_ dat = dat_
else else
call mpi_reduce(dat,dat_,1,mpi_double_precision,mpi_damn_op,root_,ictxt,info) call mpi_reduce(dat,dat_,1,psb_mpi_r_dpk_,mpi_damn_op,root_,ictxt,info)
dat = dat_ dat = dat_
endif endif
#endif #endif
@ -2921,16 +2921,16 @@ contains
call psb_realloc(size(dat),dat_,iinfo) call psb_realloc(size(dat),dat_,iinfo)
dat_ = dat dat_ = dat
if (iinfo == psb_success_) & if (iinfo == psb_success_) &
& call mpi_allreduce(dat_,dat,size(dat),mpi_double_precision,& & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_dpk_,&
& mpi_damn_op,ictxt,info) & mpi_damn_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_double_precision,mpi_damn_op,root_,ictxt,info) call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_dpk_,mpi_damn_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_double_precision,mpi_damn_op,root_,ictxt,info) call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_dpk_,mpi_damn_op,root_,ictxt,info)
end if end if
endif endif
#endif #endif
@ -2966,15 +2966,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_)& if (iinfo == psb_success_)&
& call mpi_allreduce(dat_,dat,size(dat),mpi_double_precision,mpi_damn_op,ictxt,info) & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_dpk_,mpi_damn_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_double_precision,mpi_damn_op,root_,ictxt,info) call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_dpk_,mpi_damn_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_double_precision,mpi_damn_op,root_,ictxt,info) call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_dpk_,mpi_damn_op,root_,ictxt,info)
end if end if
endif endif
#endif #endif
@ -3007,10 +3007,10 @@ contains
root_ = -1 root_ = -1
endif endif
if (root_ == -1) then if (root_ == -1) then
call mpi_allreduce(dat,dat_,1,mpi_complex,mpi_camn_op,ictxt,info) call mpi_allreduce(dat,dat_,1,psb_mpi_c_spk_,mpi_camn_op,ictxt,info)
dat = dat_ dat = dat_
else else
call mpi_reduce(dat,dat_,1,mpi_complex,mpi_camn_op,root_,ictxt,info) call mpi_reduce(dat,dat_,1,psb_mpi_c_spk_,mpi_camn_op,root_,ictxt,info)
dat = dat_ dat = dat_
endif endif
#endif #endif
@ -3046,15 +3046,15 @@ contains
call psb_realloc(size(dat),dat_,iinfo) call psb_realloc(size(dat),dat_,iinfo)
dat_ = dat dat_ = dat
if (iinfo == psb_success_) & if (iinfo == psb_success_) &
& call mpi_allreduce(dat_,dat,size(dat),mpi_complex,mpi_camn_op,ictxt,info) & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_camn_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_complex,mpi_camn_op,root_,ictxt,info) call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_camn_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_complex,mpi_camn_op,root_,ictxt,info) call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_spk_,mpi_camn_op,root_,ictxt,info)
end if end if
endif endif
#endif #endif
@ -3090,15 +3090,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_)& if (iinfo == psb_success_)&
& call mpi_allreduce(dat_,dat,size(dat),mpi_complex,mpi_camn_op,ictxt,info) & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_camn_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_complex,mpi_camn_op,root_,ictxt,info) call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_camn_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_complex,mpi_camn_op,root_,ictxt,info) call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_spk_,mpi_camn_op,root_,ictxt,info)
end if end if
endif endif
#endif #endif
@ -3130,10 +3130,10 @@ contains
root_ = -1 root_ = -1
endif endif
if (root_ == -1) then if (root_ == -1) then
call mpi_allreduce(dat,dat_,1,mpi_double_complex,mpi_zamn_op,ictxt,info) call mpi_allreduce(dat,dat_,1,psb_mpi_c_dpk_,mpi_zamn_op,ictxt,info)
dat = dat_ dat = dat_
else else
call mpi_reduce(dat,dat_,1,mpi_double_complex,mpi_zamn_op,root_,ictxt,info) call mpi_reduce(dat,dat_,1,psb_mpi_c_dpk_,mpi_zamn_op,root_,ictxt,info)
dat = dat_ dat = dat_
endif endif
#endif #endif
@ -3169,16 +3169,16 @@ contains
call psb_realloc(size(dat),dat_,iinfo) call psb_realloc(size(dat),dat_,iinfo)
dat_ = dat dat_ = dat
if (iinfo == psb_success_) & if (iinfo == psb_success_) &
& call mpi_allreduce(dat_,dat,size(dat),mpi_double_complex,& & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_dpk_,&
& mpi_zamn_op,ictxt,info) & mpi_zamn_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_double_complex,mpi_zamn_op,root_,ictxt,info) call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_zamn_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_double_complex,mpi_zamn_op,root_,ictxt,info) call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_dpk_,mpi_zamn_op,root_,ictxt,info)
end if end if
endif endif
#endif #endif
@ -3214,15 +3214,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_)& if (iinfo == psb_success_)&
& call mpi_allreduce(dat_,dat,size(dat),mpi_double_complex,mpi_zamn_op,ictxt,info) & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_zamn_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_double_complex,mpi_zamn_op,root_,ictxt,info) call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_zamn_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_double_complex,mpi_zamn_op,root_,ictxt,info) call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_dpk_,mpi_zamn_op,root_,ictxt,info)
end if end if
endif endif
#endif #endif
@ -3773,10 +3773,10 @@ contains
root_ = -1 root_ = -1
endif endif
if (root_ == -1) then if (root_ == -1) then
call mpi_allreduce(dat,dat_,1,mpi_real,mpi_sum,ictxt,info) call mpi_allreduce(dat,dat_,1,psb_mpi_r_spk_,mpi_sum,ictxt,info)
dat = dat_ dat = dat_
else else
call mpi_reduce(dat,dat_,1,mpi_real,mpi_sum,root_,ictxt,info) call mpi_reduce(dat,dat_,1,psb_mpi_r_spk_,mpi_sum,root_,ictxt,info)
dat = dat_ dat = dat_
endif endif
#endif #endif
@ -3812,15 +3812,15 @@ contains
call psb_realloc(size(dat),dat_,iinfo) call psb_realloc(size(dat),dat_,iinfo)
dat_ = dat dat_ = dat
if (iinfo == psb_success_) & if (iinfo == psb_success_) &
& call mpi_allreduce(dat_,dat,size(dat),mpi_real,mpi_sum,ictxt,info) & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_spk_,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_real,mpi_sum,root_,ictxt,info) call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_spk_,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_real,mpi_sum,root_,ictxt,info) call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_spk_,mpi_sum,root_,ictxt,info)
end if end if
endif endif
#endif #endif
@ -3856,15 +3856,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_)& if (iinfo == psb_success_)&
& call mpi_allreduce(dat_,dat,size(dat),mpi_real,mpi_sum,ictxt,info) & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_spk_,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_real,mpi_sum,root_,ictxt,info) call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_spk_,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_real,mpi_sum,root_,ictxt,info) call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_spk_,mpi_sum,root_,ictxt,info)
end if end if
endif endif
#endif #endif
@ -3896,10 +3896,10 @@ contains
root_ = -1 root_ = -1
endif endif
if (root_ == -1) then if (root_ == -1) then
call mpi_allreduce(dat,dat_,1,mpi_double_precision,mpi_sum,ictxt,info) call mpi_allreduce(dat,dat_,1,psb_mpi_r_dpk_,mpi_sum,ictxt,info)
dat = dat_ dat = dat_
else else
call mpi_reduce(dat,dat_,1,mpi_double_precision,mpi_sum,root_,ictxt,info) call mpi_reduce(dat,dat_,1,psb_mpi_r_dpk_,mpi_sum,root_,ictxt,info)
dat = dat_ dat = dat_
endif endif
#endif #endif
@ -3935,16 +3935,16 @@ contains
call psb_realloc(size(dat),dat_,iinfo) call psb_realloc(size(dat),dat_,iinfo)
dat_ = dat dat_ = dat
if (iinfo == psb_success_) & if (iinfo == psb_success_) &
& call mpi_allreduce(dat_,dat,size(dat),mpi_double_precision,& & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_dpk_,&
& mpi_sum,ictxt,info) & 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_double_precision,mpi_sum,root_,ictxt,info) call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_dpk_,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_double_precision,mpi_sum,root_,ictxt,info) call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_dpk_,mpi_sum,root_,ictxt,info)
end if end if
endif endif
#endif #endif
@ -3980,15 +3980,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_)& if (iinfo == psb_success_)&
& call mpi_allreduce(dat_,dat,size(dat),mpi_double_precision,mpi_sum,ictxt,info) & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_dpk_,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_double_precision,mpi_sum,root_,ictxt,info) call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_dpk_,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_double_precision,mpi_sum,root_,ictxt,info) call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_dpk_,mpi_sum,root_,ictxt,info)
end if end if
endif endif
#endif #endif
@ -4021,10 +4021,10 @@ contains
root_ = -1 root_ = -1
endif endif
if (root_ == -1) then if (root_ == -1) then
call mpi_allreduce(dat,dat_,1,mpi_complex,mpi_sum,ictxt,info) call mpi_allreduce(dat,dat_,1,psb_mpi_c_spk_,mpi_sum,ictxt,info)
dat = dat_ dat = dat_
else else
call mpi_reduce(dat,dat_,1,mpi_complex,mpi_sum,root_,ictxt,info) call mpi_reduce(dat,dat_,1,psb_mpi_c_spk_,mpi_sum,root_,ictxt,info)
dat = dat_ dat = dat_
endif endif
#endif #endif
@ -4060,15 +4060,15 @@ contains
call psb_realloc(size(dat),dat_,iinfo) call psb_realloc(size(dat),dat_,iinfo)
dat_ = dat dat_ = dat
if (iinfo == psb_success_) & if (iinfo == psb_success_) &
& call mpi_allreduce(dat_,dat,size(dat),mpi_complex,mpi_sum,ictxt,info) & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_spk_,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_complex,mpi_sum,root_,ictxt,info) call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_spk_,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_complex,mpi_sum,root_,ictxt,info) call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_spk_,mpi_sum,root_,ictxt,info)
end if end if
endif endif
#endif #endif
@ -4104,15 +4104,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_)& if (iinfo == psb_success_)&
& call mpi_allreduce(dat_,dat,size(dat),mpi_complex,mpi_sum,ictxt,info) & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_spk_,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_complex,mpi_sum,root_,ictxt,info) call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_spk_,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_complex,mpi_sum,root_,ictxt,info) call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_spk_,mpi_sum,root_,ictxt,info)
end if end if
endif endif
#endif #endif
@ -4144,10 +4144,10 @@ contains
root_ = -1 root_ = -1
endif endif
if (root_ == -1) then if (root_ == -1) then
call mpi_allreduce(dat,dat_,1,mpi_double_complex,mpi_sum,ictxt,info) call mpi_allreduce(dat,dat_,1,psb_mpi_c_dpk_,mpi_sum,ictxt,info)
dat = dat_ dat = dat_
else else
call mpi_reduce(dat,dat_,1,mpi_double_complex,mpi_sum,root_,ictxt,info) call mpi_reduce(dat,dat_,1,psb_mpi_c_dpk_,mpi_sum,root_,ictxt,info)
dat = dat_ dat = dat_
endif endif
#endif #endif
@ -4183,16 +4183,16 @@ contains
call psb_realloc(size(dat),dat_,iinfo) call psb_realloc(size(dat),dat_,iinfo)
dat_ = dat dat_ = dat
if (iinfo == psb_success_) & if (iinfo == psb_success_) &
& call mpi_allreduce(dat_,dat,size(dat),mpi_double_complex,& & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_dpk_,&
& mpi_sum,ictxt,info) & 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_double_complex,mpi_sum,root_,ictxt,info) call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_dpk_,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_double_complex,mpi_sum,root_,ictxt,info) call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_dpk_,mpi_sum,root_,ictxt,info)
end if end if
endif endif
#endif #endif
@ -4228,15 +4228,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_)& if (iinfo == psb_success_)&
& call mpi_allreduce(dat_,dat,size(dat),mpi_double_complex,mpi_sum,ictxt,info) & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_dpk_,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_double_complex,mpi_sum,root_,ictxt,info) call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_dpk_,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_double_complex,mpi_sum,root_,ictxt,info) call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_dpk_,mpi_sum,root_,ictxt,info)
end if end if
endif endif
#endif #endif
@ -4273,10 +4273,10 @@ contains
root_ = -1 root_ = -1
endif endif
if (root_ == -1) then if (root_ == -1) then
call mpi_allreduce(dat,dat_,1,mpi_real,mpi_snrm2_op,ictxt,info) call mpi_allreduce(dat,dat_,1,psb_mpi_r_spk_,mpi_snrm2_op,ictxt,info)
dat = dat_ dat = dat_
else else
call mpi_reduce(dat,dat_,1,mpi_real,mpi_snrm2_op,root_,ictxt,info) call mpi_reduce(dat,dat_,1,psb_mpi_r_spk_,mpi_snrm2_op,root_,ictxt,info)
dat = dat_ dat = dat_
endif endif
#endif #endif
@ -4308,10 +4308,10 @@ contains
root_ = -1 root_ = -1
endif endif
if (root_ == -1) then if (root_ == -1) then
call mpi_allreduce(dat,dat_,1,mpi_double_precision,mpi_dnrm2_op,ictxt,info) call mpi_allreduce(dat,dat_,1,psb_mpi_r_dpk_,mpi_dnrm2_op,ictxt,info)
dat = dat_ dat = dat_
else else
call mpi_reduce(dat,dat_,1,mpi_double_precision,mpi_dnrm2_op,root_,ictxt,info) call mpi_reduce(dat,dat_,1,psb_mpi_r_dpk_,mpi_dnrm2_op,root_,ictxt,info)
dat = dat_ dat = dat_
endif endif
#endif #endif
@ -4347,17 +4347,17 @@ contains
call psb_realloc(size(dat),dat_,iinfo) call psb_realloc(size(dat),dat_,iinfo)
dat_ = dat dat_ = dat
if (iinfo == psb_success_) & if (iinfo == psb_success_) &
& call mpi_allreduce(dat_,dat,size(dat),mpi_real,& & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_spk_,&
& mpi_snrm2_op,ictxt,info) & mpi_snrm2_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_real,& call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_spk_,&
& mpi_snrm2_op,root_,ictxt,info) & mpi_snrm2_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_real,& call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_spk_,&
& mpi_snrm2_op,root_,ictxt,info) & mpi_snrm2_op,root_,ictxt,info)
end if end if
endif endif
@ -4394,17 +4394,17 @@ contains
call psb_realloc(size(dat),dat_,iinfo) call psb_realloc(size(dat),dat_,iinfo)
dat_ = dat dat_ = dat
if (iinfo == psb_success_) & if (iinfo == psb_success_) &
& call mpi_allreduce(dat_,dat,size(dat),mpi_double_precision,& & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_dpk_,&
& mpi_dnrm2_op,ictxt,info) & mpi_dnrm2_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_double_precision,& call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_dpk_,&
& mpi_dnrm2_op,root_,ictxt,info) & mpi_dnrm2_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_double_precision,& call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_dpk_,&
& mpi_dnrm2_op,root_,ictxt,info) & mpi_dnrm2_op,root_,ictxt,info)
end if end if
endif endif

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

@ -272,8 +272,8 @@ Subroutine psb_csphalo(a,desc_a,blk,info,rowcnv,colcnv,&
end if end if
call mpi_alltoallv(valsnd,sdsz,bsdindx,mpi_complex,& call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_c_spk_,&
& acoo%val,rvsz,brvindx,mpi_complex,icomm,info) & acoo%val,rvsz,brvindx,psb_mpi_c_spk_,icomm,info)
call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_ipk_integer,& call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_ipk_integer,&
& acoo%ia,rvsz,brvindx,psb_mpi_ipk_integer,icomm,info) & acoo%ia,rvsz,brvindx,psb_mpi_ipk_integer,icomm,info)
call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_ipk_integer,& call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_ipk_integer,&

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

@ -272,8 +272,8 @@ Subroutine psb_dsphalo(a,desc_a,blk,info,rowcnv,colcnv,&
end if end if
call mpi_alltoallv(valsnd,sdsz,bsdindx,mpi_double_precision,& call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_r_dpk_,&
& acoo%val,rvsz,brvindx,mpi_double_precision,icomm,info) & acoo%val,rvsz,brvindx,psb_mpi_r_dpk_,icomm,info)
call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_ipk_integer,& call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_ipk_integer,&
& acoo%ia,rvsz,brvindx,psb_mpi_ipk_integer,icomm,info) & acoo%ia,rvsz,brvindx,psb_mpi_ipk_integer,icomm,info)
call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_ipk_integer,& call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_ipk_integer,&

22
base/tools/psb_glob_to_loc.f90
Unescape Escape View File

@ -31,7 +31,7 @@
!!$ !!$
! File: psb_glob_to_loc.f90 ! File: psb_glob_to_loc.f90
! !
! Subroutine: psb_glob_to_loc2 ! Subroutine: psb_glob_to_loc2v
! Performs global to local index translation. If an index does not belong ! Performs global to local index translation. If an index does not belong
! to the current process, a negative value is returned (see also iact). ! to the current process, a negative value is returned (see also iact).
! !
@ -46,8 +46,8 @@
! owned - logical, optional When .true. limits the input to indices strictly ! owned - logical, optional When .true. limits the input to indices strictly
! owned by the process, i.e. excludes halo. ! owned by the process, i.e. excludes halo.
! !
subroutine psb_glob_to_loc2(x,y,desc_a,info,iact,owned) subroutine psb_glob_to_loc2v(x,y,desc_a,info,iact,owned)
use psb_base_mod, psb_protect_name => psb_glob_to_loc2 use psb_base_mod, psb_protect_name => psb_glob_to_loc2v
use psi_mod use psi_mod
implicit none implicit none
@ -116,7 +116,7 @@ subroutine psb_glob_to_loc2(x,y,desc_a,info,iact,owned)
return return
end subroutine psb_glob_to_loc2 end subroutine psb_glob_to_loc2v
!!$ !!$
@ -150,7 +150,7 @@ end subroutine psb_glob_to_loc2
!!$ POSSIBILITY OF SUCH DAMAGE. !!$ POSSIBILITY OF SUCH DAMAGE.
!!$ !!$
!!$ !!$
! Subroutine: psb_glob_to_loc ! Subroutine: psb_glob_to_loc1v
! Performs global to local index translation. If an index does not belong ! Performs global to local index translation. If an index does not belong
! to the current process, a negative value is returned (see also iact). ! to the current process, a negative value is returned (see also iact).
! !
@ -165,8 +165,8 @@ end subroutine psb_glob_to_loc2
! owned - logical, optional When .true. limits the input to indices strictly ! owned - logical, optional When .true. limits the input to indices strictly
! owned by the process, i.e. excludes halo. ! owned by the process, i.e. excludes halo.
! !
subroutine psb_glob_to_loc(x,desc_a,info,iact,owned) subroutine psb_glob_to_loc1v(x,desc_a,info,iact,owned)
use psb_base_mod, psb_protect_name => psb_glob_to_loc use psb_base_mod, psb_protect_name => psb_glob_to_loc1v
use psi_mod use psi_mod
implicit none implicit none
@ -238,7 +238,7 @@ subroutine psb_glob_to_loc(x,desc_a,info,iact,owned)
end if end if
return return
end subroutine psb_glob_to_loc end subroutine psb_glob_to_loc1v
subroutine psb_glob_to_loc2s(x,y,desc_a,info,iact,owned) subroutine psb_glob_to_loc2s(x,y,desc_a,info,iact,owned)
use psb_base_mod, psb_protect_name => psb_glob_to_loc2s use psb_base_mod, psb_protect_name => psb_glob_to_loc2s
@ -257,8 +257,8 @@ subroutine psb_glob_to_loc2s(x,y,desc_a,info,iact,owned)
y = iv2(1) y = iv2(1)
end subroutine psb_glob_to_loc2s end subroutine psb_glob_to_loc2s
subroutine psb_glob_to_locs(x,desc_a,info,iact,owned) subroutine psb_glob_to_loc1s(x,desc_a,info,iact,owned)
use psb_base_mod, psb_protect_name => psb_glob_to_locs use psb_base_mod, psb_protect_name => psb_glob_to_loc1s
implicit none implicit none
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_),intent(inout) :: x integer(psb_ipk_),intent(inout) :: x
@ -271,5 +271,5 @@ subroutine psb_glob_to_locs(x,desc_a,info,iact,owned)
call psb_glob_to_loc(iv1,desc_a,info,iact,owned) call psb_glob_to_loc(iv1,desc_a,info,iact,owned)
x = iv1(1) x = iv1(1)
end subroutine psb_glob_to_locs end subroutine psb_glob_to_loc1s

22
base/tools/psb_loc_to_glob.f90
Unescape Escape View File

@ -31,7 +31,7 @@
!!$ !!$
! File: psb_loc_to_glob.f90 ! File: psb_loc_to_glob.f90
! !
! Subroutine: psb_loc_to_glob2 ! Subroutine: psb_loc_to_glob2v
! Performs local to global index translation. If an index is out of range ! Performs local to global index translation. If an index is out of range
! a negative value is returned (see also iact). ! a negative value is returned (see also iact).
! !
@ -44,8 +44,8 @@
! an out of range index ! an out of range index
! 'I'gnore, 'W'arning, 'A'bort ! 'I'gnore, 'W'arning, 'A'bort
! !
subroutine psb_loc_to_glob2(x,y,desc_a,info,iact) subroutine psb_loc_to_glob2v(x,y,desc_a,info,iact)
use psb_base_mod, psb_protect_name => psb_loc_to_glob2 use psb_base_mod, psb_protect_name => psb_loc_to_glob2v
implicit none implicit none
!...parameters.... !...parameters....
@ -103,7 +103,7 @@ subroutine psb_loc_to_glob2(x,y,desc_a,info,iact)
end if end if
return return
end subroutine psb_loc_to_glob2 end subroutine psb_loc_to_glob2v
!!$ !!$
@ -137,7 +137,7 @@ end subroutine psb_loc_to_glob2
!!$ POSSIBILITY OF SUCH DAMAGE. !!$ POSSIBILITY OF SUCH DAMAGE.
!!$ !!$
!!$ !!$
! Subroutine: psb_loc_to_glob ! Subroutine: psb_loc_to_glob1v
! Performs local to global index translation. If an index is out of range ! Performs local to global index translation. If an index is out of range
! a negative value is returned (see also iact). ! a negative value is returned (see also iact).
! !
@ -150,8 +150,8 @@ end subroutine psb_loc_to_glob2
! an out of range index ! an out of range index
! 'I'gnore, 'W'arning, 'A'bort ! 'I'gnore, 'W'arning, 'A'bort
! !
subroutine psb_loc_to_glob(x,desc_a,info,iact) subroutine psb_loc_to_glob1v(x,desc_a,info,iact)
use psb_base_mod, psb_protect_name => psb_loc_to_glob use psb_base_mod, psb_protect_name => psb_loc_to_glob1v
implicit none implicit none
!...parameters.... !...parameters....
@ -208,7 +208,7 @@ subroutine psb_loc_to_glob(x,desc_a,info,iact)
end if end if
return return
end subroutine psb_loc_to_glob end subroutine psb_loc_to_glob1v
subroutine psb_loc_to_glob2s(x,y,desc_a,info,iact) subroutine psb_loc_to_glob2s(x,y,desc_a,info,iact)
use psb_descriptor_type use psb_descriptor_type
@ -227,9 +227,9 @@ subroutine psb_loc_to_glob2s(x,y,desc_a,info,iact)
y = iv2(1) y = iv2(1)
end subroutine psb_loc_to_glob2s end subroutine psb_loc_to_glob2s
subroutine psb_loc_to_globs(x,desc_a,info,iact) subroutine psb_loc_to_glob1s(x,desc_a,info,iact)
use psb_descriptor_type use psb_descriptor_type
use psb_tools_mod, psb_protect_name => psb_loc_to_globs use psb_tools_mod, psb_protect_name => psb_loc_to_glob1s
implicit none implicit none
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_),intent(inout) :: x integer(psb_ipk_),intent(inout) :: x
@ -241,5 +241,5 @@ subroutine psb_loc_to_globs(x,desc_a,info,iact)
call psb_loc_to_glob(iv1,desc_a,info,iact) call psb_loc_to_glob(iv1,desc_a,info,iact)
x = iv1(1) x = iv1(1)
end subroutine psb_loc_to_globs end subroutine psb_loc_to_glob1s

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

@ -272,8 +272,8 @@ Subroutine psb_ssphalo(a,desc_a,blk,info,rowcnv,colcnv,&
end if end if
call mpi_alltoallv(valsnd,sdsz,bsdindx,mpi_real,& call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_r_spk_,&
& acoo%val,rvsz,brvindx,mpi_real,icomm,info) & acoo%val,rvsz,brvindx,psb_mpi_r_spk_,icomm,info)
call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_ipk_integer,& call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_ipk_integer,&
& acoo%ia,rvsz,brvindx,psb_mpi_ipk_integer,icomm,info) & acoo%ia,rvsz,brvindx,psb_mpi_ipk_integer,icomm,info)
call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_ipk_integer,& call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_ipk_integer,&

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

@ -272,8 +272,8 @@ Subroutine psb_zsphalo(a,desc_a,blk,info,rowcnv,colcnv,&
end if end if
call mpi_alltoallv(valsnd,sdsz,bsdindx,mpi_double_complex,& call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_c_dpk_,&
& acoo%val,rvsz,brvindx,mpi_double_complex,icomm,info) & acoo%val,rvsz,brvindx,psb_mpi_c_dpk_,icomm,info)
call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_ipk_integer,& call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_ipk_integer,&
& acoo%ia,rvsz,brvindx,psb_mpi_ipk_integer,icomm,info) & acoo%ia,rvsz,brvindx,psb_mpi_ipk_integer,icomm,info)
call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_ipk_integer,& call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_ipk_integer,&

Write Preview
Loading…
Cancel
Save