From 57a2456c9139c67775692dd0171afd186ec4b39f Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Sat, 3 Mar 2018 16:34:39 +0000 Subject: [PATCH] Split P2P files. Reorganized MPI tags. --- base/comm/internals/psi_iswapdata.F90 | 28 +- base/comm/internals/psi_iswaptran.F90 | 28 +- base/comm/psb_cscatter.F90 | 16 +- base/comm/psb_cspgather.F90 | 8 +- base/comm/psb_dscatter.F90 | 16 +- base/comm/psb_dspgather.F90 | 8 +- base/comm/psb_iscatter.F90 | 24 +- base/comm/psb_sscatter.F90 | 16 +- base/comm/psb_sspgather.F90 | 8 +- base/comm/psb_zscatter.F90 | 16 +- base/comm/psb_zspgather.F90 | 8 +- base/internals/psb_indx_map_fnd_owner.F90 | 12 +- base/internals/psi_desc_index.F90 | 6 +- base/internals/psi_extrct_dl.F90 | 4 +- base/modules/Makefile | 18 +- base/modules/basics/psi_c_p2p_mod.F90 | 307 +++ base/modules/basics/psi_d_p2p_mod.F90 | 307 +++ base/modules/basics/psi_e_p2p_mod.F90 | 307 +++ base/modules/basics/psi_m_p2p_mod.F90 | 307 +++ base/modules/basics/psi_s_p2p_mod.F90 | 307 +++ base/modules/basics/psi_z_p2p_mod.F90 | 307 +++ base/modules/psb_const_mod.F90 | 10 +- base/modules/psi_bcast_mod.F90 | 12 +- base/modules/psi_comm_buffers_mod.F90 | 6 +- base/modules/psi_p2p_mod.F90 | 2255 ++------------------- base/modules/psi_penv_mod.F90 | 26 +- base/modules/psi_reduce_mod.F90 | 256 +-- base/tools/psb_ccdbldext.F90 | 8 +- base/tools/psb_csphalo.F90 | 12 +- base/tools/psb_dcdbldext.F90 | 8 +- base/tools/psb_dsphalo.F90 | 12 +- base/tools/psb_scdbldext.F90 | 8 +- base/tools/psb_ssphalo.F90 | 12 +- base/tools/psb_zcdbldext.F90 | 8 +- base/tools/psb_zsphalo.F90 | 12 +- 35 files changed, 2327 insertions(+), 2376 deletions(-) create mode 100644 base/modules/basics/psi_c_p2p_mod.F90 create mode 100644 base/modules/basics/psi_d_p2p_mod.F90 create mode 100644 base/modules/basics/psi_e_p2p_mod.F90 create mode 100644 base/modules/basics/psi_m_p2p_mod.F90 create mode 100644 base/modules/basics/psi_s_p2p_mod.F90 create mode 100644 base/modules/basics/psi_z_p2p_mod.F90 diff --git a/base/comm/internals/psi_iswapdata.F90 b/base/comm/internals/psi_iswapdata.F90 index 5eaa0508a..edd31f7a7 100644 --- a/base/comm/internals/psi_iswapdata.F90 +++ b/base/comm/internals/psi_iswapdata.F90 @@ -297,8 +297,8 @@ subroutine psi_iswapidxm(iictxt,iicomm,flag,n,beta,y,idx, & ! swap elements using mpi_alltoallv call mpi_alltoallv(sndbuf,sdsz,bsdidx,& - & psb_mpi_ipk_int,rcvbuf,rvsz,& - & brvidx,psb_mpi_ipk_int,icomm,iret) + & psb_mpi_ipk_,rcvbuf,rvsz,& + & brvidx,psb_mpi_ipk_,icomm,iret) if(iret /= mpi_success) then ierr(1) = iret info=psb_err_mpi_error_ @@ -355,7 +355,7 @@ subroutine psi_iswapidxm(iictxt,iicomm,flag,n,beta,y,idx, & if ((nerv>0).and.(proc_to_comm /= me)) then p2ptag = psb_int_swap_tag call mpi_irecv(rcvbuf(rcv_pt),n*nerv,& - & psb_mpi_ipk_int,prcid(i),& + & psb_mpi_ipk_,prcid(i),& & p2ptag, icomm,rvhd(i),iret) end if rcv_pt = rcv_pt + n*nerv @@ -379,11 +379,11 @@ subroutine psi_iswapidxm(iictxt,iicomm,flag,n,beta,y,idx, & if ((nesd>0).and.(proc_to_comm /= me)) then if (usersend) then call mpi_rsend(sndbuf(snd_pt),n*nesd,& - & psb_mpi_ipk_int,prcid(i),& + & psb_mpi_ipk_,prcid(i),& & p2ptag,icomm,iret) else call mpi_send(sndbuf(snd_pt),n*nesd,& - & psb_mpi_ipk_int,prcid(i),& + & psb_mpi_ipk_,prcid(i),& & p2ptag,icomm,iret) end if @@ -787,8 +787,8 @@ subroutine psi_iswapidxv(iictxt,iicomm,flag,beta,y,idx, & ! swap elements using mpi_alltoallv call mpi_alltoallv(sndbuf,sdsz,bsdidx,& - & psb_mpi_ipk_int,rcvbuf,rvsz,& - & brvidx,psb_mpi_ipk_int,icomm,iret) + & psb_mpi_ipk_,rcvbuf,rvsz,& + & brvidx,psb_mpi_ipk_,icomm,iret) if(iret /= mpi_success) then ierr(1) = iret info=psb_err_mpi_error_ @@ -845,7 +845,7 @@ subroutine psi_iswapidxv(iictxt,iicomm,flag,beta,y,idx, & if ((nerv>0).and.(proc_to_comm /= me)) then p2ptag = psb_int_swap_tag call mpi_irecv(rcvbuf(rcv_pt),nerv,& - & psb_mpi_ipk_int,prcid(i),& + & psb_mpi_ipk_,prcid(i),& & p2ptag, icomm,rvhd(i),iret) end if rcv_pt = rcv_pt + nerv @@ -870,11 +870,11 @@ subroutine psi_iswapidxv(iictxt,iicomm,flag,beta,y,idx, & if ((nesd>0).and.(proc_to_comm /= me)) then if (usersend) then call mpi_rsend(sndbuf(snd_pt),nesd,& - & psb_mpi_ipk_int,prcid(i),& + & psb_mpi_ipk_,prcid(i),& & p2ptag,icomm,iret) else call mpi_send(sndbuf(snd_pt),nesd,& - & psb_mpi_ipk_int,prcid(i),& + & psb_mpi_ipk_,prcid(i),& & p2ptag,icomm,iret) end if @@ -1181,7 +1181,7 @@ subroutine psi_iswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, & if (debug) write(*,*) me,'Posting receive from',prcid(i),rcv_pt p2ptag = psb_int_swap_tag call mpi_irecv(y%combuf(rcv_pt),nerv,& - & psb_mpi_ipk_int,prcid(i),& + & psb_mpi_ipk_,prcid(i),& & p2ptag, icomm,y%comid(i,2),iret) end if pnti = pnti + nerv + nesd + 3 @@ -1224,7 +1224,7 @@ subroutine psi_iswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, & if ((nesd>0).and.(proc_to_comm /= me)) then call mpi_isend(y%combuf(snd_pt),nesd,& - & psb_mpi_ipk_int,prcid(i),& + & psb_mpi_ipk_,prcid(i),& & p2ptag,icomm,y%comid(i,1),iret) end if @@ -1526,7 +1526,7 @@ subroutine psi_iswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, & if (debug) write(*,*) me,'Posting receive from',prcid(i),rcv_pt p2ptag = psb_int_swap_tag call mpi_irecv(y%combuf(rcv_pt),n*nerv,& - & psb_mpi_ipk_int,prcid(i),& + & psb_mpi_ipk_,prcid(i),& & p2ptag, icomm,y%comid(i,2),iret) end if rcv_pt = rcv_pt + n*nerv @@ -1571,7 +1571,7 @@ subroutine psi_iswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, & if ((nesd>0).and.(proc_to_comm /= me)) then call mpi_isend(y%combuf(snd_pt),n*nesd,& - & psb_mpi_ipk_int,prcid(i),& + & psb_mpi_ipk_,prcid(i),& & p2ptag,icomm,y%comid(i,1),iret) end if diff --git a/base/comm/internals/psi_iswaptran.F90 b/base/comm/internals/psi_iswaptran.F90 index b6b3eda9c..b59ed6ba7 100644 --- a/base/comm/internals/psi_iswaptran.F90 +++ b/base/comm/internals/psi_iswaptran.F90 @@ -308,8 +308,8 @@ subroutine psi_itranidxm(iictxt,iicomm,flag,n,beta,y,idx,& ! swap elements using mpi_alltoallv call mpi_alltoallv(rcvbuf,rvsz,brvidx,& - & psb_mpi_ipk_int,& - & sndbuf,sdsz,bsdidx,psb_mpi_ipk_int,icomm,iret) + & psb_mpi_ipk_,& + & sndbuf,sdsz,bsdidx,psb_mpi_ipk_,icomm,iret) if(iret /= mpi_success) then ierr(1) = iret info=psb_err_mpi_error_ @@ -366,7 +366,7 @@ subroutine psi_itranidxm(iictxt,iicomm,flag,n,beta,y,idx,& if ((nesd>0).and.(proc_to_comm /= me)) then p2ptag = psb_int_swap_tag call mpi_irecv(sndbuf(snd_pt),n*nesd,& - & psb_mpi_ipk_int,prcid(i),& + & psb_mpi_ipk_,prcid(i),& & p2ptag,icomm,rvhd(i),iret) end if rcv_pt = rcv_pt + n*nerv @@ -390,11 +390,11 @@ subroutine psi_itranidxm(iictxt,iicomm,flag,n,beta,y,idx,& p2ptag = psb_int_swap_tag if (usersend) then call mpi_rsend(rcvbuf(rcv_pt),n*nerv,& - & psb_mpi_ipk_int,prcid(i),& + & psb_mpi_ipk_,prcid(i),& & p2ptag,icomm,iret) else call mpi_send(rcvbuf(rcv_pt),n*nerv,& - & psb_mpi_ipk_int,prcid(i),& + & psb_mpi_ipk_,prcid(i),& & p2ptag,icomm,iret) end if @@ -807,8 +807,8 @@ subroutine psi_itranidxv(iictxt,iicomm,flag,beta,y,idx,& ! swap elements using mpi_alltoallv call mpi_alltoallv(rcvbuf,rvsz,brvidx,& - & psb_mpi_ipk_int,& - & sndbuf,sdsz,bsdidx,psb_mpi_ipk_int,icomm,iret) + & psb_mpi_ipk_,& + & sndbuf,sdsz,bsdidx,psb_mpi_ipk_,icomm,iret) if(iret /= mpi_success) then ierr(1) = iret info=psb_err_mpi_error_ @@ -864,7 +864,7 @@ subroutine psi_itranidxv(iictxt,iicomm,flag,beta,y,idx,& if ((nesd>0).and.(proc_to_comm /= me)) then p2ptag = psb_int_swap_tag call mpi_irecv(sndbuf(snd_pt),nesd,& - & psb_mpi_ipk_int,prcid(i),& + & psb_mpi_ipk_,prcid(i),& & p2ptag,icomm,rvhd(i),iret) end if rcv_pt = rcv_pt + nerv @@ -888,11 +888,11 @@ subroutine psi_itranidxv(iictxt,iicomm,flag,beta,y,idx,& p2ptag = psb_int_swap_tag if (usersend) then call mpi_rsend(rcvbuf(rcv_pt),nerv,& - & psb_mpi_ipk_int,prcid(i),& + & psb_mpi_ipk_,prcid(i),& & p2ptag, icomm,iret) else call mpi_send(rcvbuf(rcv_pt),nerv,& - & psb_mpi_ipk_int,prcid(i),& + & psb_mpi_ipk_,prcid(i),& & p2ptag, icomm,iret) end if @@ -1202,7 +1202,7 @@ subroutine psi_itran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& if ((nesd>0).and.(proc_to_comm /= me)) then if (debug) write(*,*) me,'Posting receive from',prcid(i),rcv_pt call mpi_irecv(y%combuf(snd_pt),nesd,& - & psb_mpi_ipk_int,prcid(i),& + & psb_mpi_ipk_,prcid(i),& & p2ptag, icomm,y%comid(i,2),iret) end if pnti = pnti + nerv + nesd + 3 @@ -1249,7 +1249,7 @@ subroutine psi_itran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& if ((nerv>0).and.(proc_to_comm /= me)) then call mpi_isend(y%combuf(rcv_pt),nerv,& - & psb_mpi_ipk_int,prcid(i),& + & psb_mpi_ipk_,prcid(i),& & p2ptag,icomm,y%comid(i,1),iret) end if @@ -1556,7 +1556,7 @@ subroutine psi_itran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& if ((nesd>0).and.(proc_to_comm /= me)) then if (debug) write(*,*) me,'Posting receive from',prcid(i),snd_pt call mpi_irecv(y%combuf(snd_pt),n*nesd,& - & psb_mpi_ipk_int,prcid(i),& + & psb_mpi_ipk_,prcid(i),& & p2ptag, icomm,y%comid(i,2),iret) end if rcv_pt = rcv_pt + n*nerv @@ -1603,7 +1603,7 @@ subroutine psi_itran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& if ((nerv>0).and.(proc_to_comm /= me)) then call mpi_isend(y%combuf(rcv_pt),n*nerv,& - & psb_mpi_ipk_int,prcid(i),& + & psb_mpi_ipk_,prcid(i),& & p2ptag,icomm,y%comid(i,1),iret) end if diff --git a/base/comm/psb_cscatter.F90 b/base/comm/psb_cscatter.F90 index 77aa91dfc..ba6f111c0 100644 --- a/base/comm/psb_cscatter.F90 +++ b/base/comm/psb_cscatter.F90 @@ -157,8 +157,8 @@ subroutine psb_cscatterm(globx, locx, desc_a, info, root) call psb_get_rank(rootrank,ictxt,iroot) - call mpi_gather(nrow,1,psb_mpi_ipk_int,all_dim,& - & 1,psb_mpi_ipk_int,rootrank,icomm,info) + call mpi_gather(nrow,1,psb_mpi_ipk_,all_dim,& + & 1,psb_mpi_ipk_,rootrank,icomm,info) if (iam == iroot) then displ(1)=0 @@ -185,8 +185,8 @@ subroutine psb_cscatterm(globx, locx, desc_a, info, root) end if call mpi_gatherv(ltg,nrow,& - & psb_mpi_ipk_int,l_t_g_all,all_dim,& - & displ,psb_mpi_ipk_int,rootrank,icomm,info) + & psb_mpi_ipk_,l_t_g_all,all_dim,& + & displ,psb_mpi_ipk_,rootrank,icomm,info) do col=1, k ! prepare vector to scatter @@ -384,8 +384,8 @@ subroutine psb_cscatterv(globx, locx, desc_a, info, root) else call psb_get_rank(rootrank,ictxt,iroot) - call mpi_gather(nrow,1,psb_mpi_ipk_int,all_dim,& - & 1,psb_mpi_ipk_int,rootrank,icomm,info) + call mpi_gather(nrow,1,psb_mpi_ipk_,all_dim,& + & 1,psb_mpi_ipk_,rootrank,icomm,info) if(iam == iroot) then displ(1)=0 @@ -417,8 +417,8 @@ subroutine psb_cscatterv(globx, locx, desc_a, info, root) end if call mpi_gatherv(ltg,nrow,& - & psb_mpi_ipk_int,l_t_g_all,all_dim,& - & displ,psb_mpi_ipk_int,rootrank,icomm,info) + & psb_mpi_ipk_,l_t_g_all,all_dim,& + & displ,psb_mpi_ipk_,rootrank,icomm,info) ! prepare vector to scatter if (iam == iroot) then diff --git a/base/comm/psb_cspgather.F90 b/base/comm/psb_cspgather.F90 index ec86e3f8a..7f6b5a4ee 100644 --- a/base/comm/psb_cspgather.F90 +++ b/base/comm/psb_cspgather.F90 @@ -117,13 +117,13 @@ subroutine psb_csp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep & glob_coo%val,nzbr,idisp,& & psb_mpi_c_spk_,icomm,minfo) if (minfo == psb_success_) call & - & mpi_allgatherv(loc_coo%ia,ndx,psb_mpi_ipk_int,& + & mpi_allgatherv(loc_coo%ia,ndx,psb_mpi_ipk_,& & glob_coo%ia,nzbr,idisp,& - & psb_mpi_ipk_int,icomm,minfo) + & psb_mpi_ipk_,icomm,minfo) if (minfo == psb_success_) call & - & mpi_allgatherv(loc_coo%ja,ndx,psb_mpi_ipk_int,& + & mpi_allgatherv(loc_coo%ja,ndx,psb_mpi_ipk_,& & glob_coo%ja,nzbr,idisp,& - & psb_mpi_ipk_int,icomm,minfo) + & psb_mpi_ipk_,icomm,minfo) if (minfo /= psb_success_) then info = minfo diff --git a/base/comm/psb_dscatter.F90 b/base/comm/psb_dscatter.F90 index 14cc532a5..c833d3722 100644 --- a/base/comm/psb_dscatter.F90 +++ b/base/comm/psb_dscatter.F90 @@ -157,8 +157,8 @@ subroutine psb_dscatterm(globx, locx, desc_a, info, root) call psb_get_rank(rootrank,ictxt,iroot) - call mpi_gather(nrow,1,psb_mpi_ipk_int,all_dim,& - & 1,psb_mpi_ipk_int,rootrank,icomm,info) + call mpi_gather(nrow,1,psb_mpi_ipk_,all_dim,& + & 1,psb_mpi_ipk_,rootrank,icomm,info) if (iam == iroot) then displ(1)=0 @@ -185,8 +185,8 @@ subroutine psb_dscatterm(globx, locx, desc_a, info, root) end if call mpi_gatherv(ltg,nrow,& - & psb_mpi_ipk_int,l_t_g_all,all_dim,& - & displ,psb_mpi_ipk_int,rootrank,icomm,info) + & psb_mpi_ipk_,l_t_g_all,all_dim,& + & displ,psb_mpi_ipk_,rootrank,icomm,info) do col=1, k ! prepare vector to scatter @@ -384,8 +384,8 @@ subroutine psb_dscatterv(globx, locx, desc_a, info, root) else call psb_get_rank(rootrank,ictxt,iroot) - call mpi_gather(nrow,1,psb_mpi_ipk_int,all_dim,& - & 1,psb_mpi_ipk_int,rootrank,icomm,info) + call mpi_gather(nrow,1,psb_mpi_ipk_,all_dim,& + & 1,psb_mpi_ipk_,rootrank,icomm,info) if(iam == iroot) then displ(1)=0 @@ -417,8 +417,8 @@ subroutine psb_dscatterv(globx, locx, desc_a, info, root) end if call mpi_gatherv(ltg,nrow,& - & psb_mpi_ipk_int,l_t_g_all,all_dim,& - & displ,psb_mpi_ipk_int,rootrank,icomm,info) + & psb_mpi_ipk_,l_t_g_all,all_dim,& + & displ,psb_mpi_ipk_,rootrank,icomm,info) ! prepare vector to scatter if (iam == iroot) then diff --git a/base/comm/psb_dspgather.F90 b/base/comm/psb_dspgather.F90 index f3841dd6c..afebc345a 100644 --- a/base/comm/psb_dspgather.F90 +++ b/base/comm/psb_dspgather.F90 @@ -117,13 +117,13 @@ subroutine psb_dsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep & glob_coo%val,nzbr,idisp,& & psb_mpi_r_dpk_,icomm,minfo) if (minfo == psb_success_) call & - & mpi_allgatherv(loc_coo%ia,ndx,psb_mpi_ipk_int,& + & mpi_allgatherv(loc_coo%ia,ndx,psb_mpi_ipk_,& & glob_coo%ia,nzbr,idisp,& - & psb_mpi_ipk_int,icomm,minfo) + & psb_mpi_ipk_,icomm,minfo) if (minfo == psb_success_) call & - & mpi_allgatherv(loc_coo%ja,ndx,psb_mpi_ipk_int,& + & mpi_allgatherv(loc_coo%ja,ndx,psb_mpi_ipk_,& & glob_coo%ja,nzbr,idisp,& - & psb_mpi_ipk_int,icomm,minfo) + & psb_mpi_ipk_,icomm,minfo) if (minfo /= psb_success_) then info = minfo diff --git a/base/comm/psb_iscatter.F90 b/base/comm/psb_iscatter.F90 index 3a67fc73c..89c4bfc44 100644 --- a/base/comm/psb_iscatter.F90 +++ b/base/comm/psb_iscatter.F90 @@ -157,8 +157,8 @@ subroutine psb_iscatterm(globx, locx, desc_a, info, root) call psb_get_rank(rootrank,ictxt,iroot) - call mpi_gather(nrow,1,psb_mpi_ipk_int,all_dim,& - & 1,psb_mpi_ipk_int,rootrank,icomm,info) + call mpi_gather(nrow,1,psb_mpi_ipk_,all_dim,& + & 1,psb_mpi_ipk_,rootrank,icomm,info) if (iam == iroot) then displ(1)=0 @@ -185,8 +185,8 @@ subroutine psb_iscatterm(globx, locx, desc_a, info, root) end if call mpi_gatherv(ltg,nrow,& - & psb_mpi_ipk_int,l_t_g_all,all_dim,& - & displ,psb_mpi_ipk_int,rootrank,icomm,info) + & psb_mpi_ipk_,l_t_g_all,all_dim,& + & displ,psb_mpi_ipk_,rootrank,icomm,info) do col=1, k ! prepare vector to scatter @@ -202,8 +202,8 @@ subroutine psb_iscatterm(globx, locx, desc_a, info, root) ! scatter call mpi_scatterv(scatterv,all_dim,displ,& - & psb_mpi_ipk_int,locx(1,col),nrow,& - & psb_mpi_ipk_int,rootrank,icomm,info) + & psb_mpi_ipk_,locx(1,col),nrow,& + & psb_mpi_ipk_,rootrank,icomm,info) end do @@ -384,8 +384,8 @@ subroutine psb_iscatterv(globx, locx, desc_a, info, root) else call psb_get_rank(rootrank,ictxt,iroot) - call mpi_gather(nrow,1,psb_mpi_ipk_int,all_dim,& - & 1,psb_mpi_ipk_int,rootrank,icomm,info) + call mpi_gather(nrow,1,psb_mpi_ipk_,all_dim,& + & 1,psb_mpi_ipk_,rootrank,icomm,info) if(iam == iroot) then displ(1)=0 @@ -417,8 +417,8 @@ subroutine psb_iscatterv(globx, locx, desc_a, info, root) end if call mpi_gatherv(ltg,nrow,& - & psb_mpi_ipk_int,l_t_g_all,all_dim,& - & displ,psb_mpi_ipk_int,rootrank,icomm,info) + & psb_mpi_ipk_,l_t_g_all,all_dim,& + & displ,psb_mpi_ipk_,rootrank,icomm,info) ! prepare vector to scatter if (iam == iroot) then @@ -433,8 +433,8 @@ subroutine psb_iscatterv(globx, locx, desc_a, info, root) end if call mpi_scatterv(scatterv,all_dim,displ,& - & psb_mpi_ipk_int,locx,nrow,& - & psb_mpi_ipk_int,rootrank,icomm,info) + & psb_mpi_ipk_,locx,nrow,& + & psb_mpi_ipk_,rootrank,icomm,info) deallocate(l_t_g_all, scatterv,stat=info) if(info /= psb_success_) then diff --git a/base/comm/psb_sscatter.F90 b/base/comm/psb_sscatter.F90 index 54344b684..8f17f435b 100644 --- a/base/comm/psb_sscatter.F90 +++ b/base/comm/psb_sscatter.F90 @@ -157,8 +157,8 @@ subroutine psb_sscatterm(globx, locx, desc_a, info, root) call psb_get_rank(rootrank,ictxt,iroot) - call mpi_gather(nrow,1,psb_mpi_ipk_int,all_dim,& - & 1,psb_mpi_ipk_int,rootrank,icomm,info) + call mpi_gather(nrow,1,psb_mpi_ipk_,all_dim,& + & 1,psb_mpi_ipk_,rootrank,icomm,info) if (iam == iroot) then displ(1)=0 @@ -185,8 +185,8 @@ subroutine psb_sscatterm(globx, locx, desc_a, info, root) end if call mpi_gatherv(ltg,nrow,& - & psb_mpi_ipk_int,l_t_g_all,all_dim,& - & displ,psb_mpi_ipk_int,rootrank,icomm,info) + & psb_mpi_ipk_,l_t_g_all,all_dim,& + & displ,psb_mpi_ipk_,rootrank,icomm,info) do col=1, k ! prepare vector to scatter @@ -384,8 +384,8 @@ subroutine psb_sscatterv(globx, locx, desc_a, info, root) else call psb_get_rank(rootrank,ictxt,iroot) - call mpi_gather(nrow,1,psb_mpi_ipk_int,all_dim,& - & 1,psb_mpi_ipk_int,rootrank,icomm,info) + call mpi_gather(nrow,1,psb_mpi_ipk_,all_dim,& + & 1,psb_mpi_ipk_,rootrank,icomm,info) if(iam == iroot) then displ(1)=0 @@ -417,8 +417,8 @@ subroutine psb_sscatterv(globx, locx, desc_a, info, root) end if call mpi_gatherv(ltg,nrow,& - & psb_mpi_ipk_int,l_t_g_all,all_dim,& - & displ,psb_mpi_ipk_int,rootrank,icomm,info) + & psb_mpi_ipk_,l_t_g_all,all_dim,& + & displ,psb_mpi_ipk_,rootrank,icomm,info) ! prepare vector to scatter if (iam == iroot) then diff --git a/base/comm/psb_sspgather.F90 b/base/comm/psb_sspgather.F90 index d18c56580..62b7ba445 100644 --- a/base/comm/psb_sspgather.F90 +++ b/base/comm/psb_sspgather.F90 @@ -117,13 +117,13 @@ subroutine psb_ssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep & glob_coo%val,nzbr,idisp,& & psb_mpi_r_spk_,icomm,minfo) if (minfo == psb_success_) call & - & mpi_allgatherv(loc_coo%ia,ndx,psb_mpi_ipk_int,& + & mpi_allgatherv(loc_coo%ia,ndx,psb_mpi_ipk_,& & glob_coo%ia,nzbr,idisp,& - & psb_mpi_ipk_int,icomm,minfo) + & psb_mpi_ipk_,icomm,minfo) if (minfo == psb_success_) call & - & mpi_allgatherv(loc_coo%ja,ndx,psb_mpi_ipk_int,& + & mpi_allgatherv(loc_coo%ja,ndx,psb_mpi_ipk_,& & glob_coo%ja,nzbr,idisp,& - & psb_mpi_ipk_int,icomm,minfo) + & psb_mpi_ipk_,icomm,minfo) if (minfo /= psb_success_) then info = minfo diff --git a/base/comm/psb_zscatter.F90 b/base/comm/psb_zscatter.F90 index 86f1fdfaf..0d079a2ac 100644 --- a/base/comm/psb_zscatter.F90 +++ b/base/comm/psb_zscatter.F90 @@ -157,8 +157,8 @@ subroutine psb_zscatterm(globx, locx, desc_a, info, root) call psb_get_rank(rootrank,ictxt,iroot) - call mpi_gather(nrow,1,psb_mpi_ipk_int,all_dim,& - & 1,psb_mpi_ipk_int,rootrank,icomm,info) + call mpi_gather(nrow,1,psb_mpi_ipk_,all_dim,& + & 1,psb_mpi_ipk_,rootrank,icomm,info) if (iam == iroot) then displ(1)=0 @@ -185,8 +185,8 @@ subroutine psb_zscatterm(globx, locx, desc_a, info, root) end if call mpi_gatherv(ltg,nrow,& - & psb_mpi_ipk_int,l_t_g_all,all_dim,& - & displ,psb_mpi_ipk_int,rootrank,icomm,info) + & psb_mpi_ipk_,l_t_g_all,all_dim,& + & displ,psb_mpi_ipk_,rootrank,icomm,info) do col=1, k ! prepare vector to scatter @@ -384,8 +384,8 @@ subroutine psb_zscatterv(globx, locx, desc_a, info, root) else call psb_get_rank(rootrank,ictxt,iroot) - call mpi_gather(nrow,1,psb_mpi_ipk_int,all_dim,& - & 1,psb_mpi_ipk_int,rootrank,icomm,info) + call mpi_gather(nrow,1,psb_mpi_ipk_,all_dim,& + & 1,psb_mpi_ipk_,rootrank,icomm,info) if(iam == iroot) then displ(1)=0 @@ -417,8 +417,8 @@ subroutine psb_zscatterv(globx, locx, desc_a, info, root) end if call mpi_gatherv(ltg,nrow,& - & psb_mpi_ipk_int,l_t_g_all,all_dim,& - & displ,psb_mpi_ipk_int,rootrank,icomm,info) + & psb_mpi_ipk_,l_t_g_all,all_dim,& + & displ,psb_mpi_ipk_,rootrank,icomm,info) ! prepare vector to scatter if (iam == iroot) then diff --git a/base/comm/psb_zspgather.F90 b/base/comm/psb_zspgather.F90 index 3d2522eab..777bf71fb 100644 --- a/base/comm/psb_zspgather.F90 +++ b/base/comm/psb_zspgather.F90 @@ -117,13 +117,13 @@ subroutine psb_zsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep & glob_coo%val,nzbr,idisp,& & psb_mpi_c_dpk_,icomm,minfo) if (minfo == psb_success_) call & - & mpi_allgatherv(loc_coo%ia,ndx,psb_mpi_ipk_int,& + & mpi_allgatherv(loc_coo%ia,ndx,psb_mpi_ipk_,& & glob_coo%ia,nzbr,idisp,& - & psb_mpi_ipk_int,icomm,minfo) + & psb_mpi_ipk_,icomm,minfo) if (minfo == psb_success_) call & - & mpi_allgatherv(loc_coo%ja,ndx,psb_mpi_ipk_int,& + & mpi_allgatherv(loc_coo%ja,ndx,psb_mpi_ipk_,& & glob_coo%ja,nzbr,idisp,& - & psb_mpi_ipk_int,icomm,minfo) + & psb_mpi_ipk_,icomm,minfo) if (minfo /= psb_success_) then info = minfo diff --git a/base/internals/psb_indx_map_fnd_owner.F90 b/base/internals/psb_indx_map_fnd_owner.F90 index 41441423e..8e3b3b214 100644 --- a/base/internals/psb_indx_map_fnd_owner.F90 +++ b/base/internals/psb_indx_map_fnd_owner.F90 @@ -169,8 +169,8 @@ subroutine psb_indx_map_fnd_owner(idx,iprc,idxmap,info) t3 = psb_wtime() end if - call mpi_allgatherv(idx,hsz(me+1),psb_mpi_ipk_int,& - & hproc,hsz,hidx,psb_mpi_ipk_int,& + call mpi_allgatherv(idx,hsz(me+1),psb_mpi_ipk_,& + & hproc,hsz,hidx,psb_mpi_ipk_,& & icomm,minfo) if (gettime) then tamx = psb_wtime() - t3 @@ -213,8 +213,8 @@ subroutine psb_indx_map_fnd_owner(idx,iprc,idxmap,info) end if ! Collect all the answers with alltoallv (need sizes) - call mpi_alltoall(sdsz,1,psb_mpi_mpk_int,& - & rvsz,1,psb_mpi_mpk_int,icomm,minfo) + call mpi_alltoall(sdsz,1,psb_mpi_mpk_,& + & rvsz,1,psb_mpi_mpk_,icomm,minfo) isz = sum(rvsz) @@ -228,8 +228,8 @@ subroutine psb_indx_map_fnd_owner(idx,iprc,idxmap,info) rvidx(ip) = j j = j + rvsz(ip) end do - call mpi_alltoallv(hproc,sdsz,sdidx,psb_mpi_ipk_int,& - & answers(:,1),rvsz,rvidx,psb_mpi_ipk_int,& + call mpi_alltoallv(hproc,sdsz,sdidx,psb_mpi_ipk_,& + & answers(:,1),rvsz,rvidx,psb_mpi_ipk_,& & icomm,minfo) if (gettime) then tamx = psb_wtime() - t3 + tamx diff --git a/base/internals/psi_desc_index.F90 b/base/internals/psi_desc_index.F90 index 0ef84fd75..71c6d7e2f 100644 --- a/base/internals/psi_desc_index.F90 +++ b/base/internals/psi_desc_index.F90 @@ -186,7 +186,7 @@ subroutine psi_desc_index(desc,index_in,dep_list,& i = i + nerv + 1 end do ihinsz=i - call mpi_alltoall(sdsz,1,psb_mpi_mpk_int,rvsz,1,psb_mpi_mpk_int,icomm,minfo) + call mpi_alltoall(sdsz,1,psb_mpi_mpk_,rvsz,1,psb_mpi_mpk_,icomm,minfo) if (minfo /= psb_success_) then call psb_errpush(psb_err_from_subroutine_,name,a_err='mpi_alltoall') goto 9999 @@ -292,8 +292,8 @@ subroutine psi_desc_index(desc,index_in,dep_list,& idxr = idxr + rvsz(proc+1) end do - call mpi_alltoallv(sndbuf,sdsz,bsdindx,psb_mpi_ipk_int,& - & rcvbuf,rvsz,brvindx,psb_mpi_ipk_int,icomm,minfo) + call mpi_alltoallv(sndbuf,sdsz,bsdindx,psb_mpi_ipk_,& + & rcvbuf,rvsz,brvindx,psb_mpi_ipk_,icomm,minfo) if (minfo /= psb_success_) then call psb_errpush(psb_err_from_subroutine_,name,a_err='mpi_alltoallv') goto 9999 diff --git a/base/internals/psi_extrct_dl.F90 b/base/internals/psi_extrct_dl.F90 index c9f684238..d2174af1e 100644 --- a/base/internals/psi_extrct_dl.F90 +++ b/base/internals/psi_extrct_dl.F90 @@ -272,8 +272,8 @@ subroutine psi_extract_dep_list(ictxt,is_bld,is_upd,desc_str,dep_list,& endif itmp(1:dl_lda) = dep_list(1:dl_lda,me) dl_mpi = dl_lda - call mpi_allgather(itmp,dl_mpi,psb_mpi_ipk_int,& - & dep_list,dl_mpi,psb_mpi_ipk_int,icomm,minfo) + call mpi_allgather(itmp,dl_mpi,psb_mpi_ipk_,& + & dep_list,dl_mpi,psb_mpi_ipk_,icomm,minfo) info = minfo if (info == 0) deallocate(itmp,stat=info) if (info /= psb_success_) then diff --git a/base/modules/Makefile b/base/modules/Makefile index 915cc09ed..01b6615c4 100644 --- a/base/modules/Makefile +++ b/base/modules/Makefile @@ -8,7 +8,13 @@ BASIC_MODS= psb_const_mod.o psb_error_mod.o psb_realloc_mod.o \ basics/psb_c_realloc_mod.o \ basics/psb_z_realloc_mod.o -COMMINT=psi_comm_buffers_mod.o psi_penv_mod.o psi_bcast_mod.o psi_reduce_mod.o psi_p2p_mod.o +COMMINT=psi_comm_buffers_mod.o psi_penv_mod.o psi_bcast_mod.o psi_reduce_mod.o\ + psi_p2p_mod.o basics/psi_m_p2p_mod.o \ + basics/psi_e_p2p_mod.o \ + basics/psi_s_p2p_mod.o \ + basics/psi_d_p2p_mod.o \ + basics/psi_c_p2p_mod.o \ + basics/psi_z_p2p_mod.o UTIL_MODS = aux/psb_string_mod.o desc/psb_desc_const_mod.o desc/psb_indx_map_mod.o\ desc/psb_gen_block_map_mod.o desc/psb_list_map_mod.o desc/psb_repl_map_mod.o\ desc/psb_glist_map_mod.o desc/psb_hash_map_mod.o \ @@ -77,6 +83,16 @@ psb_realloc_mod.o: basics/psb_m_realloc_mod.o \ basics/psb_c_realloc_mod.o \ basics/psb_z_realloc_mod.o +psi_p2p_mod.o: basics/psi_m_p2p_mod.o \ + basics/psi_e_p2p_mod.o \ + basics/psi_s_p2p_mod.o \ + basics/psi_d_p2p_mod.o \ + basics/psi_c_p2p_mod.o \ + basics/psi_z_p2p_mod.o + +basics/psi_m_p2p_mod.o basics/psi_e_p2p_mod.o basics/psi_s_p2p_mod.o \ + basics/psi_d_p2p_mod.o basics/psi_c_p2p_mod.o basics/psi_z_p2p_mod.o: psi_penv_mod.o + aux/psb_string_mod.o desc/psb_desc_const_mod.o psi_comm_buffers_mod.o: psb_const_mod.o aux/psb_hash_mod.o: psb_realloc_mod.o psb_const_mod.o aux/psb_i_sort_mod.o aux/psb_s_sort_mod.o aux/psb_d_sort_mod.o aux/psb_c_sort_mod.o aux/psb_z_sort_mod.o \ diff --git a/base/modules/basics/psi_c_p2p_mod.F90 b/base/modules/basics/psi_c_p2p_mod.F90 new file mode 100644 index 000000000..f732c8085 --- /dev/null +++ b/base/modules/basics/psi_c_p2p_mod.F90 @@ -0,0 +1,307 @@ +! +! Parallel Sparse BLAS version 3.5 +! (C) Copyright 2006-2018 +! Salvatore Filippone +! Alfredo Buttari +! +! Redistribution and use in source and binary forms, with or without +! modification, are permitted provided that the following conditions +! are met: +! 1. Redistributions of source code must retain the above copyright +! notice, this list of conditions and the following disclaimer. +! 2. Redistributions in binary form must reproduce the above copyright +! notice, this list of conditions, and the following disclaimer in the +! documentation and/or other materials provided with the distribution. +! 3. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific written permission. +! +! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS +! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +! POSSIBILITY OF SUCH DAMAGE. +! +! + +module psi_c_p2p_mod + use psi_penv_mod + use psi_comm_buffers_mod + + interface psb_snd + module procedure psb_csnds, psb_csndv, psb_csndm, & + & psb_csnds_ec, psb_csndv_ec, psb_csndm_ec + end interface + + interface psb_rcv + module procedure psb_crcvs, psb_crcvv, psb_crcvm, & + & psb_crcvs_ec, psb_crcvv_ec, psb_crcvm_ec + end interface + +contains + + subroutine psb_csnds(ictxt,dat,dst) + use psi_comm_buffers_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + complex(psb_spk_), intent(in) :: dat + integer(psb_mpk_), intent(in) :: dst + complex(psb_spk_), allocatable :: dat_(:) + integer(psb_mpk_) :: info +#if defined(SERIAL_MPI) + ! do nothing +#else + allocate(dat_(1), stat=info) + dat_(1) = dat + call psi_snd(ictxt,psb_complex_tag,dst,dat_,psb_mesg_queue) +#endif + end subroutine psb_csnds + + subroutine psb_csndv(ictxt,dat,dst) + use psi_comm_buffers_mod + +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + complex(psb_spk_), intent(in) :: dat(:) + integer(psb_mpk_), intent(in) :: dst + complex(psb_spk_), allocatable :: dat_(:) + integer(psb_mpk_) :: info + +#if defined(SERIAL_MPI) +#else + allocate(dat_(size(dat)), stat=info) + dat_(:) = dat(:) + call psi_snd(ictxt,psb_complex_tag,dst,dat_,psb_mesg_queue) +#endif + + end subroutine psb_csndv + + subroutine psb_csndm(ictxt,dat,dst,m) + use psi_comm_buffers_mod + +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + complex(psb_spk_), intent(in) :: dat(:,:) + integer(psb_mpk_), intent(in) :: dst + integer(psb_ipk_), intent(in), optional :: m + complex(psb_spk_), allocatable :: dat_(:) + integer(psb_ipk_) :: i,j,k,m_,n_ + integer(psb_mpk_) :: info + +#if defined(SERIAL_MPI) +#else + if (present(m)) then + m_ = m + else + m_ = size(dat,1) + end if + n_ = size(dat,2) + allocate(dat_(m_*n_), stat=info) + k=1 + do j=1,n_ + do i=1, m_ + dat_(k) = dat(i,j) + k = k + 1 + end do + end do + call psi_snd(ictxt,psb_complex_tag,dst,dat_,psb_mesg_queue) +#endif + end subroutine psb_csndm + + subroutine psb_crcvs(ictxt,dat,src) + use psi_comm_buffers_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + complex(psb_spk_), intent(out) :: dat + integer(psb_mpk_), intent(in) :: src + integer(psb_mpk_) :: info + integer(psb_mpk_) :: status(mpi_status_size) +#if defined(SERIAL_MPI) + ! do nothing +#else + call mpi_recv(dat,1,psb_mpi_c_spk_,src,psb_complex_tag,ictxt,status,info) + call psb_test_nodes(psb_mesg_queue) +#endif + end subroutine psb_crcvs + + subroutine psb_crcvv(ictxt,dat,src) + use psi_comm_buffers_mod + +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + complex(psb_spk_), intent(out) :: dat(:) + integer(psb_mpk_), intent(in) :: src + complex(psb_spk_), allocatable :: dat_(:) + integer(psb_mpk_) :: info + integer(psb_mpk_) :: status(mpi_status_size) +#if defined(SERIAL_MPI) +#else + call mpi_recv(dat,size(dat),psb_mpi_c_spk_,src,psb_complex_tag,ictxt,status,info) + call psb_test_nodes(psb_mesg_queue) +#endif + + end subroutine psb_crcvv + + subroutine psb_crcvm(ictxt,dat,src,m) + use psi_comm_buffers_mod + +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + complex(psb_spk_), intent(out) :: dat(:,:) + integer(psb_mpk_), intent(in) :: src + integer(psb_ipk_), intent(in), optional :: m + complex(psb_spk_), allocatable :: dat_(:) + integer(psb_mpk_) :: info ,m_,n_, ld, mp_rcv_type + integer(psb_mpk_) :: i,j,k + integer(psb_mpk_) :: status(mpi_status_size) +#if defined(SERIAL_MPI) + ! What should we do here?? +#else + if (present(m)) then + m_ = m + ld = size(dat,1) + n_ = size(dat,2) + 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_recv(dat,1,mp_rcv_type,src,& + & psb_complex_tag,ictxt,status,info) + if (info == mpi_success) call mpi_type_free(mp_rcv_type,info) + else + call mpi_recv(dat,size(dat),psb_mpi_c_spk_,src,psb_complex_tag,ictxt,status,info) + end if + if (info /= mpi_success) then + write(psb_err_unit,*) 'Error in psb_recv', info + end if + call psb_test_nodes(psb_mesg_queue) +#endif + end subroutine psb_crcvm + + + subroutine psb_csnds_ec(ictxt,dat,dst) + + integer(psb_epk_), intent(in) :: ictxt + complex(psb_spk_), intent(in) :: dat + integer(psb_epk_), intent(in) :: dst + + integer(psb_mpk_) :: iictxt, idst + + iictxt = ictxt + idst = dst + call psb_snd(iictxt, dat, idst) + + end subroutine psb_csnds_ec + + subroutine psb_csndv_ec(ictxt,dat,dst) + + integer(psb_epk_), intent(in) :: ictxt + complex(psb_spk_), intent(in) :: dat(:) + integer(psb_epk_), intent(in) :: dst + + integer(psb_mpk_) :: iictxt, idst + + iictxt = ictxt + idst = dst + call psb_snd(iictxt, dat, idst) + + end subroutine psb_csndv_ec + + subroutine psb_csndm_ec(ictxt,dat,dst,m) + + integer(psb_epk_), intent(in) :: ictxt + complex(psb_spk_), intent(in) :: dat(:,:) + integer(psb_epk_), intent(in) :: dst + + integer(psb_mpk_) :: iictxt, idst + + iictxt = ictxt + idst = dst + call psb_snd(iictxt, dat, idst) + + end subroutine psb_csndm_ec + + subroutine psb_crcvs_ec(ictxt,dat,src) + + integer(psb_epk_), intent(in) :: ictxt + complex(psb_spk_), intent(out) :: dat + integer(psb_epk_), intent(in) :: src + + integer(psb_mpk_) :: iictxt, isrc + + iictxt = ictxt + isrc = src + call psb_rcv(iictxt, dat, isrc) + + end subroutine psb_crcvs_ec + + subroutine psb_crcvv_ec(ictxt,dat,src) + + integer(psb_epk_), intent(in) :: ictxt + complex(psb_spk_), intent(out) :: dat(:) + integer(psb_epk_), intent(in) :: src + + integer(psb_mpk_) :: iictxt, isrc + + iictxt = ictxt + isrc = src + call psb_rcv(iictxt, dat, isrc) + + end subroutine psb_crcvv_ec + + subroutine psb_crcvm_ec(ictxt,dat,src,m) + + integer(psb_epk_), intent(in) :: ictxt + complex(psb_spk_), intent(out) :: dat(:,:) + integer(psb_epk_), intent(in) :: src + + integer(psb_mpk_) :: iictxt, isrc + + iictxt = ictxt + isrc = src + call psb_rcv(iictxt, dat, isrc) + + end subroutine psb_crcvm_ec + + +end module psi_c_p2p_mod diff --git a/base/modules/basics/psi_d_p2p_mod.F90 b/base/modules/basics/psi_d_p2p_mod.F90 new file mode 100644 index 000000000..f59234f3b --- /dev/null +++ b/base/modules/basics/psi_d_p2p_mod.F90 @@ -0,0 +1,307 @@ +! +! Parallel Sparse BLAS version 3.5 +! (C) Copyright 2006-2018 +! Salvatore Filippone +! Alfredo Buttari +! +! Redistribution and use in source and binary forms, with or without +! modification, are permitted provided that the following conditions +! are met: +! 1. Redistributions of source code must retain the above copyright +! notice, this list of conditions and the following disclaimer. +! 2. Redistributions in binary form must reproduce the above copyright +! notice, this list of conditions, and the following disclaimer in the +! documentation and/or other materials provided with the distribution. +! 3. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific written permission. +! +! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS +! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +! POSSIBILITY OF SUCH DAMAGE. +! +! + +module psi_d_p2p_mod + use psi_penv_mod + use psi_comm_buffers_mod + + interface psb_snd + module procedure psb_dsnds, psb_dsndv, psb_dsndm, & + & psb_dsnds_ec, psb_dsndv_ec, psb_dsndm_ec + end interface + + interface psb_rcv + module procedure psb_drcvs, psb_drcvv, psb_drcvm, & + & psb_drcvs_ec, psb_drcvv_ec, psb_drcvm_ec + end interface + +contains + + subroutine psb_dsnds(ictxt,dat,dst) + use psi_comm_buffers_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + real(psb_dpk_), intent(in) :: dat + integer(psb_mpk_), intent(in) :: dst + real(psb_dpk_), allocatable :: dat_(:) + integer(psb_mpk_) :: info +#if defined(SERIAL_MPI) + ! do nothing +#else + allocate(dat_(1), stat=info) + dat_(1) = dat + call psi_snd(ictxt,psb_double_tag,dst,dat_,psb_mesg_queue) +#endif + end subroutine psb_dsnds + + subroutine psb_dsndv(ictxt,dat,dst) + use psi_comm_buffers_mod + +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + real(psb_dpk_), intent(in) :: dat(:) + integer(psb_mpk_), intent(in) :: dst + real(psb_dpk_), allocatable :: dat_(:) + integer(psb_mpk_) :: info + +#if defined(SERIAL_MPI) +#else + allocate(dat_(size(dat)), stat=info) + dat_(:) = dat(:) + call psi_snd(ictxt,psb_double_tag,dst,dat_,psb_mesg_queue) +#endif + + end subroutine psb_dsndv + + subroutine psb_dsndm(ictxt,dat,dst,m) + use psi_comm_buffers_mod + +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + real(psb_dpk_), intent(in) :: dat(:,:) + integer(psb_mpk_), intent(in) :: dst + integer(psb_ipk_), intent(in), optional :: m + real(psb_dpk_), allocatable :: dat_(:) + integer(psb_ipk_) :: i,j,k,m_,n_ + integer(psb_mpk_) :: info + +#if defined(SERIAL_MPI) +#else + if (present(m)) then + m_ = m + else + m_ = size(dat,1) + end if + n_ = size(dat,2) + allocate(dat_(m_*n_), stat=info) + k=1 + do j=1,n_ + do i=1, m_ + dat_(k) = dat(i,j) + k = k + 1 + end do + end do + call psi_snd(ictxt,psb_double_tag,dst,dat_,psb_mesg_queue) +#endif + end subroutine psb_dsndm + + subroutine psb_drcvs(ictxt,dat,src) + use psi_comm_buffers_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + real(psb_dpk_), intent(out) :: dat + integer(psb_mpk_), intent(in) :: src + integer(psb_mpk_) :: info + integer(psb_mpk_) :: status(mpi_status_size) +#if defined(SERIAL_MPI) + ! do nothing +#else + call mpi_recv(dat,1,psb_mpi_r_dpk_,src,psb_double_tag,ictxt,status,info) + call psb_test_nodes(psb_mesg_queue) +#endif + end subroutine psb_drcvs + + subroutine psb_drcvv(ictxt,dat,src) + use psi_comm_buffers_mod + +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + real(psb_dpk_), intent(out) :: dat(:) + integer(psb_mpk_), intent(in) :: src + real(psb_dpk_), allocatable :: dat_(:) + integer(psb_mpk_) :: info + integer(psb_mpk_) :: status(mpi_status_size) +#if defined(SERIAL_MPI) +#else + call mpi_recv(dat,size(dat),psb_mpi_r_dpk_,src,psb_double_tag,ictxt,status,info) + call psb_test_nodes(psb_mesg_queue) +#endif + + end subroutine psb_drcvv + + subroutine psb_drcvm(ictxt,dat,src,m) + use psi_comm_buffers_mod + +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + real(psb_dpk_), intent(out) :: dat(:,:) + integer(psb_mpk_), intent(in) :: src + integer(psb_ipk_), intent(in), optional :: m + real(psb_dpk_), allocatable :: dat_(:) + integer(psb_mpk_) :: info ,m_,n_, ld, mp_rcv_type + integer(psb_mpk_) :: i,j,k + integer(psb_mpk_) :: status(mpi_status_size) +#if defined(SERIAL_MPI) + ! What should we do here?? +#else + if (present(m)) then + m_ = m + ld = size(dat,1) + n_ = size(dat,2) + 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_recv(dat,1,mp_rcv_type,src,& + & psb_double_tag,ictxt,status,info) + if (info == mpi_success) call mpi_type_free(mp_rcv_type,info) + else + call mpi_recv(dat,size(dat),psb_mpi_r_dpk_,src,psb_double_tag,ictxt,status,info) + end if + if (info /= mpi_success) then + write(psb_err_unit,*) 'Error in psb_recv', info + end if + call psb_test_nodes(psb_mesg_queue) +#endif + end subroutine psb_drcvm + + + subroutine psb_dsnds_ec(ictxt,dat,dst) + + integer(psb_epk_), intent(in) :: ictxt + real(psb_dpk_), intent(in) :: dat + integer(psb_epk_), intent(in) :: dst + + integer(psb_mpk_) :: iictxt, idst + + iictxt = ictxt + idst = dst + call psb_snd(iictxt, dat, idst) + + end subroutine psb_dsnds_ec + + subroutine psb_dsndv_ec(ictxt,dat,dst) + + integer(psb_epk_), intent(in) :: ictxt + real(psb_dpk_), intent(in) :: dat(:) + integer(psb_epk_), intent(in) :: dst + + integer(psb_mpk_) :: iictxt, idst + + iictxt = ictxt + idst = dst + call psb_snd(iictxt, dat, idst) + + end subroutine psb_dsndv_ec + + subroutine psb_dsndm_ec(ictxt,dat,dst,m) + + integer(psb_epk_), intent(in) :: ictxt + real(psb_dpk_), intent(in) :: dat(:,:) + integer(psb_epk_), intent(in) :: dst + + integer(psb_mpk_) :: iictxt, idst + + iictxt = ictxt + idst = dst + call psb_snd(iictxt, dat, idst) + + end subroutine psb_dsndm_ec + + subroutine psb_drcvs_ec(ictxt,dat,src) + + integer(psb_epk_), intent(in) :: ictxt + real(psb_dpk_), intent(out) :: dat + integer(psb_epk_), intent(in) :: src + + integer(psb_mpk_) :: iictxt, isrc + + iictxt = ictxt + isrc = src + call psb_rcv(iictxt, dat, isrc) + + end subroutine psb_drcvs_ec + + subroutine psb_drcvv_ec(ictxt,dat,src) + + integer(psb_epk_), intent(in) :: ictxt + real(psb_dpk_), intent(out) :: dat(:) + integer(psb_epk_), intent(in) :: src + + integer(psb_mpk_) :: iictxt, isrc + + iictxt = ictxt + isrc = src + call psb_rcv(iictxt, dat, isrc) + + end subroutine psb_drcvv_ec + + subroutine psb_drcvm_ec(ictxt,dat,src,m) + + integer(psb_epk_), intent(in) :: ictxt + real(psb_dpk_), intent(out) :: dat(:,:) + integer(psb_epk_), intent(in) :: src + + integer(psb_mpk_) :: iictxt, isrc + + iictxt = ictxt + isrc = src + call psb_rcv(iictxt, dat, isrc) + + end subroutine psb_drcvm_ec + + +end module psi_d_p2p_mod diff --git a/base/modules/basics/psi_e_p2p_mod.F90 b/base/modules/basics/psi_e_p2p_mod.F90 new file mode 100644 index 000000000..d72f4ee0f --- /dev/null +++ b/base/modules/basics/psi_e_p2p_mod.F90 @@ -0,0 +1,307 @@ +! +! Parallel Sparse BLAS version 3.5 +! (C) Copyright 2006-2018 +! Salvatore Filippone +! Alfredo Buttari +! +! Redistribution and use in source and binary forms, with or without +! modification, are permitted provided that the following conditions +! are met: +! 1. Redistributions of source code must retain the above copyright +! notice, this list of conditions and the following disclaimer. +! 2. Redistributions in binary form must reproduce the above copyright +! notice, this list of conditions, and the following disclaimer in the +! documentation and/or other materials provided with the distribution. +! 3. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific written permission. +! +! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS +! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +! POSSIBILITY OF SUCH DAMAGE. +! +! + +module psi_e_p2p_mod + use psi_penv_mod + use psi_comm_buffers_mod + + interface psb_snd + module procedure psb_esnds, psb_esndv, psb_esndm, & + & psb_esnds_ec, psb_esndv_ec, psb_esndm_ec + end interface + + interface psb_rcv + module procedure psb_ercvs, psb_ercvv, psb_ercvm, & + & psb_ercvs_ec, psb_ercvv_ec, psb_ercvm_ec + end interface + +contains + + subroutine psb_esnds(ictxt,dat,dst) + use psi_comm_buffers_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + integer(psb_epk_), intent(in) :: dat + integer(psb_mpk_), intent(in) :: dst + integer(psb_epk_), allocatable :: dat_(:) + integer(psb_mpk_) :: info +#if defined(SERIAL_MPI) + ! do nothing +#else + allocate(dat_(1), stat=info) + dat_(1) = dat + call psi_snd(ictxt,psb_int8_tag,dst,dat_,psb_mesg_queue) +#endif + end subroutine psb_esnds + + subroutine psb_esndv(ictxt,dat,dst) + use psi_comm_buffers_mod + +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + integer(psb_epk_), intent(in) :: dat(:) + integer(psb_mpk_), intent(in) :: dst + integer(psb_epk_), allocatable :: dat_(:) + integer(psb_mpk_) :: info + +#if defined(SERIAL_MPI) +#else + allocate(dat_(size(dat)), stat=info) + dat_(:) = dat(:) + call psi_snd(ictxt,psb_int8_tag,dst,dat_,psb_mesg_queue) +#endif + + end subroutine psb_esndv + + subroutine psb_esndm(ictxt,dat,dst,m) + use psi_comm_buffers_mod + +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + integer(psb_epk_), intent(in) :: dat(:,:) + integer(psb_mpk_), intent(in) :: dst + integer(psb_ipk_), intent(in), optional :: m + integer(psb_epk_), allocatable :: dat_(:) + integer(psb_ipk_) :: i,j,k,m_,n_ + integer(psb_mpk_) :: info + +#if defined(SERIAL_MPI) +#else + if (present(m)) then + m_ = m + else + m_ = size(dat,1) + end if + n_ = size(dat,2) + allocate(dat_(m_*n_), stat=info) + k=1 + do j=1,n_ + do i=1, m_ + dat_(k) = dat(i,j) + k = k + 1 + end do + end do + call psi_snd(ictxt,psb_int8_tag,dst,dat_,psb_mesg_queue) +#endif + end subroutine psb_esndm + + subroutine psb_ercvs(ictxt,dat,src) + use psi_comm_buffers_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + integer(psb_epk_), intent(out) :: dat + integer(psb_mpk_), intent(in) :: src + integer(psb_mpk_) :: info + integer(psb_mpk_) :: status(mpi_status_size) +#if defined(SERIAL_MPI) + ! do nothing +#else + call mpi_recv(dat,1,psb_mpi_epk_,src,psb_int8_tag,ictxt,status,info) + call psb_test_nodes(psb_mesg_queue) +#endif + end subroutine psb_ercvs + + subroutine psb_ercvv(ictxt,dat,src) + use psi_comm_buffers_mod + +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + integer(psb_epk_), intent(out) :: dat(:) + integer(psb_mpk_), intent(in) :: src + integer(psb_epk_), allocatable :: dat_(:) + integer(psb_mpk_) :: info + integer(psb_mpk_) :: status(mpi_status_size) +#if defined(SERIAL_MPI) +#else + call mpi_recv(dat,size(dat),psb_mpi_epk_,src,psb_int8_tag,ictxt,status,info) + call psb_test_nodes(psb_mesg_queue) +#endif + + end subroutine psb_ercvv + + subroutine psb_ercvm(ictxt,dat,src,m) + use psi_comm_buffers_mod + +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + integer(psb_epk_), intent(out) :: dat(:,:) + integer(psb_mpk_), intent(in) :: src + integer(psb_ipk_), intent(in), optional :: m + integer(psb_epk_), allocatable :: dat_(:) + integer(psb_mpk_) :: info ,m_,n_, ld, mp_rcv_type + integer(psb_mpk_) :: i,j,k + integer(psb_mpk_) :: status(mpi_status_size) +#if defined(SERIAL_MPI) + ! What should we do here?? +#else + if (present(m)) then + m_ = m + ld = size(dat,1) + n_ = size(dat,2) + call mpi_type_vector(n_,m_,ld,psb_mpi_epk_,mp_rcv_type,info) + if (info == mpi_success) call mpi_type_commit(mp_rcv_type,info) + if (info == mpi_success) call mpi_recv(dat,1,mp_rcv_type,src,& + & psb_int8_tag,ictxt,status,info) + if (info == mpi_success) call mpi_type_free(mp_rcv_type,info) + else + call mpi_recv(dat,size(dat),psb_mpi_epk_,src,psb_int8_tag,ictxt,status,info) + end if + if (info /= mpi_success) then + write(psb_err_unit,*) 'Error in psb_recv', info + end if + call psb_test_nodes(psb_mesg_queue) +#endif + end subroutine psb_ercvm + + + subroutine psb_esnds_ec(ictxt,dat,dst) + + integer(psb_epk_), intent(in) :: ictxt + integer(psb_epk_), intent(in) :: dat + integer(psb_epk_), intent(in) :: dst + + integer(psb_mpk_) :: iictxt, idst + + iictxt = ictxt + idst = dst + call psb_snd(iictxt, dat, idst) + + end subroutine psb_esnds_ec + + subroutine psb_esndv_ec(ictxt,dat,dst) + + integer(psb_epk_), intent(in) :: ictxt + integer(psb_epk_), intent(in) :: dat(:) + integer(psb_epk_), intent(in) :: dst + + integer(psb_mpk_) :: iictxt, idst + + iictxt = ictxt + idst = dst + call psb_snd(iictxt, dat, idst) + + end subroutine psb_esndv_ec + + subroutine psb_esndm_ec(ictxt,dat,dst,m) + + integer(psb_epk_), intent(in) :: ictxt + integer(psb_epk_), intent(in) :: dat(:,:) + integer(psb_epk_), intent(in) :: dst + + integer(psb_mpk_) :: iictxt, idst + + iictxt = ictxt + idst = dst + call psb_snd(iictxt, dat, idst) + + end subroutine psb_esndm_ec + + subroutine psb_ercvs_ec(ictxt,dat,src) + + integer(psb_epk_), intent(in) :: ictxt + integer(psb_epk_), intent(out) :: dat + integer(psb_epk_), intent(in) :: src + + integer(psb_mpk_) :: iictxt, isrc + + iictxt = ictxt + isrc = src + call psb_rcv(iictxt, dat, isrc) + + end subroutine psb_ercvs_ec + + subroutine psb_ercvv_ec(ictxt,dat,src) + + integer(psb_epk_), intent(in) :: ictxt + integer(psb_epk_), intent(out) :: dat(:) + integer(psb_epk_), intent(in) :: src + + integer(psb_mpk_) :: iictxt, isrc + + iictxt = ictxt + isrc = src + call psb_rcv(iictxt, dat, isrc) + + end subroutine psb_ercvv_ec + + subroutine psb_ercvm_ec(ictxt,dat,src,m) + + integer(psb_epk_), intent(in) :: ictxt + integer(psb_epk_), intent(out) :: dat(:,:) + integer(psb_epk_), intent(in) :: src + + integer(psb_mpk_) :: iictxt, isrc + + iictxt = ictxt + isrc = src + call psb_rcv(iictxt, dat, isrc) + + end subroutine psb_ercvm_ec + + +end module psi_e_p2p_mod diff --git a/base/modules/basics/psi_m_p2p_mod.F90 b/base/modules/basics/psi_m_p2p_mod.F90 new file mode 100644 index 000000000..f2600dc60 --- /dev/null +++ b/base/modules/basics/psi_m_p2p_mod.F90 @@ -0,0 +1,307 @@ +! +! Parallel Sparse BLAS version 3.5 +! (C) Copyright 2006-2018 +! Salvatore Filippone +! Alfredo Buttari +! +! Redistribution and use in source and binary forms, with or without +! modification, are permitted provided that the following conditions +! are met: +! 1. Redistributions of source code must retain the above copyright +! notice, this list of conditions and the following disclaimer. +! 2. Redistributions in binary form must reproduce the above copyright +! notice, this list of conditions, and the following disclaimer in the +! documentation and/or other materials provided with the distribution. +! 3. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific written permission. +! +! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS +! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +! POSSIBILITY OF SUCH DAMAGE. +! +! + +module psi_m_p2p_mod + use psi_penv_mod + use psi_comm_buffers_mod + + interface psb_snd + module procedure psb_msnds, psb_msndv, psb_msndm, & + & psb_msnds_ec, psb_msndv_ec, psb_msndm_ec + end interface + + interface psb_rcv + module procedure psb_mrcvs, psb_mrcvv, psb_mrcvm, & + & psb_mrcvs_ec, psb_mrcvv_ec, psb_mrcvm_ec + end interface + +contains + + subroutine psb_msnds(ictxt,dat,dst) + use psi_comm_buffers_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + integer(psb_mpk_), intent(in) :: dat + integer(psb_mpk_), intent(in) :: dst + integer(psb_mpk_), allocatable :: dat_(:) + integer(psb_mpk_) :: info +#if defined(SERIAL_MPI) + ! do nothing +#else + allocate(dat_(1), stat=info) + dat_(1) = dat + call psi_snd(ictxt,psb_int4_tag,dst,dat_,psb_mesg_queue) +#endif + end subroutine psb_msnds + + subroutine psb_msndv(ictxt,dat,dst) + use psi_comm_buffers_mod + +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + integer(psb_mpk_), intent(in) :: dat(:) + integer(psb_mpk_), intent(in) :: dst + integer(psb_mpk_), allocatable :: dat_(:) + integer(psb_mpk_) :: info + +#if defined(SERIAL_MPI) +#else + allocate(dat_(size(dat)), stat=info) + dat_(:) = dat(:) + call psi_snd(ictxt,psb_int4_tag,dst,dat_,psb_mesg_queue) +#endif + + end subroutine psb_msndv + + subroutine psb_msndm(ictxt,dat,dst,m) + use psi_comm_buffers_mod + +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + integer(psb_mpk_), intent(in) :: dat(:,:) + integer(psb_mpk_), intent(in) :: dst + integer(psb_ipk_), intent(in), optional :: m + integer(psb_mpk_), allocatable :: dat_(:) + integer(psb_ipk_) :: i,j,k,m_,n_ + integer(psb_mpk_) :: info + +#if defined(SERIAL_MPI) +#else + if (present(m)) then + m_ = m + else + m_ = size(dat,1) + end if + n_ = size(dat,2) + allocate(dat_(m_*n_), stat=info) + k=1 + do j=1,n_ + do i=1, m_ + dat_(k) = dat(i,j) + k = k + 1 + end do + end do + call psi_snd(ictxt,psb_int4_tag,dst,dat_,psb_mesg_queue) +#endif + end subroutine psb_msndm + + subroutine psb_mrcvs(ictxt,dat,src) + use psi_comm_buffers_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + integer(psb_mpk_), intent(out) :: dat + integer(psb_mpk_), intent(in) :: src + integer(psb_mpk_) :: info + integer(psb_mpk_) :: status(mpi_status_size) +#if defined(SERIAL_MPI) + ! do nothing +#else + call mpi_recv(dat,1,psb_mpi_mpk_,src,psb_int4_tag,ictxt,status,info) + call psb_test_nodes(psb_mesg_queue) +#endif + end subroutine psb_mrcvs + + subroutine psb_mrcvv(ictxt,dat,src) + use psi_comm_buffers_mod + +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + integer(psb_mpk_), intent(out) :: dat(:) + integer(psb_mpk_), intent(in) :: src + integer(psb_mpk_), allocatable :: dat_(:) + integer(psb_mpk_) :: info + integer(psb_mpk_) :: status(mpi_status_size) +#if defined(SERIAL_MPI) +#else + call mpi_recv(dat,size(dat),psb_mpi_mpk_,src,psb_int4_tag,ictxt,status,info) + call psb_test_nodes(psb_mesg_queue) +#endif + + end subroutine psb_mrcvv + + subroutine psb_mrcvm(ictxt,dat,src,m) + use psi_comm_buffers_mod + +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + integer(psb_mpk_), intent(out) :: dat(:,:) + integer(psb_mpk_), intent(in) :: src + integer(psb_ipk_), intent(in), optional :: m + integer(psb_mpk_), allocatable :: dat_(:) + integer(psb_mpk_) :: info ,m_,n_, ld, mp_rcv_type + integer(psb_mpk_) :: i,j,k + integer(psb_mpk_) :: status(mpi_status_size) +#if defined(SERIAL_MPI) + ! What should we do here?? +#else + if (present(m)) then + m_ = m + ld = size(dat,1) + n_ = size(dat,2) + call mpi_type_vector(n_,m_,ld,psb_mpi_mpk_,mp_rcv_type,info) + if (info == mpi_success) call mpi_type_commit(mp_rcv_type,info) + if (info == mpi_success) call mpi_recv(dat,1,mp_rcv_type,src,& + & psb_int4_tag,ictxt,status,info) + if (info == mpi_success) call mpi_type_free(mp_rcv_type,info) + else + call mpi_recv(dat,size(dat),psb_mpi_mpk_,src,psb_int4_tag,ictxt,status,info) + end if + if (info /= mpi_success) then + write(psb_err_unit,*) 'Error in psb_recv', info + end if + call psb_test_nodes(psb_mesg_queue) +#endif + end subroutine psb_mrcvm + + + subroutine psb_msnds_ec(ictxt,dat,dst) + + integer(psb_epk_), intent(in) :: ictxt + integer(psb_mpk_), intent(in) :: dat + integer(psb_epk_), intent(in) :: dst + + integer(psb_mpk_) :: iictxt, idst + + iictxt = ictxt + idst = dst + call psb_snd(iictxt, dat, idst) + + end subroutine psb_msnds_ec + + subroutine psb_msndv_ec(ictxt,dat,dst) + + integer(psb_epk_), intent(in) :: ictxt + integer(psb_mpk_), intent(in) :: dat(:) + integer(psb_epk_), intent(in) :: dst + + integer(psb_mpk_) :: iictxt, idst + + iictxt = ictxt + idst = dst + call psb_snd(iictxt, dat, idst) + + end subroutine psb_msndv_ec + + subroutine psb_msndm_ec(ictxt,dat,dst,m) + + integer(psb_epk_), intent(in) :: ictxt + integer(psb_mpk_), intent(in) :: dat(:,:) + integer(psb_epk_), intent(in) :: dst + + integer(psb_mpk_) :: iictxt, idst + + iictxt = ictxt + idst = dst + call psb_snd(iictxt, dat, idst) + + end subroutine psb_msndm_ec + + subroutine psb_mrcvs_ec(ictxt,dat,src) + + integer(psb_epk_), intent(in) :: ictxt + integer(psb_mpk_), intent(out) :: dat + integer(psb_epk_), intent(in) :: src + + integer(psb_mpk_) :: iictxt, isrc + + iictxt = ictxt + isrc = src + call psb_rcv(iictxt, dat, isrc) + + end subroutine psb_mrcvs_ec + + subroutine psb_mrcvv_ec(ictxt,dat,src) + + integer(psb_epk_), intent(in) :: ictxt + integer(psb_mpk_), intent(out) :: dat(:) + integer(psb_epk_), intent(in) :: src + + integer(psb_mpk_) :: iictxt, isrc + + iictxt = ictxt + isrc = src + call psb_rcv(iictxt, dat, isrc) + + end subroutine psb_mrcvv_ec + + subroutine psb_mrcvm_ec(ictxt,dat,src,m) + + integer(psb_epk_), intent(in) :: ictxt + integer(psb_mpk_), intent(out) :: dat(:,:) + integer(psb_epk_), intent(in) :: src + + integer(psb_mpk_) :: iictxt, isrc + + iictxt = ictxt + isrc = src + call psb_rcv(iictxt, dat, isrc) + + end subroutine psb_mrcvm_ec + + +end module psi_m_p2p_mod diff --git a/base/modules/basics/psi_s_p2p_mod.F90 b/base/modules/basics/psi_s_p2p_mod.F90 new file mode 100644 index 000000000..91f4d7399 --- /dev/null +++ b/base/modules/basics/psi_s_p2p_mod.F90 @@ -0,0 +1,307 @@ +! +! Parallel Sparse BLAS version 3.5 +! (C) Copyright 2006-2018 +! Salvatore Filippone +! Alfredo Buttari +! +! Redistribution and use in source and binary forms, with or without +! modification, are permitted provided that the following conditions +! are met: +! 1. Redistributions of source code must retain the above copyright +! notice, this list of conditions and the following disclaimer. +! 2. Redistributions in binary form must reproduce the above copyright +! notice, this list of conditions, and the following disclaimer in the +! documentation and/or other materials provided with the distribution. +! 3. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific written permission. +! +! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS +! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +! POSSIBILITY OF SUCH DAMAGE. +! +! + +module psi_s_p2p_mod + use psi_penv_mod + use psi_comm_buffers_mod + + interface psb_snd + module procedure psb_ssnds, psb_ssndv, psb_ssndm, & + & psb_ssnds_ec, psb_ssndv_ec, psb_ssndm_ec + end interface + + interface psb_rcv + module procedure psb_srcvs, psb_srcvv, psb_srcvm, & + & psb_srcvs_ec, psb_srcvv_ec, psb_srcvm_ec + end interface + +contains + + subroutine psb_ssnds(ictxt,dat,dst) + use psi_comm_buffers_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + real(psb_spk_), intent(in) :: dat + integer(psb_mpk_), intent(in) :: dst + real(psb_spk_), allocatable :: dat_(:) + integer(psb_mpk_) :: info +#if defined(SERIAL_MPI) + ! do nothing +#else + allocate(dat_(1), stat=info) + dat_(1) = dat + call psi_snd(ictxt,psb_real_tag,dst,dat_,psb_mesg_queue) +#endif + end subroutine psb_ssnds + + subroutine psb_ssndv(ictxt,dat,dst) + use psi_comm_buffers_mod + +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + real(psb_spk_), intent(in) :: dat(:) + integer(psb_mpk_), intent(in) :: dst + real(psb_spk_), allocatable :: dat_(:) + integer(psb_mpk_) :: info + +#if defined(SERIAL_MPI) +#else + allocate(dat_(size(dat)), stat=info) + dat_(:) = dat(:) + call psi_snd(ictxt,psb_real_tag,dst,dat_,psb_mesg_queue) +#endif + + end subroutine psb_ssndv + + subroutine psb_ssndm(ictxt,dat,dst,m) + use psi_comm_buffers_mod + +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + real(psb_spk_), intent(in) :: dat(:,:) + integer(psb_mpk_), intent(in) :: dst + integer(psb_ipk_), intent(in), optional :: m + real(psb_spk_), allocatable :: dat_(:) + integer(psb_ipk_) :: i,j,k,m_,n_ + integer(psb_mpk_) :: info + +#if defined(SERIAL_MPI) +#else + if (present(m)) then + m_ = m + else + m_ = size(dat,1) + end if + n_ = size(dat,2) + allocate(dat_(m_*n_), stat=info) + k=1 + do j=1,n_ + do i=1, m_ + dat_(k) = dat(i,j) + k = k + 1 + end do + end do + call psi_snd(ictxt,psb_real_tag,dst,dat_,psb_mesg_queue) +#endif + end subroutine psb_ssndm + + subroutine psb_srcvs(ictxt,dat,src) + use psi_comm_buffers_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + real(psb_spk_), intent(out) :: dat + integer(psb_mpk_), intent(in) :: src + integer(psb_mpk_) :: info + integer(psb_mpk_) :: status(mpi_status_size) +#if defined(SERIAL_MPI) + ! do nothing +#else + call mpi_recv(dat,1,psb_mpi_r_spk_,src,psb_real_tag,ictxt,status,info) + call psb_test_nodes(psb_mesg_queue) +#endif + end subroutine psb_srcvs + + subroutine psb_srcvv(ictxt,dat,src) + use psi_comm_buffers_mod + +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + real(psb_spk_), intent(out) :: dat(:) + integer(psb_mpk_), intent(in) :: src + real(psb_spk_), allocatable :: dat_(:) + integer(psb_mpk_) :: info + integer(psb_mpk_) :: status(mpi_status_size) +#if defined(SERIAL_MPI) +#else + call mpi_recv(dat,size(dat),psb_mpi_r_spk_,src,psb_real_tag,ictxt,status,info) + call psb_test_nodes(psb_mesg_queue) +#endif + + end subroutine psb_srcvv + + subroutine psb_srcvm(ictxt,dat,src,m) + use psi_comm_buffers_mod + +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + real(psb_spk_), intent(out) :: dat(:,:) + integer(psb_mpk_), intent(in) :: src + integer(psb_ipk_), intent(in), optional :: m + real(psb_spk_), allocatable :: dat_(:) + integer(psb_mpk_) :: info ,m_,n_, ld, mp_rcv_type + integer(psb_mpk_) :: i,j,k + integer(psb_mpk_) :: status(mpi_status_size) +#if defined(SERIAL_MPI) + ! What should we do here?? +#else + if (present(m)) then + m_ = m + ld = size(dat,1) + n_ = size(dat,2) + 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_recv(dat,1,mp_rcv_type,src,& + & psb_real_tag,ictxt,status,info) + if (info == mpi_success) call mpi_type_free(mp_rcv_type,info) + else + call mpi_recv(dat,size(dat),psb_mpi_r_spk_,src,psb_real_tag,ictxt,status,info) + end if + if (info /= mpi_success) then + write(psb_err_unit,*) 'Error in psb_recv', info + end if + call psb_test_nodes(psb_mesg_queue) +#endif + end subroutine psb_srcvm + + + subroutine psb_ssnds_ec(ictxt,dat,dst) + + integer(psb_epk_), intent(in) :: ictxt + real(psb_spk_), intent(in) :: dat + integer(psb_epk_), intent(in) :: dst + + integer(psb_mpk_) :: iictxt, idst + + iictxt = ictxt + idst = dst + call psb_snd(iictxt, dat, idst) + + end subroutine psb_ssnds_ec + + subroutine psb_ssndv_ec(ictxt,dat,dst) + + integer(psb_epk_), intent(in) :: ictxt + real(psb_spk_), intent(in) :: dat(:) + integer(psb_epk_), intent(in) :: dst + + integer(psb_mpk_) :: iictxt, idst + + iictxt = ictxt + idst = dst + call psb_snd(iictxt, dat, idst) + + end subroutine psb_ssndv_ec + + subroutine psb_ssndm_ec(ictxt,dat,dst,m) + + integer(psb_epk_), intent(in) :: ictxt + real(psb_spk_), intent(in) :: dat(:,:) + integer(psb_epk_), intent(in) :: dst + + integer(psb_mpk_) :: iictxt, idst + + iictxt = ictxt + idst = dst + call psb_snd(iictxt, dat, idst) + + end subroutine psb_ssndm_ec + + subroutine psb_srcvs_ec(ictxt,dat,src) + + integer(psb_epk_), intent(in) :: ictxt + real(psb_spk_), intent(out) :: dat + integer(psb_epk_), intent(in) :: src + + integer(psb_mpk_) :: iictxt, isrc + + iictxt = ictxt + isrc = src + call psb_rcv(iictxt, dat, isrc) + + end subroutine psb_srcvs_ec + + subroutine psb_srcvv_ec(ictxt,dat,src) + + integer(psb_epk_), intent(in) :: ictxt + real(psb_spk_), intent(out) :: dat(:) + integer(psb_epk_), intent(in) :: src + + integer(psb_mpk_) :: iictxt, isrc + + iictxt = ictxt + isrc = src + call psb_rcv(iictxt, dat, isrc) + + end subroutine psb_srcvv_ec + + subroutine psb_srcvm_ec(ictxt,dat,src,m) + + integer(psb_epk_), intent(in) :: ictxt + real(psb_spk_), intent(out) :: dat(:,:) + integer(psb_epk_), intent(in) :: src + + integer(psb_mpk_) :: iictxt, isrc + + iictxt = ictxt + isrc = src + call psb_rcv(iictxt, dat, isrc) + + end subroutine psb_srcvm_ec + + +end module psi_s_p2p_mod diff --git a/base/modules/basics/psi_z_p2p_mod.F90 b/base/modules/basics/psi_z_p2p_mod.F90 new file mode 100644 index 000000000..b72b0ae6a --- /dev/null +++ b/base/modules/basics/psi_z_p2p_mod.F90 @@ -0,0 +1,307 @@ +! +! Parallel Sparse BLAS version 3.5 +! (C) Copyright 2006-2018 +! Salvatore Filippone +! Alfredo Buttari +! +! Redistribution and use in source and binary forms, with or without +! modification, are permitted provided that the following conditions +! are met: +! 1. Redistributions of source code must retain the above copyright +! notice, this list of conditions and the following disclaimer. +! 2. Redistributions in binary form must reproduce the above copyright +! notice, this list of conditions, and the following disclaimer in the +! documentation and/or other materials provided with the distribution. +! 3. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific written permission. +! +! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS +! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +! POSSIBILITY OF SUCH DAMAGE. +! +! + +module psi_z_p2p_mod + use psi_penv_mod + use psi_comm_buffers_mod + + interface psb_snd + module procedure psb_zsnds, psb_zsndv, psb_zsndm, & + & psb_zsnds_ec, psb_zsndv_ec, psb_zsndm_ec + end interface + + interface psb_rcv + module procedure psb_zrcvs, psb_zrcvv, psb_zrcvm, & + & psb_zrcvs_ec, psb_zrcvv_ec, psb_zrcvm_ec + end interface + +contains + + subroutine psb_zsnds(ictxt,dat,dst) + use psi_comm_buffers_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + complex(psb_dpk_), intent(in) :: dat + integer(psb_mpk_), intent(in) :: dst + complex(psb_dpk_), allocatable :: dat_(:) + integer(psb_mpk_) :: info +#if defined(SERIAL_MPI) + ! do nothing +#else + allocate(dat_(1), stat=info) + dat_(1) = dat + call psi_snd(ictxt,psb_dcomplex_tag,dst,dat_,psb_mesg_queue) +#endif + end subroutine psb_zsnds + + subroutine psb_zsndv(ictxt,dat,dst) + use psi_comm_buffers_mod + +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + complex(psb_dpk_), intent(in) :: dat(:) + integer(psb_mpk_), intent(in) :: dst + complex(psb_dpk_), allocatable :: dat_(:) + integer(psb_mpk_) :: info + +#if defined(SERIAL_MPI) +#else + allocate(dat_(size(dat)), stat=info) + dat_(:) = dat(:) + call psi_snd(ictxt,psb_dcomplex_tag,dst,dat_,psb_mesg_queue) +#endif + + end subroutine psb_zsndv + + subroutine psb_zsndm(ictxt,dat,dst,m) + use psi_comm_buffers_mod + +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + complex(psb_dpk_), intent(in) :: dat(:,:) + integer(psb_mpk_), intent(in) :: dst + integer(psb_ipk_), intent(in), optional :: m + complex(psb_dpk_), allocatable :: dat_(:) + integer(psb_ipk_) :: i,j,k,m_,n_ + integer(psb_mpk_) :: info + +#if defined(SERIAL_MPI) +#else + if (present(m)) then + m_ = m + else + m_ = size(dat,1) + end if + n_ = size(dat,2) + allocate(dat_(m_*n_), stat=info) + k=1 + do j=1,n_ + do i=1, m_ + dat_(k) = dat(i,j) + k = k + 1 + end do + end do + call psi_snd(ictxt,psb_dcomplex_tag,dst,dat_,psb_mesg_queue) +#endif + end subroutine psb_zsndm + + subroutine psb_zrcvs(ictxt,dat,src) + use psi_comm_buffers_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + complex(psb_dpk_), intent(out) :: dat + integer(psb_mpk_), intent(in) :: src + integer(psb_mpk_) :: info + integer(psb_mpk_) :: status(mpi_status_size) +#if defined(SERIAL_MPI) + ! do nothing +#else + call mpi_recv(dat,1,psb_mpi_c_dpk_,src,psb_dcomplex_tag,ictxt,status,info) + call psb_test_nodes(psb_mesg_queue) +#endif + end subroutine psb_zrcvs + + subroutine psb_zrcvv(ictxt,dat,src) + use psi_comm_buffers_mod + +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + complex(psb_dpk_), intent(out) :: dat(:) + integer(psb_mpk_), intent(in) :: src + complex(psb_dpk_), allocatable :: dat_(:) + integer(psb_mpk_) :: info + integer(psb_mpk_) :: status(mpi_status_size) +#if defined(SERIAL_MPI) +#else + call mpi_recv(dat,size(dat),psb_mpi_c_dpk_,src,psb_dcomplex_tag,ictxt,status,info) + call psb_test_nodes(psb_mesg_queue) +#endif + + end subroutine psb_zrcvv + + subroutine psb_zrcvm(ictxt,dat,src,m) + use psi_comm_buffers_mod + +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpk_), intent(in) :: ictxt + complex(psb_dpk_), intent(out) :: dat(:,:) + integer(psb_mpk_), intent(in) :: src + integer(psb_ipk_), intent(in), optional :: m + complex(psb_dpk_), allocatable :: dat_(:) + integer(psb_mpk_) :: info ,m_,n_, ld, mp_rcv_type + integer(psb_mpk_) :: i,j,k + integer(psb_mpk_) :: status(mpi_status_size) +#if defined(SERIAL_MPI) + ! What should we do here?? +#else + if (present(m)) then + m_ = m + ld = size(dat,1) + n_ = size(dat,2) + 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_recv(dat,1,mp_rcv_type,src,& + & psb_dcomplex_tag,ictxt,status,info) + if (info == mpi_success) call mpi_type_free(mp_rcv_type,info) + else + call mpi_recv(dat,size(dat),psb_mpi_c_dpk_,src,psb_dcomplex_tag,ictxt,status,info) + end if + if (info /= mpi_success) then + write(psb_err_unit,*) 'Error in psb_recv', info + end if + call psb_test_nodes(psb_mesg_queue) +#endif + end subroutine psb_zrcvm + + + subroutine psb_zsnds_ec(ictxt,dat,dst) + + integer(psb_epk_), intent(in) :: ictxt + complex(psb_dpk_), intent(in) :: dat + integer(psb_epk_), intent(in) :: dst + + integer(psb_mpk_) :: iictxt, idst + + iictxt = ictxt + idst = dst + call psb_snd(iictxt, dat, idst) + + end subroutine psb_zsnds_ec + + subroutine psb_zsndv_ec(ictxt,dat,dst) + + integer(psb_epk_), intent(in) :: ictxt + complex(psb_dpk_), intent(in) :: dat(:) + integer(psb_epk_), intent(in) :: dst + + integer(psb_mpk_) :: iictxt, idst + + iictxt = ictxt + idst = dst + call psb_snd(iictxt, dat, idst) + + end subroutine psb_zsndv_ec + + subroutine psb_zsndm_ec(ictxt,dat,dst,m) + + integer(psb_epk_), intent(in) :: ictxt + complex(psb_dpk_), intent(in) :: dat(:,:) + integer(psb_epk_), intent(in) :: dst + + integer(psb_mpk_) :: iictxt, idst + + iictxt = ictxt + idst = dst + call psb_snd(iictxt, dat, idst) + + end subroutine psb_zsndm_ec + + subroutine psb_zrcvs_ec(ictxt,dat,src) + + integer(psb_epk_), intent(in) :: ictxt + complex(psb_dpk_), intent(out) :: dat + integer(psb_epk_), intent(in) :: src + + integer(psb_mpk_) :: iictxt, isrc + + iictxt = ictxt + isrc = src + call psb_rcv(iictxt, dat, isrc) + + end subroutine psb_zrcvs_ec + + subroutine psb_zrcvv_ec(ictxt,dat,src) + + integer(psb_epk_), intent(in) :: ictxt + complex(psb_dpk_), intent(out) :: dat(:) + integer(psb_epk_), intent(in) :: src + + integer(psb_mpk_) :: iictxt, isrc + + iictxt = ictxt + isrc = src + call psb_rcv(iictxt, dat, isrc) + + end subroutine psb_zrcvv_ec + + subroutine psb_zrcvm_ec(ictxt,dat,src,m) + + integer(psb_epk_), intent(in) :: ictxt + complex(psb_dpk_), intent(out) :: dat(:,:) + integer(psb_epk_), intent(in) :: src + + integer(psb_mpk_) :: iictxt, isrc + + iictxt = ictxt + isrc = src + call psb_rcv(iictxt, dat, isrc) + + end subroutine psb_zrcvm_ec + + +end module psi_z_p2p_mod diff --git a/base/modules/psb_const_mod.F90 b/base/modules/psb_const_mod.F90 index 238aef5d3..739f9a403 100644 --- a/base/modules/psb_const_mod.F90 +++ b/base/modules/psb_const_mod.F90 @@ -111,11 +111,11 @@ module psb_const_mod ! ! Integer type identifiers for MPI operations. ! - integer(psb_mpk_), save :: psb_mpi_i2pk_int - integer(psb_mpk_), save :: psb_mpi_epk_int - integer(psb_mpk_), save :: psb_mpi_mpk_int - integer(psb_mpk_), save :: psb_mpi_ipk_int - integer(psb_mpk_), save :: psb_mpi_lpk_int + integer(psb_mpk_), save :: psb_mpi_i2pk_ + integer(psb_mpk_), save :: psb_mpi_epk_ + integer(psb_mpk_), save :: psb_mpi_mpk_ + integer(psb_mpk_), save :: psb_mpi_ipk_ + integer(psb_mpk_), save :: psb_mpi_lpk_ integer(psb_mpk_), save :: psb_mpi_r_spk_ integer(psb_mpk_), save :: psb_mpi_r_dpk_ integer(psb_mpk_), save :: psb_mpi_c_spk_ diff --git a/base/modules/psi_bcast_mod.F90 b/base/modules/psi_bcast_mod.F90 index 707e12b3a..1e0486244 100644 --- a/base/modules/psi_bcast_mod.F90 +++ b/base/modules/psi_bcast_mod.F90 @@ -91,7 +91,7 @@ contains endif call psb_info(ictxt,iam,np) - call mpi_bcast(dat,1,psb_mpi_ipk_int,root_,ictxt,info) + call mpi_bcast(dat,1,psb_mpi_ipk_,root_,ictxt,info) #endif end subroutine psb_ibcasts @@ -116,7 +116,7 @@ contains endif call psb_info(ictxt,iam,np) - call mpi_bcast(dat,size(dat),psb_mpi_ipk_int,root_,ictxt,info) + call mpi_bcast(dat,size(dat),psb_mpi_ipk_,root_,ictxt,info) #endif end subroutine psb_ibcastv @@ -142,7 +142,7 @@ contains endif call psb_info(ictxt,iam,np) - call mpi_bcast(dat,size(dat),psb_mpi_ipk_int,root_,ictxt,info) + call mpi_bcast(dat,size(dat),psb_mpi_ipk_,root_,ictxt,info) #endif end subroutine psb_ibcastm @@ -608,7 +608,7 @@ contains endif call psb_info(ictxt,iam,np) - call mpi_bcast(dat,1,psb_mpi_lpk_int,root_,ictxt,info) + call mpi_bcast(dat,1,psb_mpi_lpk_,root_,ictxt,info) #endif end subroutine psb_i8bcasts @@ -633,7 +633,7 @@ contains endif call psb_info(ictxt,iam,np) - call mpi_bcast(dat,size(dat),psb_mpi_lpk_int,root_,ictxt,info) + call mpi_bcast(dat,size(dat),psb_mpi_lpk_,root_,ictxt,info) #endif end subroutine psb_i8bcastv @@ -659,7 +659,7 @@ contains endif call psb_info(ictxt,iam,np) - call mpi_bcast(dat,size(dat),psb_mpi_lpk_int,root_,ictxt,info) + call mpi_bcast(dat,size(dat),psb_mpi_lpk_,root_,ictxt,info) #endif end subroutine psb_i8bcastm diff --git a/base/modules/psi_comm_buffers_mod.F90 b/base/modules/psi_comm_buffers_mod.F90 index 2d44dc723..8619f99de 100644 --- a/base/modules/psi_comm_buffers_mod.F90 +++ b/base/modules/psi_comm_buffers_mod.F90 @@ -312,7 +312,7 @@ contains write(psb_err_unit,*) 'Fatal memory error inside communication subsystem' return end if - call mpi_isend(node%intbuf,size(node%intbuf),psb_mpi_mpk_int,& + call mpi_isend(node%intbuf,size(node%intbuf),psb_mpi_mpk_,& & dest,tag,icontxt,node%request,minfo) info = minfo call psb_insert_node(mesg_queue,node) @@ -349,7 +349,7 @@ contains write(psb_err_unit,*) 'Fatal memory error inside communication subsystem' return end if - call mpi_isend(node%int8buf,size(node%int8buf),psb_mpi_epk_int,& + call mpi_isend(node%int8buf,size(node%int8buf),psb_mpi_epk_,& & dest,tag,icontxt,node%request,minfo) info = minfo call psb_insert_node(mesg_queue,node) @@ -385,7 +385,7 @@ contains write(psb_err_unit,*) 'Fatal memory error inside communication subsystem' return end if - call mpi_isend(node%int2buf,size(node%int2buf),psb_mpi_i2pk_int,& + call mpi_isend(node%int2buf,size(node%int2buf),psb_mpi_i2pk_,& & dest,tag,icontxt,node%request,minfo) info = minfo call psb_insert_node(mesg_queue,node) diff --git a/base/modules/psi_p2p_mod.F90 b/base/modules/psi_p2p_mod.F90 index 2d95fc13d..ca5a9fbc6 100644 --- a/base/modules/psi_p2p_mod.F90 +++ b/base/modules/psi_p2p_mod.F90 @@ -34,80 +34,30 @@ module psi_p2p_mod use psi_penv_mod use psi_comm_buffers_mod - interface psb_snd - module procedure psb_isnds, psb_isndv, psb_isndm, & - & psb_ssnds, psb_ssndv, psb_ssndm,& - & psb_dsnds, psb_dsndv, psb_dsndm,& - & psb_csnds, psb_csndv, psb_csndm,& - & psb_zsnds, psb_zsndv, psb_zsndm,& - & psb_lsnds, psb_lsndv, psb_lsndm,& - & psb_hsnds - end interface - - interface psb_rcv - module procedure psb_ircvs, psb_ircvv, psb_ircvm, & - & psb_srcvs, psb_srcvv, psb_srcvm,& - & psb_drcvs, psb_drcvv, psb_drcvm,& - & psb_crcvs, psb_crcvv, psb_crcvm,& - & psb_zrcvs, psb_zrcvv, psb_zrcvm,& - & psb_lrcvs, psb_lrcvv, psb_lrcvm,& - & psb_hrcvs - end interface - - -#if defined(LONG_INTEGERS) - interface psb_snd - module procedure psb_i4snds, psb_i4sndv, psb_i4sndm - end interface - - interface psb_rcv - module procedure psb_i4rcvs, psb_i4rcvv, psb_i4rcvm - end interface -#endif - -#if !defined(LONG_INTEGERS) - interface psb_snd - module procedure psb_i8snds, psb_i8sndv, psb_i8sndm - end interface + use psi_m_p2p_mod + use psi_e_p2p_mod + use psi_s_p2p_mod + use psi_d_p2p_mod + use psi_c_p2p_mod + use psi_z_p2p_mod - interface psb_rcv - module procedure psb_i8rcvs, psb_i8rcvv, psb_i8rcvm - end interface -#endif - -#if defined(SHORT_INTEGERS) - interface psb_snd - module procedure psb_i2snds, psb_i2sndv, psb_i2sndm - end interface - - interface psb_rcv - module procedure psb_i2rcvs, psb_i2rcvv, psb_i2rcvm - end interface -#endif - -#if defined(LONG_INTEGERS) + ! + ! Add interfaces for + ! LOGICAL scalar/vector/matrix + ! CHARACTER scalar (use H prefix as in old style Hollerith) + ! interface psb_snd - module procedure psb_isnds_ic, psb_isndv_ic, psb_isndm_ic, & - & psb_ssnds_ic, psb_ssndv_ic, psb_ssndm_ic,& - & psb_dsnds_ic, psb_dsndv_ic, psb_dsndm_ic,& - & psb_csnds_ic, psb_csndv_ic, psb_csndm_ic,& - & psb_zsnds_ic, psb_zsndv_ic, psb_zsndm_ic,& - & psb_lsnds_ic, psb_lsndv_ic, & - & psb_lsndm_ic, psb_hsnds_ic + module procedure psb_lsnds, psb_lsndv, psb_lsndm,& + & psb_hsnds, psb_lsnds_ec, psb_lsndv_ec, & + & psb_lsndm_ec, psb_hsnds_ec end interface - interface psb_rcv - module procedure psb_ircvs_ic, psb_ircvv_ic, psb_ircvm_ic, & - & psb_srcvs_ic, psb_srcvv_ic, psb_srcvm_ic,& - & psb_drcvs_ic, psb_drcvv_ic, psb_drcvm_ic,& - & psb_crcvs_ic, psb_crcvv_ic, psb_crcvm_ic,& - & psb_zrcvs_ic, psb_zrcvv_ic, psb_zrcvm_ic,& - & psb_lrcvs_ic, psb_lrcvv_ic, & - & psb_lrcvm_ic, psb_hrcvs_ic + module procedure psb_lrcvs, psb_lrcvv, psb_lrcvm,& + & psb_hrcvs, psb_lrcvs_ec, psb_lrcvv_ec, & + & psb_lrcvm_ec, psb_hrcvs_ec end interface -#endif contains @@ -118,7 +68,7 @@ contains ! ! !!!!!!!!!!!!!!!!!!!!!!!! - subroutine psb_isnds(ictxt,dat,dst) + subroutine psb_lsnds(ictxt,dat,dst) use psi_comm_buffers_mod #ifdef MPI_MOD use mpi @@ -128,20 +78,20 @@ contains include 'mpif.h' #endif integer(psb_mpk_), intent(in) :: ictxt - integer(psb_ipk_), intent(in) :: dat + logical, intent(in) :: dat integer(psb_mpk_), intent(in) :: dst - integer(psb_ipk_), allocatable :: dat_(:) + logical, allocatable :: dat_(:) integer(psb_mpk_) :: info #if defined(SERIAL_MPI) ! do nothing #else allocate(dat_(1), stat=info) dat_(1) = dat - call psi_snd(ictxt,psb_int_tag,dst,dat_,psb_mesg_queue) + call psi_snd(ictxt,psb_logical_tag,dst,dat_,psb_mesg_queue) #endif - end subroutine psb_isnds + end subroutine psb_lsnds - subroutine psb_isndv(ictxt,dat,dst) + subroutine psb_lsndv(ictxt,dat,dst) use psi_comm_buffers_mod #ifdef MPI_MOD @@ -152,21 +102,21 @@ contains include 'mpif.h' #endif integer(psb_mpk_), intent(in) :: ictxt - integer(psb_ipk_), intent(in) :: dat(:) + logical, intent(in) :: dat(:) integer(psb_mpk_), intent(in) :: dst - integer(psb_ipk_), allocatable :: dat_(:) + logical, allocatable :: dat_(:) integer(psb_mpk_) :: info #if defined(SERIAL_MPI) #else allocate(dat_(size(dat)), stat=info) dat_(:) = dat(:) - call psi_snd(ictxt,psb_int_tag,dst,dat_,psb_mesg_queue) + call psi_snd(ictxt,psb_logical_tag,dst,dat_,psb_mesg_queue) #endif - end subroutine psb_isndv + end subroutine psb_lsndv - subroutine psb_isndm(ictxt,dat,dst,m) + subroutine psb_lsndm(ictxt,dat,dst,m) use psi_comm_buffers_mod #ifdef MPI_MOD @@ -177,10 +127,10 @@ contains include 'mpif.h' #endif integer(psb_mpk_), intent(in) :: ictxt - integer(psb_ipk_), intent(in) :: dat(:,:) + logical, intent(in) :: dat(:,:) integer(psb_mpk_), intent(in) :: dst integer(psb_ipk_), intent(in), optional :: m - integer(psb_ipk_), allocatable :: dat_(:) + logical, allocatable :: dat_(:) integer(psb_mpk_) :: info integer(psb_ipk_) :: i,j,k,m_,n_ @@ -200,11 +150,11 @@ contains k = k + 1 end do end do - call psi_snd(ictxt,psb_int_tag,dst,dat_,psb_mesg_queue) + call psi_snd(ictxt,psb_logical_tag,dst,dat_,psb_mesg_queue) #endif - end subroutine psb_isndm + end subroutine psb_lsndm - subroutine psb_ssnds(ictxt,dat,dst) + subroutine psb_hsnds(ictxt,dat,dst) use psi_comm_buffers_mod #ifdef MPI_MOD use mpi @@ -214,84 +164,86 @@ contains include 'mpif.h' #endif integer(psb_mpk_), intent(in) :: ictxt - real(psb_spk_), intent(in) :: dat + character(len=*), intent(in) :: dat integer(psb_mpk_), intent(in) :: dst - real(psb_spk_), allocatable :: dat_(:) - integer(psb_mpk_) :: info + character(len=1), allocatable :: dat_(:) + integer(psb_mpk_) :: info, l, i #if defined(SERIAL_MPI) ! do nothing #else - allocate(dat_(1), stat=info) - dat_(1) = dat - call psi_snd(ictxt,psb_real_tag,dst,dat_,psb_mesg_queue) + l = len(dat) + allocate(dat_(l), stat=info) + do i=1, l + dat_(i) = dat(i:i) + end do + call psi_snd(ictxt,psb_char_tag,dst,dat_,psb_mesg_queue) #endif - end subroutine psb_ssnds + end subroutine psb_hsnds - subroutine psb_ssndv(ictxt,dat,dst) - use psi_comm_buffers_mod + subroutine psb_lsnds_ec(ictxt,dat,dst) + integer(psb_epk_), intent(in) :: ictxt + logical, intent(in) :: dat + integer(psb_epk_), intent(in) :: dst + + integer(psb_mpk_) :: iictxt, idst -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - real(psb_spk_), intent(in) :: dat(:) - integer(psb_mpk_), intent(in) :: dst - real(psb_spk_), allocatable :: dat_(:) - integer(psb_mpk_) :: info + iictxt = ictxt + idst = dst + call psb_snd(iictxt, dat, idst) -#if defined(SERIAL_MPI) -#else - allocate(dat_(size(dat)), stat=info) - dat_(:) = dat(:) - call psi_snd(ictxt,psb_real_tag,dst,dat_,psb_mesg_queue) -#endif + end subroutine psb_lsnds_ec - end subroutine psb_ssndv + subroutine psb_lsndv_ec(ictxt,dat,dst) - subroutine psb_ssndm(ictxt,dat,dst,m) - use psi_comm_buffers_mod + integer(psb_epk_), intent(in) :: ictxt + logical, intent(in) :: dat(:) + integer(psb_epk_), intent(in) :: dst + + integer(psb_mpk_) :: iictxt, idst -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - real(psb_spk_), intent(in) :: dat(:,:) - integer(psb_mpk_), intent(in) :: dst - integer(psb_ipk_), intent(in), optional :: m - real(psb_spk_), allocatable :: dat_(:) - integer(psb_ipk_) :: i,j,k,m_,n_ - integer(psb_mpk_) :: info + iictxt = ictxt + idst = dst + call psb_snd(iictxt, dat, idst) -#if defined(SERIAL_MPI) -#else - if (present(m)) then - m_ = m - else - m_ = size(dat,1) - end if - n_ = size(dat,2) - allocate(dat_(m_*n_), stat=info) - k=1 - do j=1,n_ - do i=1, m_ - dat_(k) = dat(i,j) - k = k + 1 - end do - end do - call psi_snd(ictxt,psb_real_tag,dst,dat_,psb_mesg_queue) -#endif - end subroutine psb_ssndm + end subroutine psb_lsndv_ec + + subroutine psb_lsndm_ec(ictxt,dat,dst,m) + + integer(psb_epk_), intent(in) :: ictxt + logical, intent(in) :: dat(:,:) + integer(psb_epk_), intent(in) :: dst + + integer(psb_mpk_) :: iictxt, idst + + iictxt = ictxt + idst = dst + call psb_snd(iictxt, dat, idst) + + end subroutine psb_lsndm_ec - subroutine psb_dsnds(ictxt,dat,dst) + subroutine psb_hsnds_ec(ictxt,dat,dst) + + integer(psb_epk_), intent(in) :: ictxt + character(len=*), intent(in) :: dat + integer(psb_epk_), intent(in) :: dst + + integer(psb_mpk_) :: iictxt, idst + + iictxt = ictxt + idst = dst + call psb_snd(iictxt, dat, idst) + + end subroutine psb_hsnds_ec + + + ! !!!!!!!!!!!!!!!!!!!!!!!! + ! + ! Point-to-point RCV + ! + ! !!!!!!!!!!!!!!!!!!!!!!!! + + subroutine psb_lrcvs(ictxt,dat,src) use psi_comm_buffers_mod #ifdef MPI_MOD use mpi @@ -301,20 +253,19 @@ contains include 'mpif.h' #endif integer(psb_mpk_), intent(in) :: ictxt - real(psb_dpk_), intent(in) :: dat - integer(psb_mpk_), intent(in) :: dst - real(psb_dpk_), allocatable :: dat_(:) + logical, intent(out) :: dat + integer(psb_mpk_), intent(in) :: src integer(psb_mpk_) :: info + integer(psb_mpk_) :: status(mpi_status_size) #if defined(SERIAL_MPI) ! do nothing #else - allocate(dat_(1), stat=info) - dat_(1) = dat - call psi_snd(ictxt,psb_double_tag,dst,dat_,psb_mesg_queue) + call mpi_recv(dat,1,mpi_logical,src,psb_logical_tag,ictxt,status,info) + call psb_test_nodes(psb_mesg_queue) #endif - end subroutine psb_dsnds + end subroutine psb_lrcvs - subroutine psb_dsndv(ictxt,dat,dst) + subroutine psb_lrcvv(ictxt,dat,src) use psi_comm_buffers_mod #ifdef MPI_MOD @@ -325,21 +276,19 @@ contains include 'mpif.h' #endif integer(psb_mpk_), intent(in) :: ictxt - real(psb_dpk_), intent(in) :: dat(:) - integer(psb_mpk_), intent(in) :: dst - real(psb_dpk_), allocatable :: dat_(:) + logical, intent(out) :: dat(:) + integer(psb_mpk_), intent(in) :: src integer(psb_mpk_) :: info - + integer(psb_mpk_) :: status(mpi_status_size) #if defined(SERIAL_MPI) #else - allocate(dat_(size(dat)), stat=info) - dat_(:) = dat(:) - call psi_snd(ictxt,psb_double_tag,dst,dat_,psb_mesg_queue) + call mpi_recv(dat,size(dat),mpi_logical,src,psb_logical_tag,ictxt,status,info) + call psb_test_nodes(psb_mesg_queue) #endif - end subroutine psb_dsndv + end subroutine psb_lrcvv - subroutine psb_dsndm(ictxt,dat,dst,m) + subroutine psb_lrcvm(ictxt,dat,src,m) use psi_comm_buffers_mod #ifdef MPI_MOD @@ -350,35 +299,37 @@ contains include 'mpif.h' #endif integer(psb_mpk_), intent(in) :: ictxt - real(psb_dpk_), intent(in) :: dat(:,:) - integer(psb_mpk_), intent(in) :: dst + logical, intent(out) :: dat(:,:) + integer(psb_mpk_), intent(in) :: src integer(psb_ipk_), intent(in), optional :: m - real(psb_dpk_), allocatable :: dat_(:) - integer(psb_mpk_) :: info - integer(psb_ipk_) :: i,j,k,m_,n_ - + integer(psb_mpk_) :: info ,m_,n_, ld, mp_rcv_type + integer(psb_ipk_) :: i,j,k + integer(psb_mpk_) :: status(mpi_status_size) #if defined(SERIAL_MPI) + ! What should we do here?? #else if (present(m)) then m_ = m + ld = size(dat,1) + n_ = size(dat,2) + call mpi_type_vector(n_,m_,ld,mpi_logical,mp_rcv_type,info) + if (info == mpi_success) call mpi_type_commit(mp_rcv_type,info) + if (info == mpi_success) call mpi_recv(dat,1,mp_rcv_type,src,& + & psb_logical_tag,ictxt,status,info) + if (info == mpi_success) call mpi_type_free(mp_rcv_type,info) else - m_ = size(dat,1) + call mpi_recv(dat,size(dat),mpi_logical,src,& + & psb_logical_tag,ictxt,status,info) end if - n_ = size(dat,2) - allocate(dat_(m_*n_), stat=info) - k=1 - do j=1,n_ - do i=1, m_ - dat_(k) = dat(i,j) - k = k + 1 - end do - end do - call psi_snd(ictxt,psb_double_tag,dst,dat_,psb_mesg_queue) + if (info /= mpi_success) then + write(psb_err_unit,*) 'Error in psb_recv', info + end if + call psb_test_nodes(psb_mesg_queue) #endif - end subroutine psb_dsndm + end subroutine psb_lrcvm - subroutine psb_csnds(ictxt,dat,dst) + subroutine psb_hrcvs(ictxt,dat,src) use psi_comm_buffers_mod #ifdef MPI_MOD use mpi @@ -388,1912 +339,58 @@ contains include 'mpif.h' #endif integer(psb_mpk_), intent(in) :: ictxt - complex(psb_spk_), intent(in) :: dat - integer(psb_mpk_), intent(in) :: dst - complex(psb_spk_), allocatable :: dat_(:) - integer(psb_mpk_) :: info + character(len=*), intent(out) :: dat + integer(psb_mpk_), intent(in) :: src + character(len=1), allocatable :: dat_(:) + integer(psb_mpk_) :: info, l, i + integer(psb_mpk_) :: status(mpi_status_size) #if defined(SERIAL_MPI) ! do nothing #else - allocate(dat_(1), stat=info) - dat_(1) = dat - call psi_snd(ictxt,psb_complex_tag,dst,dat_,psb_mesg_queue) + l = len(dat) + allocate(dat_(l), stat=info) + call mpi_recv(dat_,l,mpi_character,src,psb_char_tag,ictxt,status,info) + call psb_test_nodes(psb_mesg_queue) + do i=1, l + dat(i:i) = dat_(i) + end do + deallocate(dat_) #endif - end subroutine psb_csnds + end subroutine psb_hrcvs - subroutine psb_csndv(ictxt,dat,dst) - use psi_comm_buffers_mod -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - complex(psb_spk_), intent(in) :: dat(:) - integer(psb_mpk_), intent(in) :: dst - complex(psb_spk_), allocatable :: dat_(:) - integer(psb_mpk_) :: info + subroutine psb_lrcvs_ec(ictxt,dat,src) + integer(psb_epk_), intent(in) :: ictxt + logical, intent(out) :: dat + integer(psb_epk_), intent(in) :: src + + integer(psb_mpk_) :: iictxt, isrc -#if defined(SERIAL_MPI) -#else - allocate(dat_(size(dat)), stat=info) - dat_(:) = dat(:) - call psi_snd(ictxt,psb_complex_tag,dst,dat_,psb_mesg_queue) -#endif + iictxt = ictxt + isrc = src + call psb_rcv(iictxt, dat, isrc) + + end subroutine psb_lrcvs_ec - end subroutine psb_csndv + subroutine psb_lrcvv_ec(ictxt,dat,src) - subroutine psb_csndm(ictxt,dat,dst,m) - use psi_comm_buffers_mod - -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - complex(psb_spk_), intent(in) :: dat(:,:) - integer(psb_mpk_), intent(in) :: dst - integer(psb_ipk_), intent(in), optional :: m - complex(psb_spk_), allocatable :: dat_(:) - integer(psb_mpk_) :: info - integer(psb_ipk_) :: i,j,k,m_,n_ - -#if defined(SERIAL_MPI) -#else - if (present(m)) then - m_ = m - else - m_ = size(dat,1) - end if - n_ = size(dat,2) - allocate(dat_(m_*n_), stat=info) - k=1 - do j=1,n_ - do i=1, m_ - dat_(k) = dat(i,j) - k = k + 1 - end do - end do - call psi_snd(ictxt,psb_complex_tag,dst,dat_,psb_mesg_queue) -#endif - end subroutine psb_csndm - - - subroutine psb_zsnds(ictxt,dat,dst) - use psi_comm_buffers_mod -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - complex(psb_dpk_), intent(in) :: dat - integer(psb_mpk_), intent(in) :: dst - complex(psb_dpk_), allocatable :: dat_(:) - integer(psb_mpk_) :: info -#if defined(SERIAL_MPI) - ! do nothing -#else - allocate(dat_(1), stat=info) - dat_(1) = dat - call psi_snd(ictxt,psb_dcomplex_tag,dst,dat_,psb_mesg_queue) -#endif - end subroutine psb_zsnds - - subroutine psb_zsndv(ictxt,dat,dst) - use psi_comm_buffers_mod - -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - complex(psb_dpk_), intent(in) :: dat(:) - integer(psb_mpk_), intent(in) :: dst - complex(psb_dpk_), allocatable :: dat_(:) - integer(psb_mpk_) :: info - -#if defined(SERIAL_MPI) -#else - allocate(dat_(size(dat)), stat=info) - dat_(:) = dat(:) - call psi_snd(ictxt,psb_dcomplex_tag,dst,dat_,psb_mesg_queue) -#endif - - end subroutine psb_zsndv - - subroutine psb_zsndm(ictxt,dat,dst,m) - use psi_comm_buffers_mod - -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - complex(psb_dpk_), intent(in) :: dat(:,:) - integer(psb_mpk_), intent(in) :: dst - integer(psb_ipk_), intent(in), optional :: m - complex(psb_dpk_), allocatable :: dat_(:) - integer(psb_mpk_) :: info - integer(psb_ipk_) :: i,j,k,m_,n_ - -#if defined(SERIAL_MPI) -#else - if (present(m)) then - m_ = m - else - m_ = size(dat,1) - end if - n_ = size(dat,2) - allocate(dat_(m_*n_), stat=info) - k=1 - do j=1,n_ - do i=1, m_ - dat_(k) = dat(i,j) - k = k + 1 - end do - end do - call psi_snd(ictxt,psb_dcomplex_tag,dst,dat_,psb_mesg_queue) -#endif - end subroutine psb_zsndm - - - subroutine psb_lsnds(ictxt,dat,dst) - use psi_comm_buffers_mod -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - logical, intent(in) :: dat - integer(psb_mpk_), intent(in) :: dst - logical, allocatable :: dat_(:) - integer(psb_mpk_) :: info -#if defined(SERIAL_MPI) - ! do nothing -#else - allocate(dat_(1), stat=info) - dat_(1) = dat - call psi_snd(ictxt,psb_logical_tag,dst,dat_,psb_mesg_queue) -#endif - end subroutine psb_lsnds - - subroutine psb_lsndv(ictxt,dat,dst) - use psi_comm_buffers_mod - -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - logical, intent(in) :: dat(:) - integer(psb_mpk_), intent(in) :: dst - logical, allocatable :: dat_(:) - integer(psb_mpk_) :: info - -#if defined(SERIAL_MPI) -#else - allocate(dat_(size(dat)), stat=info) - dat_(:) = dat(:) - call psi_snd(ictxt,psb_logical_tag,dst,dat_,psb_mesg_queue) -#endif - - end subroutine psb_lsndv - - subroutine psb_lsndm(ictxt,dat,dst,m) - use psi_comm_buffers_mod - -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - logical, intent(in) :: dat(:,:) - integer(psb_mpk_), intent(in) :: dst - integer(psb_ipk_), intent(in), optional :: m - logical, allocatable :: dat_(:) - integer(psb_mpk_) :: info - integer(psb_ipk_) :: i,j,k,m_,n_ - -#if defined(SERIAL_MPI) -#else - if (present(m)) then - m_ = m - else - m_ = size(dat,1) - end if - n_ = size(dat,2) - allocate(dat_(m_*n_), stat=info) - k=1 - do j=1,n_ - do i=1, m_ - dat_(k) = dat(i,j) - k = k + 1 - end do - end do - call psi_snd(ictxt,psb_logical_tag,dst,dat_,psb_mesg_queue) -#endif - end subroutine psb_lsndm - - - subroutine psb_hsnds(ictxt,dat,dst) - use psi_comm_buffers_mod -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - character(len=*), intent(in) :: dat - integer(psb_mpk_), intent(in) :: dst - character(len=1), allocatable :: dat_(:) - integer(psb_mpk_) :: info, l, i -#if defined(SERIAL_MPI) - ! do nothing -#else - l = len(dat) - allocate(dat_(l), stat=info) - do i=1, l - dat_(i) = dat(i:i) - end do - call psi_snd(ictxt,psb_char_tag,dst,dat_,psb_mesg_queue) -#endif - end subroutine psb_hsnds - -#if defined(LONG_INTEGERS) - subroutine psb_i4snds(ictxt,dat,dst) - use psi_comm_buffers_mod -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - integer(psb_mpk_), intent(in) :: dat - integer(psb_mpk_), intent(in) :: dst - integer(psb_mpk_), allocatable :: dat_(:) - integer(psb_mpk_) :: info -#if defined(SERIAL_MPI) - ! do nothing -#else - allocate(dat_(1), stat=info) - dat_(1) = dat - call psi_snd(ictxt,psb_int4_tag,dst,dat_,psb_mesg_queue) -#endif - end subroutine psb_i4snds - - subroutine psb_i4sndv(ictxt,dat,dst) - use psi_comm_buffers_mod - -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - integer(psb_mpk_), intent(in) :: dat(:) - integer(psb_mpk_), intent(in) :: dst - integer(psb_mpk_), allocatable :: dat_(:) - integer(psb_mpk_) :: info - -#if defined(SERIAL_MPI) -#else - allocate(dat_(size(dat)), stat=info) - dat_(:) = dat(:) - call psi_snd(ictxt,psb_int4_tag,dst,dat_,psb_mesg_queue) -#endif - - end subroutine psb_i4sndv - - subroutine psb_i4sndm(ictxt,dat,dst,m) - use psi_comm_buffers_mod - -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - integer(psb_mpk_), intent(in) :: dat(:,:) - integer(psb_mpk_), intent(in) :: dst - integer(psb_mpk_), intent(in), optional :: m - integer(psb_mpk_), allocatable :: dat_(:) - integer(psb_mpk_) :: info - integer(psb_mpk_) :: i,j,k,m_,n_ - -#if defined(SERIAL_MPI) -#else - if (present(m)) then - m_ = m - else - m_ = size(dat,1) - end if - n_ = size(dat,2) - allocate(dat_(m_*n_), stat=info) - k=1 - do j=1,n_ - do i=1, m_ - dat_(k) = dat(i,j) - k = k + 1 - end do - end do - call psi_snd(ictxt,psb_int4_tag,dst,dat_,psb_mesg_queue) -#endif - end subroutine psb_i4sndm - -#endif - - -#if !defined(LONG_INTEGERS) - subroutine psb_i8snds(ictxt,dat,dst) - use psi_comm_buffers_mod -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - integer(psb_epk_), intent(in) :: dat - integer(psb_mpk_), intent(in) :: dst - integer(psb_epk_), allocatable :: dat_(:) - integer(psb_mpk_) :: info -#if defined(SERIAL_MPI) - ! do nothing -#else - allocate(dat_(1), stat=info) - dat_(1) = dat - call psi_snd(ictxt,psb_int8_tag,dst,dat_,psb_mesg_queue) -#endif - end subroutine psb_i8snds - - subroutine psb_i8sndv(ictxt,dat,dst) - use psi_comm_buffers_mod - -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - integer(psb_epk_), intent(in) :: dat(:) - integer(psb_mpk_), intent(in) :: dst - integer(psb_epk_), allocatable :: dat_(:) - integer(psb_mpk_) :: info - -#if defined(SERIAL_MPI) -#else - allocate(dat_(size(dat)), stat=info) - dat_(:) = dat(:) - call psi_snd(ictxt,psb_int8_tag,dst,dat_,psb_mesg_queue) -#endif - - end subroutine psb_i8sndv - - subroutine psb_i8sndm(ictxt,dat,dst,m) - use psi_comm_buffers_mod - -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - integer(psb_epk_), intent(in) :: dat(:,:) - integer(psb_mpk_), intent(in) :: dst - integer(psb_ipk_), intent(in), optional :: m - integer(psb_epk_), allocatable :: dat_(:) - integer(psb_mpk_) :: info - integer(psb_ipk_) :: i,j,k,m_,n_ - -#if defined(SERIAL_MPI) -#else - if (present(m)) then - m_ = m - else - m_ = size(dat,1) - end if - n_ = size(dat,2) - allocate(dat_(m_*n_), stat=info) - k=1 - do j=1,n_ - do i=1, m_ - dat_(k) = dat(i,j) - k = k + 1 - end do - end do - call psi_snd(ictxt,psb_int8_tag,dst,dat_,psb_mesg_queue) -#endif - end subroutine psb_i8sndm - -#endif - - -#if defined(SHORT_INTEGERS) - subroutine psb_i2snds(ictxt,dat,dst) - use psi_comm_buffers_mod -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - integer(2), intent(in) :: dat - integer(psb_mpk_), intent(in) :: dst - integer(2), allocatable :: dat_(:) - integer(psb_mpk_) :: info -#if defined(SERIAL_MPI) - ! do nothing -#else - allocate(dat_(1), stat=info) - dat_(1) = dat - call psi_snd(ictxt,psb_int2_tag,dst,dat_,psb_mesg_queue) -#endif - end subroutine psb_i2snds - - subroutine psb_i2sndv(ictxt,dat,dst) - use psi_comm_buffers_mod - -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - integer(2), intent(in) :: dat(:) - integer(psb_mpk_), intent(in) :: dst - integer(2), allocatable :: dat_(:) - integer(psb_mpk_) :: info - -#if defined(SERIAL_MPI) -#else - allocate(dat_(size(dat)), stat=info) - dat_(:) = dat(:) - call psi_snd(ictxt,psb_int2_tag,dst,dat_,psb_mesg_queue) -#endif - - end subroutine psb_i2sndv - - subroutine psb_i2sndm(ictxt,dat,dst,m) - use psi_comm_buffers_mod - -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - integer(2), intent(in) :: dat(:,:) - integer(psb_mpk_), intent(in) :: dst - integer(psb_ipk_), intent(in), optional :: m - integer(2), allocatable :: dat_(:) - integer(psb_mpk_) :: info - integer(psb_ipk_) :: i,j,k,m_,n_ - -#if defined(SERIAL_MPI) -#else - if (present(m)) then - m_ = m - else - m_ = size(dat,1) - end if - n_ = size(dat,2) - allocate(dat_(m_*n_), stat=info) - k=1 - do j=1,n_ - do i=1, m_ - dat_(k) = dat(i,j) - k = k + 1 - end do - end do - call psi_snd(ictxt,psb_int2_tag,dst,dat_,psb_mesg_queue) -#endif - end subroutine psb_i2sndm - -#endif - - ! !!!!!!!!!!!!!!!!!!!!!!!! - ! - ! Point-to-point RCV - ! - ! !!!!!!!!!!!!!!!!!!!!!!!! - - subroutine psb_ircvs(ictxt,dat,src) - use psi_comm_buffers_mod -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - integer(psb_ipk_), intent(out) :: dat - integer(psb_mpk_), intent(in) :: src - integer(psb_mpk_) :: info - integer(psb_mpk_) :: status(mpi_status_size) -#if defined(SERIAL_MPI) - ! do nothing -#else - call mpi_recv(dat,1,psb_mpi_ipk_int,src,psb_int_tag,ictxt,status,info) - call psb_test_nodes(psb_mesg_queue) -#endif - end subroutine psb_ircvs - - subroutine psb_ircvv(ictxt,dat,src) - use psi_comm_buffers_mod - -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - integer(psb_ipk_), intent(out) :: dat(:) - integer(psb_mpk_), intent(in) :: src - integer(psb_ipk_), allocatable :: dat_(:) - integer(psb_mpk_) :: info - integer(psb_mpk_) :: status(mpi_status_size) -#if defined(SERIAL_MPI) -#else - call mpi_recv(dat,size(dat),psb_mpi_ipk_int,src,psb_int_tag,ictxt,status,info) - call psb_test_nodes(psb_mesg_queue) -#endif - - end subroutine psb_ircvv - - subroutine psb_ircvm(ictxt,dat,src,m) - use psi_comm_buffers_mod - -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - integer(psb_ipk_), intent(out) :: dat(:,:) - integer(psb_mpk_), intent(in) :: src - integer(psb_ipk_), intent(in), optional :: m - integer(psb_ipk_), allocatable :: dat_(:) - integer(psb_mpk_) :: info, m_,n_, ld, mp_rcv_type - integer(psb_ipk_) :: i,j,k - integer(psb_mpk_) :: status(mpi_status_size) -#if defined(SERIAL_MPI) - ! What should we do here?? -#else - if (present(m)) then - m_ = m - ld = size(dat,1) - n_ = size(dat,2) - call mpi_type_vector(n_,m_,ld,psb_mpi_ipk_int,mp_rcv_type,info) - if (info == mpi_success) call mpi_type_commit(mp_rcv_type,info) - if (info == mpi_success) call mpi_recv(dat,1,mp_rcv_type,src,& - & psb_int_tag,ictxt,status,info) - if (info == mpi_success) call mpi_type_free(mp_rcv_type,info) - else - call mpi_recv(dat,size(dat),psb_mpi_ipk_int,src,psb_int_tag,ictxt,status,info) - end if - if (info /= mpi_success) then - write(psb_err_unit,*) 'Error in psb_recv', info - end if - call psb_test_nodes(psb_mesg_queue) -#endif - end subroutine psb_ircvm - - - subroutine psb_srcvs(ictxt,dat,src) - use psi_comm_buffers_mod -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - real(psb_spk_), intent(out) :: dat - integer(psb_mpk_), intent(in) :: src - integer(psb_mpk_) :: info - integer(psb_mpk_) :: status(mpi_status_size) -#if defined(SERIAL_MPI) - ! do nothing -#else - call mpi_recv(dat,1,psb_mpi_r_spk_,src,psb_real_tag,ictxt,status,info) - call psb_test_nodes(psb_mesg_queue) -#endif - end subroutine psb_srcvs - - subroutine psb_srcvv(ictxt,dat,src) - use psi_comm_buffers_mod - -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - real(psb_spk_), intent(out) :: dat(:) - integer(psb_mpk_), intent(in) :: src - real(psb_spk_), allocatable :: dat_(:) - integer(psb_mpk_) :: info - integer(psb_mpk_) :: status(mpi_status_size) -#if defined(SERIAL_MPI) -#else - call mpi_recv(dat,size(dat),psb_mpi_r_spk_,src,psb_real_tag,ictxt,status,info) - call psb_test_nodes(psb_mesg_queue) -#endif - - end subroutine psb_srcvv - - subroutine psb_srcvm(ictxt,dat,src,m) - use psi_comm_buffers_mod - -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - real(psb_spk_), intent(out) :: dat(:,:) - integer(psb_mpk_), intent(in) :: src - integer(psb_ipk_), intent(in), optional :: m - real(psb_spk_), allocatable :: dat_(:) - integer(psb_mpk_) :: info ,m_,n_, ld, mp_rcv_type - integer(psb_mpk_) :: i,j,k - integer(psb_mpk_) :: status(mpi_status_size) -#if defined(SERIAL_MPI) - ! What should we do here?? -#else - if (present(m)) then - m_ = m - ld = size(dat,1) - n_ = size(dat,2) - 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_recv(dat,1,mp_rcv_type,src,& - & psb_real_tag,ictxt,status,info) - if (info == mpi_success) call mpi_type_free(mp_rcv_type,info) - else - call mpi_recv(dat,size(dat),psb_mpi_r_spk_,src,psb_real_tag,ictxt,status,info) - end if - if (info /= mpi_success) then - write(psb_err_unit,*) 'Error in psb_recv', info - end if - call psb_test_nodes(psb_mesg_queue) -#endif - end subroutine psb_srcvm - - - subroutine psb_drcvs(ictxt,dat,src) - use psi_comm_buffers_mod -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - real(psb_dpk_), intent(out) :: dat - integer(psb_mpk_), intent(in) :: src - integer(psb_mpk_) :: info - integer(psb_mpk_) :: status(mpi_status_size) -#if defined(SERIAL_MPI) - ! do nothing -#else - call mpi_recv(dat,1,psb_mpi_r_dpk_,src,psb_double_tag,ictxt,status,info) - call psb_test_nodes(psb_mesg_queue) -#endif - end subroutine psb_drcvs - - subroutine psb_drcvv(ictxt,dat,src) - use psi_comm_buffers_mod - -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - real(psb_dpk_), intent(out) :: dat(:) - integer(psb_mpk_), intent(in) :: src - real(psb_dpk_), allocatable :: dat_(:) - integer(psb_mpk_) :: info - integer(psb_mpk_) :: status(mpi_status_size) -#if defined(SERIAL_MPI) -#else - call mpi_recv(dat,size(dat),psb_mpi_r_dpk_,src,psb_double_tag,ictxt,status,info) - call psb_test_nodes(psb_mesg_queue) -#endif - - end subroutine psb_drcvv - - subroutine psb_drcvm(ictxt,dat,src,m) - use psi_comm_buffers_mod - -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - real(psb_dpk_), intent(out) :: dat(:,:) - integer(psb_mpk_), intent(in) :: src - integer(psb_mpk_), intent(in), optional :: m - real(psb_dpk_), allocatable :: dat_(:) - integer(psb_mpk_) :: info ,m_,n_, ld, mp_rcv_type - integer(psb_ipk_) :: i,j,k - integer(psb_mpk_) :: status(mpi_status_size) -#if defined(SERIAL_MPI) - ! What should we do here?? -#else - if (present(m)) then - m_ = m - ld = size(dat,1) - n_ = size(dat,2) - 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_recv(dat,1,mp_rcv_type,src,& - & psb_double_tag,ictxt,status,info) - if (info == mpi_success) call mpi_type_free(mp_rcv_type,info) - else - call mpi_recv(dat,size(dat),psb_mpi_r_dpk_,src,& - & psb_double_tag,ictxt,status,info) - end if - if (info /= mpi_success) then - write(psb_err_unit,*) 'Error in psb_recv', info - end if - call psb_test_nodes(psb_mesg_queue) -#endif - end subroutine psb_drcvm - - - subroutine psb_crcvs(ictxt,dat,src) - use psi_comm_buffers_mod -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - complex(psb_spk_), intent(out) :: dat - integer(psb_mpk_), intent(in) :: src - integer(psb_mpk_) :: info - integer(psb_mpk_) :: status(mpi_status_size) -#if defined(SERIAL_MPI) - ! do nothing -#else - call mpi_recv(dat,1,psb_mpi_c_spk_,src,psb_complex_tag,ictxt,status,info) - call psb_test_nodes(psb_mesg_queue) -#endif - end subroutine psb_crcvs - - subroutine psb_crcvv(ictxt,dat,src) - use psi_comm_buffers_mod - -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - complex(psb_spk_), intent(out) :: dat(:) - integer(psb_mpk_), intent(in) :: src - complex(psb_spk_), allocatable :: dat_(:) - integer(psb_mpk_) :: info - integer(psb_mpk_) :: status(mpi_status_size) -#if defined(SERIAL_MPI) -#else - call mpi_recv(dat,size(dat),psb_mpi_c_spk_,src,psb_complex_tag,ictxt,status,info) - call psb_test_nodes(psb_mesg_queue) -#endif - - end subroutine psb_crcvv - - subroutine psb_crcvm(ictxt,dat,src,m) - use psi_comm_buffers_mod - -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - complex(psb_spk_), intent(out) :: dat(:,:) - integer(psb_mpk_), intent(in) :: src - integer(psb_ipk_), intent(in), optional :: m - complex(psb_spk_), allocatable :: dat_(:) - integer(psb_mpk_) :: info ,m_,n_, ld, mp_rcv_type - integer(psb_ipk_) :: i,j,k - integer(psb_mpk_) :: status(mpi_status_size) -#if defined(SERIAL_MPI) - ! What should we do here?? -#else - if (present(m)) then - m_ = m - ld = size(dat,1) - n_ = size(dat,2) - 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_recv(dat,1,mp_rcv_type,src,& - & psb_complex_tag,ictxt,status,info) - if (info == mpi_success) call mpi_type_free(mp_rcv_type,info) - else - call mpi_recv(dat,size(dat),psb_mpi_c_spk_,src,& - & psb_complex_tag,ictxt,status,info) - end if - if (info /= mpi_success) then - write(psb_err_unit,*) 'Error in psb_recv', info - end if - call psb_test_nodes(psb_mesg_queue) -#endif - end subroutine psb_crcvm - - - subroutine psb_zrcvs(ictxt,dat,src) - use psi_comm_buffers_mod -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - complex(psb_dpk_), intent(out) :: dat - integer(psb_mpk_), intent(in) :: src - integer(psb_mpk_) :: info - integer(psb_mpk_) :: status(mpi_status_size) -#if defined(SERIAL_MPI) - ! do nothing -#else - call mpi_recv(dat,1,psb_mpi_c_dpk_,src,psb_dcomplex_tag,ictxt,status,info) - call psb_test_nodes(psb_mesg_queue) -#endif - end subroutine psb_zrcvs - - subroutine psb_zrcvv(ictxt,dat,src) - use psi_comm_buffers_mod - -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - complex(psb_dpk_), intent(out) :: dat(:) - integer(psb_mpk_), intent(in) :: src - complex(psb_dpk_), allocatable :: dat_(:) - integer(psb_mpk_) :: info - integer(psb_mpk_) :: status(mpi_status_size) -#if defined(SERIAL_MPI) -#else - call mpi_recv(dat,size(dat),psb_mpi_c_dpk_,src,psb_dcomplex_tag,ictxt,status,info) - call psb_test_nodes(psb_mesg_queue) -#endif - - end subroutine psb_zrcvv - - subroutine psb_zrcvm(ictxt,dat,src,m) - use psi_comm_buffers_mod - -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - complex(psb_dpk_), intent(out) :: dat(:,:) - integer(psb_mpk_), intent(in) :: src - integer(psb_ipk_), intent(in), optional :: m - complex(psb_dpk_), allocatable :: dat_(:) - integer(psb_mpk_) :: info ,m_,n_, ld, mp_rcv_type - integer(psb_ipk_) :: i,j,k - integer(psb_mpk_) :: status(mpi_status_size) -#if defined(SERIAL_MPI) - ! What should we do here?? -#else - if (present(m)) then - m_ = m - ld = size(dat,1) - n_ = size(dat,2) - 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_recv(dat,1,mp_rcv_type,src,& - & psb_dcomplex_tag,ictxt,status,info) - if (info == mpi_success) call mpi_type_free(mp_rcv_type,info) - else - call mpi_recv(dat,size(dat),psb_mpi_c_dpk_,src,& - & psb_dcomplex_tag,ictxt,status,info) - end if - if (info /= mpi_success) then - write(psb_err_unit,*) 'Error in psb_recv', info - end if - call psb_test_nodes(psb_mesg_queue) -#endif - end subroutine psb_zrcvm - - - subroutine psb_lrcvs(ictxt,dat,src) - use psi_comm_buffers_mod -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - logical, intent(out) :: dat - integer(psb_mpk_), intent(in) :: src - integer(psb_mpk_) :: info - integer(psb_mpk_) :: status(mpi_status_size) -#if defined(SERIAL_MPI) - ! do nothing -#else - call mpi_recv(dat,1,mpi_logical,src,psb_logical_tag,ictxt,status,info) - call psb_test_nodes(psb_mesg_queue) -#endif - end subroutine psb_lrcvs - - subroutine psb_lrcvv(ictxt,dat,src) - use psi_comm_buffers_mod - -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - logical, intent(out) :: dat(:) - integer(psb_mpk_), intent(in) :: src - integer(psb_mpk_) :: info - integer(psb_mpk_) :: status(mpi_status_size) -#if defined(SERIAL_MPI) -#else - call mpi_recv(dat,size(dat),mpi_logical,src,psb_logical_tag,ictxt,status,info) - call psb_test_nodes(psb_mesg_queue) -#endif - - end subroutine psb_lrcvv - - subroutine psb_lrcvm(ictxt,dat,src,m) - use psi_comm_buffers_mod - -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - logical, intent(out) :: dat(:,:) - integer(psb_mpk_), intent(in) :: src - integer(psb_ipk_), intent(in), optional :: m - integer(psb_mpk_) :: info ,m_,n_, ld, mp_rcv_type - integer(psb_ipk_) :: i,j,k - integer(psb_mpk_) :: status(mpi_status_size) -#if defined(SERIAL_MPI) - ! What should we do here?? -#else - if (present(m)) then - m_ = m - ld = size(dat,1) - n_ = size(dat,2) - call mpi_type_vector(n_,m_,ld,mpi_logical,mp_rcv_type,info) - if (info == mpi_success) call mpi_type_commit(mp_rcv_type,info) - if (info == mpi_success) call mpi_recv(dat,1,mp_rcv_type,src,& - & psb_logical_tag,ictxt,status,info) - if (info == mpi_success) call mpi_type_free(mp_rcv_type,info) - else - call mpi_recv(dat,size(dat),mpi_logical,src,& - & psb_logical_tag,ictxt,status,info) - end if - if (info /= mpi_success) then - write(psb_err_unit,*) 'Error in psb_recv', info - end if - call psb_test_nodes(psb_mesg_queue) -#endif - end subroutine psb_lrcvm - - - subroutine psb_hrcvs(ictxt,dat,src) - use psi_comm_buffers_mod -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - character(len=*), intent(out) :: dat - integer(psb_mpk_), intent(in) :: src - character(len=1), allocatable :: dat_(:) - integer(psb_mpk_) :: info, l, i - integer(psb_mpk_) :: status(mpi_status_size) -#if defined(SERIAL_MPI) - ! do nothing -#else - l = len(dat) - allocate(dat_(l), stat=info) - call mpi_recv(dat_,l,mpi_character,src,psb_char_tag,ictxt,status,info) - call psb_test_nodes(psb_mesg_queue) - do i=1, l - dat(i:i) = dat_(i) - end do - deallocate(dat_) -#endif - end subroutine psb_hrcvs - - -#if defined(LONG_INTEGERS) - - subroutine psb_i4rcvs(ictxt,dat,src) - use psi_comm_buffers_mod -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - integer(psb_mpk_), intent(out) :: dat - integer(psb_mpk_), intent(in) :: src - integer(psb_mpk_) :: info - integer(psb_mpk_) :: status(mpi_status_size) -#if defined(SERIAL_MPI) - ! do nothing -#else - call mpi_recv(dat,1,psb_mpi_mpk_int,src,psb_int4_tag,ictxt,status,info) - call psb_test_nodes(psb_mesg_queue) -#endif - end subroutine psb_i4rcvs - - subroutine psb_i4rcvv(ictxt,dat,src) - use psi_comm_buffers_mod - -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - integer(psb_mpk_), intent(out) :: dat(:) - integer(psb_mpk_), intent(in) :: src - integer(psb_mpk_) :: info - integer(psb_mpk_) :: status(mpi_status_size) -#if defined(SERIAL_MPI) -#else - call mpi_recv(dat,size(dat),psb_mpi_mpk_int,src,psb_int4_tag,ictxt,status,info) - call psb_test_nodes(psb_mesg_queue) -#endif - - end subroutine psb_i4rcvv - - subroutine psb_i4rcvm(ictxt,dat,src,m) - use psi_comm_buffers_mod - -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - integer(psb_mpk_), intent(out) :: dat(:,:) - integer(psb_mpk_), intent(in) :: src - integer(psb_mpk_), intent(in), optional :: m - integer(psb_mpk_) :: info ,m_,n_, ld, mp_rcv_type - integer(psb_mpk_) :: i,j,k - integer(psb_mpk_) :: status(mpi_status_size) -#if defined(SERIAL_MPI) - ! What should we do here?? -#else - if (present(m)) then - m_ = m - ld = size(dat,1) - n_ = size(dat,2) - call mpi_type_vector(n_,m_,ld,psb_mpi_mpk_int,mp_rcv_type,info) - if (info == mpi_success) call mpi_type_commit(mp_rcv_type,info) - if (info == mpi_success) call mpi_recv(dat,1,mp_rcv_type,src,& - & psb_int4_tag,ictxt,status,info) - if (info == mpi_success) call mpi_type_free(mp_rcv_type,info) - else - call mpi_recv(dat,size(dat),psb_mpi_mpk_int,src,& - & psb_int4_tag,ictxt,status,info) - end if - if (info /= mpi_success) then - write(psb_err_unit,*) 'Error in psb_recv', info - end if - call psb_test_nodes(psb_mesg_queue) -#endif - end subroutine psb_i4rcvm - -#endif - -#if !defined(LONG_INTEGERS) - - subroutine psb_i8rcvs(ictxt,dat,src) - use psi_comm_buffers_mod -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - integer(psb_epk_), intent(out) :: dat - integer(psb_mpk_), intent(in) :: src - integer(psb_mpk_) :: info - integer(psb_mpk_) :: status(mpi_status_size) -#if defined(SERIAL_MPI) - ! do nothing -#else - call mpi_recv(dat,1,psb_mpi_lpk_int,src,psb_int8_tag,ictxt,status,info) - call psb_test_nodes(psb_mesg_queue) -#endif - end subroutine psb_i8rcvs - - subroutine psb_i8rcvv(ictxt,dat,src) - use psi_comm_buffers_mod - -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - integer(psb_epk_), intent(out) :: dat(:) - integer(psb_mpk_), intent(in) :: src - integer(psb_mpk_) :: info - integer(psb_mpk_) :: status(mpi_status_size) -#if defined(SERIAL_MPI) -#else - call mpi_recv(dat,size(dat),psb_mpi_lpk_int,src,psb_int8_tag,ictxt,status,info) - call psb_test_nodes(psb_mesg_queue) -#endif - - end subroutine psb_i8rcvv - - subroutine psb_i8rcvm(ictxt,dat,src,m) - use psi_comm_buffers_mod - -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - integer(psb_epk_), intent(out) :: dat(:,:) - integer(psb_mpk_), intent(in) :: src - integer(psb_ipk_), intent(in), optional :: m - integer(psb_mpk_) :: info ,m_,n_, ld, mp_rcv_type - integer(psb_ipk_) :: i,j,k - integer(psb_mpk_) :: status(mpi_status_size) -#if defined(SERIAL_MPI) - ! What should we do here?? -#else - if (present(m)) then - m_ = m - ld = size(dat,1) - n_ = size(dat,2) - call mpi_type_vector(n_,m_,ld,psb_mpi_lpk_int,mp_rcv_type,info) - if (info == mpi_success) call mpi_type_commit(mp_rcv_type,info) - if (info == mpi_success) call mpi_recv(dat,1,mp_rcv_type,src,& - & psb_int8_tag,ictxt,status,info) - if (info == mpi_success) call mpi_type_free(mp_rcv_type,info) - else - call mpi_recv(dat,size(dat),psb_mpi_lpk_int,src,& - & psb_int8_tag,ictxt,status,info) - end if - if (info /= mpi_success) then - write(psb_err_unit,*) 'Error in psb_recv', info - end if - call psb_test_nodes(psb_mesg_queue) -#endif - end subroutine psb_i8rcvm - -#endif - -#if defined(SHORT_INTEGERS) - - subroutine psb_i2rcvs(ictxt,dat,src) - use psi_comm_buffers_mod -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - integer(2), intent(out) :: dat - integer(psb_mpk_), intent(in) :: src - integer(psb_mpk_) :: info - integer(psb_mpk_) :: status(mpi_status_size) -#if defined(SERIAL_MPI) - ! do nothing -#else - call mpi_recv(dat,1,psb_mpi_mpk_int2,src,psb_int2_tag,ictxt,status,info) - call psb_test_nodes(psb_mesg_queue) -#endif - end subroutine psb_i2rcvs - - subroutine psb_i2rcvv(ictxt,dat,src) - use psi_comm_buffers_mod - -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - integer(2), intent(out) :: dat(:) - integer(psb_mpk_), intent(in) :: src - integer(psb_mpk_) :: info - integer(psb_mpk_) :: status(mpi_status_size) -#if defined(SERIAL_MPI) -#else - call mpi_recv(dat,size(dat),psb_mpi_mpk_int2,src,psb_int2_tag,ictxt,status,info) - call psb_test_nodes(psb_mesg_queue) -#endif - - end subroutine psb_i2rcvv - - subroutine psb_i2rcvm(ictxt,dat,src,m) - use psi_comm_buffers_mod - -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_), intent(in) :: ictxt - integer(2), intent(out) :: dat(:,:) - integer(psb_mpk_), intent(in) :: src - integer(psb_mpk_), intent(in), optional :: m - integer(psb_mpk_) :: info , m_,n_, ld, mp_rcv_type - integer(psb_ipk_) :: i,j,k - integer(psb_mpk_) :: status(mpi_status_size) -#if defined(SERIAL_MPI) - ! What should we do here?? -#else - if (present(m)) then - m_ = m - ld = size(dat,1) - n_ = size(dat,2) - call mpi_type_vector(n_,m_,ld,psb_mpi_mpk_int2,mp_rcv_type,info) - if (info == mpi_success) call mpi_type_commit(mp_rcv_type,info) - if (info == mpi_success) call mpi_recv(dat,1,mp_rcv_type,src,& - & psb_int2_tag,ictxt,status,info) - if (info == mpi_success) call mpi_type_free(mp_rcv_type,info) - else - call mpi_recv(dat,size(dat),psb_mpi_mpk_int2,src,& - & psb_int2_tag,ictxt,status,info) - end if - if (info /= mpi_success) then - write(psb_err_unit,*) 'Error in psb_recv', info - end if - call psb_test_nodes(psb_mesg_queue) -#endif - end subroutine psb_i2rcvm - -#endif - - -! -! Integer * 8 aliases. -! - -#if defined(LONG_INTEGERS) - ! !!!!!!!!!!!!!!!!!!!!!!!! - ! - ! Point-to-point SND - ! - ! !!!!!!!!!!!!!!!!!!!!!!!! - - subroutine psb_isnds_ic(ictxt,dat,dst) - - integer(psb_ipk_), intent(in) :: ictxt - integer(psb_ipk_), intent(in) :: dat - integer(psb_ipk_), intent(in) :: dst - - integer(psb_mpk_) :: iictxt, idst - - iictxt = ictxt - idst = dst - call psb_snd(iictxt, dat, idst) - - end subroutine psb_isnds_ic - - subroutine psb_isndv_ic(ictxt,dat,dst) - - integer(psb_ipk_), intent(in) :: ictxt - integer(psb_ipk_), intent(in) :: dat(:) - integer(psb_ipk_), intent(in) :: dst - - integer(psb_mpk_) :: iictxt, idst - - iictxt = ictxt - idst = dst - call psb_snd(iictxt, dat, idst) - - end subroutine psb_isndv_ic - - subroutine psb_isndm_ic(ictxt,dat,dst,m) - - integer(psb_ipk_), intent(in) :: ictxt - integer(psb_ipk_), intent(in) :: dat(:,:) - integer(psb_ipk_), intent(in) :: dst - - integer(psb_mpk_) :: iictxt, idst - - iictxt = ictxt - idst = dst - call psb_snd(iictxt, dat, idst) - - end subroutine psb_isndm_ic - - subroutine psb_ssnds_ic(ictxt,dat,dst) - - integer(psb_ipk_), intent(in) :: ictxt - real(psb_spk_), intent(in) :: dat - integer(psb_ipk_), intent(in) :: dst - - integer(psb_mpk_) :: iictxt, idst - - iictxt = ictxt - idst = dst - call psb_snd(iictxt, dat, idst) - - end subroutine psb_ssnds_ic - - subroutine psb_ssndv_ic(ictxt,dat,dst) - - integer(psb_ipk_), intent(in) :: ictxt - real(psb_spk_), intent(in) :: dat(:) - integer(psb_ipk_), intent(in) :: dst - - integer(psb_mpk_) :: iictxt, idst - - iictxt = ictxt - idst = dst - call psb_snd(iictxt, dat, idst) - - end subroutine psb_ssndv_ic - - subroutine psb_ssndm_ic(ictxt,dat,dst,m) - - integer(psb_ipk_), intent(in) :: ictxt - real(psb_spk_), intent(in) :: dat(:,:) - integer(psb_ipk_), intent(in) :: dst - - integer(psb_mpk_) :: iictxt, idst - - iictxt = ictxt - idst = dst - call psb_snd(iictxt, dat, idst) - - end subroutine psb_ssndm_ic - - - subroutine psb_dsnds_ic(ictxt,dat,dst) - - integer(psb_ipk_), intent(in) :: ictxt - real(psb_dpk_), intent(in) :: dat - integer(psb_ipk_), intent(in) :: dst - - integer(psb_mpk_) :: iictxt, idst - - iictxt = ictxt - idst = dst - call psb_snd(iictxt, dat, idst) - - end subroutine psb_dsnds_ic - - subroutine psb_dsndv_ic(ictxt,dat,dst) - - integer(psb_ipk_), intent(in) :: ictxt - real(psb_dpk_), intent(in) :: dat(:) - integer(psb_ipk_), intent(in) :: dst - - integer(psb_mpk_) :: iictxt, idst - - iictxt = ictxt - idst = dst - call psb_snd(iictxt, dat, idst) - - end subroutine psb_dsndv_ic - - subroutine psb_dsndm_ic(ictxt,dat,dst,m) - - integer(psb_ipk_), intent(in) :: ictxt - real(psb_dpk_), intent(in) :: dat(:,:) - integer(psb_ipk_), intent(in) :: dst - - integer(psb_mpk_) :: iictxt, idst - - iictxt = ictxt - idst = dst - call psb_snd(iictxt, dat, idst) - - end subroutine psb_dsndm_ic - - - subroutine psb_csnds_ic(ictxt,dat,dst) - - integer(psb_ipk_), intent(in) :: ictxt - complex(psb_spk_), intent(in) :: dat - integer(psb_ipk_), intent(in) :: dst - - integer(psb_mpk_) :: iictxt, idst - - iictxt = ictxt - idst = dst - call psb_snd(iictxt, dat, idst) - - end subroutine psb_csnds_ic - - subroutine psb_csndv_ic(ictxt,dat,dst) - - integer(psb_ipk_), intent(in) :: ictxt - complex(psb_spk_), intent(in) :: dat(:) - integer(psb_ipk_), intent(in) :: dst - - integer(psb_mpk_) :: iictxt, idst - - iictxt = ictxt - idst = dst - call psb_snd(iictxt, dat, idst) - - end subroutine psb_csndv_ic - - subroutine psb_csndm_ic(ictxt,dat,dst,m) - - integer(psb_ipk_), intent(in) :: ictxt - complex(psb_spk_), intent(in) :: dat(:,:) - integer(psb_ipk_), intent(in) :: dst - - integer(psb_mpk_) :: iictxt, idst - - iictxt = ictxt - idst = dst - call psb_snd(iictxt, dat, idst) - - end subroutine psb_csndm_ic - - - subroutine psb_zsnds_ic(ictxt,dat,dst) - - integer(psb_ipk_), intent(in) :: ictxt - complex(psb_dpk_), intent(in) :: dat - integer(psb_ipk_), intent(in) :: dst - - integer(psb_mpk_) :: iictxt, idst - - iictxt = ictxt - idst = dst - call psb_snd(iictxt, dat, idst) - - end subroutine psb_zsnds_ic - - subroutine psb_zsndv_ic(ictxt,dat,dst) - - integer(psb_ipk_), intent(in) :: ictxt - complex(psb_dpk_), intent(in) :: dat(:) - integer(psb_ipk_), intent(in) :: dst - - integer(psb_mpk_) :: iictxt, idst - - iictxt = ictxt - idst = dst - call psb_snd(iictxt, dat, idst) - - end subroutine psb_zsndv_ic - - subroutine psb_zsndm_ic(ictxt,dat,dst,m) - integer(psb_ipk_), intent(in) :: ictxt - complex(psb_dpk_), intent(in) :: dat(:,:) - integer(psb_ipk_), intent(in) :: dst - - integer(psb_mpk_) :: iictxt, idst - - iictxt = ictxt - idst = dst - call psb_snd(iictxt, dat, idst) - - end subroutine psb_zsndm_ic - - - subroutine psb_lsnds_ic(ictxt,dat,dst) - integer(psb_ipk_), intent(in) :: ictxt - logical, intent(in) :: dat - integer(psb_ipk_), intent(in) :: dst - - integer(psb_mpk_) :: iictxt, idst - - iictxt = ictxt - idst = dst - call psb_snd(iictxt, dat, idst) - - end subroutine psb_lsnds_ic - - subroutine psb_lsndv_ic(ictxt,dat,dst) - - integer(psb_ipk_), intent(in) :: ictxt - logical, intent(in) :: dat(:) - integer(psb_ipk_), intent(in) :: dst - - integer(psb_mpk_) :: iictxt, idst - - iictxt = ictxt - idst = dst - call psb_snd(iictxt, dat, idst) - - end subroutine psb_lsndv_ic - - subroutine psb_lsndm_ic(ictxt,dat,dst,m) - - integer(psb_ipk_), intent(in) :: ictxt - logical, intent(in) :: dat(:,:) - integer(psb_ipk_), intent(in) :: dst - - integer(psb_mpk_) :: iictxt, idst - - iictxt = ictxt - idst = dst - call psb_snd(iictxt, dat, idst) - - end subroutine psb_lsndm_ic - - - subroutine psb_hsnds_ic(ictxt,dat,dst) - - integer(psb_ipk_), intent(in) :: ictxt - character(len=*), intent(in) :: dat - integer(psb_ipk_), intent(in) :: dst - - integer(psb_mpk_) :: iictxt, idst - - iictxt = ictxt - idst = dst - call psb_snd(iictxt, dat, idst) - - end subroutine psb_hsnds_ic - - - ! !!!!!!!!!!!!!!!!!!!!!!!! - ! - ! Point-to-point RCV - ! - ! !!!!!!!!!!!!!!!!!!!!!!!! - - subroutine psb_ircvs_ic(ictxt,dat,src) - - integer(psb_ipk_), intent(in) :: ictxt - integer(psb_ipk_), intent(out) :: dat - integer(psb_ipk_), intent(in) :: src - - integer(psb_mpk_) :: iictxt, isrc - - iictxt = ictxt - isrc = src - call psb_rcv(iictxt, dat, isrc) - - end subroutine psb_ircvs_ic - - subroutine psb_ircvv_ic(ictxt,dat,src) - - integer(psb_ipk_), intent(in) :: ictxt - integer(psb_ipk_), intent(out) :: dat(:) - integer(psb_ipk_), intent(in) :: src - - integer(psb_mpk_) :: iictxt, isrc - - iictxt = ictxt - isrc = src - call psb_rcv(iictxt, dat, isrc) - - end subroutine psb_ircvv_ic - - subroutine psb_ircvm_ic(ictxt,dat,src,m) - - integer(psb_ipk_), intent(in) :: ictxt - integer(psb_ipk_), intent(out) :: dat(:,:) - integer(psb_ipk_), intent(in) :: src - - integer(psb_mpk_) :: iictxt, isrc - - iictxt = ictxt - isrc = src - call psb_rcv(iictxt, dat, isrc) - - end subroutine psb_ircvm_ic - - subroutine psb_srcvs_ic(ictxt,dat,src) - - integer(psb_ipk_), intent(in) :: ictxt - real(psb_spk_), intent(out) :: dat - integer(psb_ipk_), intent(in) :: src - - integer(psb_mpk_) :: iictxt, isrc - - iictxt = ictxt - isrc = src - call psb_rcv(iictxt, dat, isrc) - - end subroutine psb_srcvs_ic - - subroutine psb_srcvv_ic(ictxt,dat,src) - - integer(psb_ipk_), intent(in) :: ictxt - real(psb_spk_), intent(out) :: dat(:) - integer(psb_ipk_), intent(in) :: src - - integer(psb_mpk_) :: iictxt, isrc - - iictxt = ictxt - isrc = src - call psb_rcv(iictxt, dat, isrc) - - end subroutine psb_srcvv_ic - - subroutine psb_srcvm_ic(ictxt,dat,src,m) - - integer(psb_ipk_), intent(in) :: ictxt - real(psb_spk_), intent(out) :: dat(:,:) - integer(psb_ipk_), intent(in) :: src - - integer(psb_mpk_) :: iictxt, isrc - - iictxt = ictxt - isrc = src - call psb_rcv(iictxt, dat, isrc) - - end subroutine psb_srcvm_ic - - - subroutine psb_drcvs_ic(ictxt,dat,src) - - integer(psb_ipk_), intent(in) :: ictxt - real(psb_dpk_), intent(out) :: dat - integer(psb_ipk_), intent(in) :: src - - integer(psb_mpk_) :: iictxt, isrc - - iictxt = ictxt - isrc = src - call psb_rcv(iictxt, dat, isrc) - - end subroutine psb_drcvs_ic - - subroutine psb_drcvv_ic(ictxt,dat,src) - - integer(psb_ipk_), intent(in) :: ictxt - real(psb_dpk_), intent(out) :: dat(:) - integer(psb_ipk_), intent(in) :: src - - integer(psb_mpk_) :: iictxt, isrc - - iictxt = ictxt - isrc = src - call psb_rcv(iictxt, dat, isrc) - - end subroutine psb_drcvv_ic - - subroutine psb_drcvm_ic(ictxt,dat,src,m) - - integer(psb_ipk_), intent(in) :: ictxt - real(psb_dpk_), intent(out) :: dat(:,:) - integer(psb_ipk_), intent(in) :: src - - integer(psb_mpk_) :: iictxt, isrc - - iictxt = ictxt - isrc = src - call psb_rcv(iictxt, dat, isrc) - - end subroutine psb_drcvm_ic - - - subroutine psb_crcvs_ic(ictxt,dat,src) - - integer(psb_ipk_), intent(in) :: ictxt - complex(psb_spk_), intent(out) :: dat - integer(psb_ipk_), intent(in) :: src - - integer(psb_mpk_) :: iictxt, isrc - - iictxt = ictxt - isrc = src - call psb_rcv(iictxt, dat, isrc) - - end subroutine psb_crcvs_ic - - subroutine psb_crcvv_ic(ictxt,dat,src) - - integer(psb_ipk_), intent(in) :: ictxt - complex(psb_spk_), intent(out) :: dat(:) - integer(psb_ipk_), intent(in) :: src - - integer(psb_mpk_) :: iictxt, isrc - - iictxt = ictxt - isrc = src - call psb_rcv(iictxt, dat, isrc) - - end subroutine psb_crcvv_ic - - subroutine psb_crcvm_ic(ictxt,dat,src,m) - - integer(psb_ipk_), intent(in) :: ictxt - complex(psb_spk_), intent(out) :: dat(:,:) - integer(psb_ipk_), intent(in) :: src - - integer(psb_mpk_) :: iictxt, isrc - - iictxt = ictxt - isrc = src - call psb_rcv(iictxt, dat, isrc) - - end subroutine psb_crcvm_ic - - - subroutine psb_zrcvs_ic(ictxt,dat,src) - - integer(psb_ipk_), intent(in) :: ictxt - complex(psb_dpk_), intent(out) :: dat - integer(psb_ipk_), intent(in) :: src - - integer(psb_mpk_) :: iictxt, isrc - - iictxt = ictxt - isrc = src - call psb_rcv(iictxt, dat, isrc) - - end subroutine psb_zrcvs_ic - - subroutine psb_zrcvv_ic(ictxt,dat,src) - - integer(psb_ipk_), intent(in) :: ictxt - complex(psb_dpk_), intent(out) :: dat(:) - integer(psb_ipk_), intent(in) :: src - - integer(psb_mpk_) :: iictxt, isrc + integer(psb_epk_), intent(in) :: ictxt + logical, intent(out) :: dat(:) + integer(psb_epk_), intent(in) :: src + + integer(psb_mpk_) :: iictxt, isrc iictxt = ictxt isrc = src call psb_rcv(iictxt, dat, isrc) - end subroutine psb_zrcvv_ic + end subroutine psb_lrcvv_ec - subroutine psb_zrcvm_ic(ictxt,dat,src,m) - integer(psb_ipk_), intent(in) :: ictxt - complex(psb_dpk_), intent(out) :: dat(:,:) - integer(psb_ipk_), intent(in) :: src - - integer(psb_mpk_) :: iictxt, isrc - - iictxt = ictxt - isrc = src - call psb_rcv(iictxt, dat, isrc) - - end subroutine psb_zrcvm_ic - - - subroutine psb_lrcvs_ic(ictxt,dat,src) - integer(psb_ipk_), intent(in) :: ictxt - logical, intent(out) :: dat - integer(psb_ipk_), intent(in) :: src - - integer(psb_mpk_) :: iictxt, isrc - - iictxt = ictxt - isrc = src - call psb_rcv(iictxt, dat, isrc) + subroutine psb_lrcvm_ec(ictxt,dat,src,m) - end subroutine psb_lrcvs_ic - - subroutine psb_lrcvv_ic(ictxt,dat,src) - - integer(psb_ipk_), intent(in) :: ictxt - logical, intent(out) :: dat(:) - integer(psb_ipk_), intent(in) :: src - - integer(psb_mpk_) :: iictxt, isrc - - iictxt = ictxt - isrc = src - call psb_rcv(iictxt, dat, isrc) - - end subroutine psb_lrcvv_ic - - subroutine psb_lrcvm_ic(ictxt,dat,src,m) - - integer(psb_ipk_), intent(in) :: ictxt + integer(psb_epk_), intent(in) :: ictxt logical, intent(out) :: dat(:,:) - integer(psb_ipk_), intent(in) :: src + integer(psb_epk_), intent(in) :: src integer(psb_mpk_) :: iictxt, isrc @@ -2301,14 +398,14 @@ contains isrc = src call psb_rcv(iictxt, dat, isrc) - end subroutine psb_lrcvm_ic + end subroutine psb_lrcvm_ec - subroutine psb_hrcvs_ic(ictxt,dat,src) + subroutine psb_hrcvs_ec(ictxt,dat,src) - integer(psb_ipk_), intent(in) :: ictxt + integer(psb_epk_), intent(in) :: ictxt character(len=*), intent(out) :: dat - integer(psb_ipk_), intent(in) :: src + integer(psb_epk_), intent(in) :: src integer(psb_mpk_) :: iictxt, isrc @@ -2316,10 +413,6 @@ contains isrc = src call psb_rcv(iictxt, dat, isrc) - end subroutine psb_hrcvs_ic - - -#endif - + end subroutine psb_hrcvs_ec end module psi_p2p_mod diff --git a/base/modules/psi_penv_mod.F90 b/base/modules/psi_penv_mod.F90 index 911a2d52e..b042a1a77 100644 --- a/base/modules/psi_penv_mod.F90 +++ b/base/modules/psi_penv_mod.F90 @@ -147,32 +147,32 @@ contains info = 0 #if 0 - if (info == 0) call mpi_type_create_f90_integer(psb_ipk_, psb_mpi_ipk_int ,info) - if (info == 0) call mpi_type_create_f90_integer(psb_mpk_, psb_mpi_mpk_int ,info) - if (info == 0) call mpi_type_create_f90_integer(psb_epk_, psb_mpi_lpk_int ,info) + if (info == 0) call mpi_type_create_f90_integer(psb_ipk_, psb_mpi_ipk_ ,info) + if (info == 0) call mpi_type_create_f90_integer(psb_mpk_, psb_mpi_mpk_ ,info) + if (info == 0) call mpi_type_create_f90_integer(psb_epk_, psb_mpi_lpk_ ,info) if (info == 0) call mpi_type_create_f90_real(psb_spk_p_,psb_spk_r_, psb_mpi_r_spk_,info) if (info == 0) call mpi_type_create_f90_real(psb_dpk_p_,psb_dpk_r_, psb_mpi_r_dpk_,info) if (info == 0) call mpi_type_create_f90_complex(psb_spk_p_,psb_spk_r_, psb_mpi_c_spk_,info) if (info == 0) call mpi_type_create_f90_complex(psb_dpk_p_,psb_dpk_r_, psb_mpi_c_dpk_,info) #else #if defined(INT_I4_L4) - psb_mpi_ipk_int = mpi_integer - psb_mpi_lpk_int = mpi_integer + psb_mpi_ipk_ = mpi_integer + psb_mpi_lpk_ = mpi_integer #elif defined(INT_I4_L8) - psb_mpi_ipk_int = mpi_integer - psb_mpi_lpk_int = mpi_integer8 + psb_mpi_ipk_ = mpi_integer + psb_mpi_lpk_ = mpi_integer8 #elif defined(INT_I8_L8) - psb_mpi_ipk_int = mpi_integer8 - psb_mpi_lpk_int = mpi_integer8 + psb_mpi_ipk_ = mpi_integer8 + psb_mpi_lpk_ = mpi_integer8 #else ! This should never happen write(psb_err_unit,*) 'Warning: an impossible IPK/LPK combination.' write(psb_err_unit,*) 'Something went wrong at configuration time.' - psb_mpi_ipk_int = -1 - psb_mpi_lpk_int = -1 + psb_mpi_ipk_ = -1 + psb_mpi_lpk_ = -1 #endif - psb_mpi_mpk_int = mpi_integer - psb_mpi_epk_int = mpi_integer8 + psb_mpi_mpk_ = mpi_integer + psb_mpi_epk_ = mpi_integer8 psb_mpi_r_spk_ = mpi_real psb_mpi_r_dpk_ = mpi_double_precision psb_mpi_c_spk_ = mpi_complex diff --git a/base/modules/psi_reduce_mod.F90 b/base/modules/psi_reduce_mod.F90 index 6de28a0ad..1bda35909 100644 --- a/base/modules/psi_reduce_mod.F90 +++ b/base/modules/psi_reduce_mod.F90 @@ -224,10 +224,10 @@ contains root_ = -1 endif if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,psb_mpi_ipk_int,mpi_max,ictxt,info) + call mpi_allreduce(dat,dat_,1,psb_mpi_ipk_,mpi_max,ictxt,info) dat = dat_ else - call mpi_reduce(dat,dat_,1,psb_mpi_ipk_int,mpi_max,root_,ictxt,info) + call mpi_reduce(dat,dat_,1,psb_mpi_ipk_,mpi_max,root_,ictxt,info) if (iam == root_) dat = dat_ endif #endif @@ -263,15 +263,15 @@ contains call psb_realloc(size(dat),dat_,iinfo) dat_=dat if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),& - & psb_mpi_ipk_int,mpi_max,ictxt,info) + & psb_mpi_ipk_,mpi_max,ictxt,info) else if (iam == root_) then call psb_realloc(size(dat),dat_,iinfo) dat_=dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_ipk_int,mpi_max,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_ipk_,mpi_max,root_,ictxt,info) else call psb_realloc(1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_ipk_int,mpi_max,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_ipk_,mpi_max,root_,ictxt,info) end if endif #endif @@ -307,15 +307,15 @@ contains call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_=dat if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),& - & psb_mpi_ipk_int,mpi_max,ictxt,info) + & psb_mpi_ipk_,mpi_max,ictxt,info) else if (iam == root_) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_=dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_ipk_int,mpi_max,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_ipk_,mpi_max,root_,ictxt,info) else call psb_realloc(1,1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_ipk_int,mpi_max,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_ipk_,mpi_max,root_,ictxt,info) end if endif #endif @@ -348,10 +348,10 @@ contains root_ = -1 endif if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,psb_mpi_mpk_int,mpi_max,ictxt,info) + call mpi_allreduce(dat,dat_,1,psb_mpi_mpk_,mpi_max,ictxt,info) dat = dat_ else - call mpi_reduce(dat,dat_,1,psb_mpi_mpk_int,mpi_max,root_,ictxt,info) + call mpi_reduce(dat,dat_,1,psb_mpi_mpk_,mpi_max,root_,ictxt,info) if (iam == root_) dat = dat_ endif #endif @@ -387,15 +387,15 @@ contains call psb_realloc(size(dat),dat_,iinfo) dat_=dat if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),& - & psb_mpi_mpk_int,mpi_max,ictxt,info) + & psb_mpi_mpk_,mpi_max,ictxt,info) else if (iam == root_) then call psb_realloc(size(dat),dat_,iinfo) dat_=dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_mpk_int,mpi_max,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_mpk_,mpi_max,root_,ictxt,info) else call psb_realloc(1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_mpk_int,mpi_max,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_mpk_,mpi_max,root_,ictxt,info) end if endif #endif @@ -431,15 +431,15 @@ contains call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_=dat if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),& - & psb_mpi_mpk_int,mpi_max,ictxt,info) + & psb_mpi_mpk_,mpi_max,ictxt,info) else if (iam == root_) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_=dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_mpk_int,mpi_max,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_mpk_,mpi_max,root_,ictxt,info) else call psb_realloc(1,1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_mpk_int,mpi_max,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_mpk_,mpi_max,root_,ictxt,info) end if endif #endif @@ -475,10 +475,10 @@ contains root_ = -1 endif if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,psb_mpi_lpk_int,mpi_max,ictxt,info) + call mpi_allreduce(dat,dat_,1,psb_mpi_lpk_,mpi_max,ictxt,info) dat = dat_ else - call mpi_reduce(dat,dat_,1,psb_mpi_lpk_int,mpi_max,root_,ictxt,info) + call mpi_reduce(dat,dat_,1,psb_mpi_lpk_,mpi_max,root_,ictxt,info) if (iam == root_) dat = dat_ endif #endif @@ -514,15 +514,15 @@ contains call psb_realloc(size(dat),dat_,iinfo) dat_=dat if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),& - & psb_mpi_lpk_int,mpi_max,ictxt,info) + & psb_mpi_lpk_,mpi_max,ictxt,info) else if (iam == root_) then call psb_realloc(size(dat),dat_,iinfo) dat_=dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_lpk_int,mpi_max,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_lpk_,mpi_max,root_,ictxt,info) else call psb_realloc(1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_lpk_int,mpi_max,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_lpk_,mpi_max,root_,ictxt,info) end if endif #endif @@ -558,15 +558,15 @@ contains call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_=dat if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),& - & psb_mpi_lpk_int,mpi_max,ictxt,info) + & psb_mpi_lpk_,mpi_max,ictxt,info) else if (iam == root_) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_=dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_lpk_int,mpi_max,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_lpk_,mpi_max,root_,ictxt,info) else call psb_realloc(1,1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_lpk_int,mpi_max,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_lpk_,mpi_max,root_,ictxt,info) end if endif #endif @@ -855,10 +855,10 @@ contains root_ = -1 endif if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,psb_mpi_ipk_int,mpi_min,ictxt,info) + call mpi_allreduce(dat,dat_,1,psb_mpi_ipk_,mpi_min,ictxt,info) dat = dat_ else - call mpi_reduce(dat,dat_,1,psb_mpi_ipk_int,mpi_min,root_,ictxt,info) + call mpi_reduce(dat,dat_,1,psb_mpi_ipk_,mpi_min,root_,ictxt,info) if (iam == root_) dat = dat_ endif #endif @@ -894,15 +894,15 @@ contains call psb_realloc(size(dat),dat_,iinfo) dat_=dat if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),& - & psb_mpi_ipk_int,mpi_min,ictxt,info) + & psb_mpi_ipk_,mpi_min,ictxt,info) else if (iam == root_) then call psb_realloc(size(dat),dat_,iinfo) dat_=dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_ipk_int,mpi_min,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_ipk_,mpi_min,root_,ictxt,info) else call psb_realloc(1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_ipk_int,mpi_min,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_ipk_,mpi_min,root_,ictxt,info) end if endif #endif @@ -938,15 +938,15 @@ contains call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_=dat if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),& - & psb_mpi_ipk_int,mpi_min,ictxt,info) + & psb_mpi_ipk_,mpi_min,ictxt,info) else if (iam == root_) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_=dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_ipk_int,mpi_min,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_ipk_,mpi_min,root_,ictxt,info) else call psb_realloc(1,1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_ipk_int,mpi_min,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_ipk_,mpi_min,root_,ictxt,info) end if endif #endif @@ -979,10 +979,10 @@ contains root_ = -1 endif if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,psb_mpi_mpk_int,mpi_min,ictxt,info) + call mpi_allreduce(dat,dat_,1,psb_mpi_mpk_,mpi_min,ictxt,info) dat = dat_ else - call mpi_reduce(dat,dat_,1,psb_mpi_mpk_int,mpi_min,root_,ictxt,info) + call mpi_reduce(dat,dat_,1,psb_mpi_mpk_,mpi_min,root_,ictxt,info) if (iam == root_) dat = dat_ endif #endif @@ -1018,15 +1018,15 @@ contains call psb_realloc(size(dat),dat_,iinfo) dat_=dat if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),& - & psb_mpi_mpk_int,mpi_min,ictxt,info) + & psb_mpi_mpk_,mpi_min,ictxt,info) else if (iam == root_) then call psb_realloc(size(dat),dat_,iinfo) dat_=dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_mpk_int,mpi_min,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_mpk_,mpi_min,root_,ictxt,info) else call psb_realloc(1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_mpk_int,mpi_min,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_mpk_,mpi_min,root_,ictxt,info) end if endif #endif @@ -1062,15 +1062,15 @@ contains call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_=dat if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),& - & psb_mpi_mpk_int,mpi_min,ictxt,info) + & psb_mpi_mpk_,mpi_min,ictxt,info) else if (iam == root_) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_=dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_mpk_int,mpi_min,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_mpk_,mpi_min,root_,ictxt,info) else call psb_realloc(1,1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_mpk_int,mpi_min,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_mpk_,mpi_min,root_,ictxt,info) end if endif #endif @@ -1106,10 +1106,10 @@ contains root_ = -1 endif if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,psb_mpi_lpk_int,mpi_min,ictxt,info) + call mpi_allreduce(dat,dat_,1,psb_mpi_lpk_,mpi_min,ictxt,info) dat = dat_ else - call mpi_reduce(dat,dat_,1,psb_mpi_lpk_int,mpi_min,root_,ictxt,info) + call mpi_reduce(dat,dat_,1,psb_mpi_lpk_,mpi_min,root_,ictxt,info) if (iam == root_) dat = dat_ endif #endif @@ -1145,15 +1145,15 @@ contains call psb_realloc(size(dat),dat_,iinfo) dat_=dat if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),& - & psb_mpi_lpk_int,mpi_min,ictxt,info) + & psb_mpi_lpk_,mpi_min,ictxt,info) else if (iam == root_) then call psb_realloc(size(dat),dat_,iinfo) dat_=dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_lpk_int,mpi_min,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_lpk_,mpi_min,root_,ictxt,info) else call psb_realloc(1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_lpk_int,mpi_min,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_lpk_,mpi_min,root_,ictxt,info) end if endif #endif @@ -1189,15 +1189,15 @@ contains call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_=dat if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),& - & psb_mpi_lpk_int,mpi_min,ictxt,info) + & psb_mpi_lpk_,mpi_min,ictxt,info) else if (iam == root_) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_=dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_lpk_int,mpi_min,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_lpk_,mpi_min,root_,ictxt,info) else call psb_realloc(1,1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_lpk_int,mpi_min,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_lpk_,mpi_min,root_,ictxt,info) end if endif #endif @@ -1489,10 +1489,10 @@ contains root_ = -1 endif if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,psb_mpi_ipk_int,mpi_iamx_op,ictxt,info) + call mpi_allreduce(dat,dat_,1,psb_mpi_ipk_,mpi_iamx_op,ictxt,info) dat = dat_ else - call mpi_reduce(dat,dat_,1,psb_mpi_ipk_int,mpi_iamx_op,root_,ictxt,info) + call mpi_reduce(dat,dat_,1,psb_mpi_ipk_,mpi_iamx_op,root_,ictxt,info) if (iam == root_) dat = dat_ endif @@ -1529,15 +1529,15 @@ contains call psb_realloc(size(dat),dat_,iinfo) dat_=dat if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),& - & psb_mpi_ipk_int,mpi_iamx_op,ictxt,info) + & psb_mpi_ipk_,mpi_iamx_op,ictxt,info) else if (iam == root_) then call psb_realloc(size(dat),dat_,iinfo) dat_=dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_ipk_int,mpi_iamx_op,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_ipk_,mpi_iamx_op,root_,ictxt,info) else call psb_realloc(1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_ipk_int,mpi_iamx_op,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_ipk_,mpi_iamx_op,root_,ictxt,info) end if endif #endif @@ -1573,15 +1573,15 @@ contains call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_=dat if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),& - & psb_mpi_ipk_int,mpi_iamx_op,ictxt,info) + & psb_mpi_ipk_,mpi_iamx_op,ictxt,info) else if (iam == root_) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_=dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_ipk_int,mpi_iamx_op,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_ipk_,mpi_iamx_op,root_,ictxt,info) else call psb_realloc(1,1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_ipk_int,mpi_iamx_op,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_ipk_,mpi_iamx_op,root_,ictxt,info) end if endif #endif @@ -1616,10 +1616,10 @@ contains root_ = -1 endif if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,psb_mpi_mpk_int,mpi_i4amx_op,ictxt,info) + call mpi_allreduce(dat,dat_,1,psb_mpi_mpk_,mpi_i4amx_op,ictxt,info) dat = dat_ else - call mpi_reduce(dat,dat_,1,psb_mpi_mpk_int,mpi_i4amx_op,root_,ictxt,info) + call mpi_reduce(dat,dat_,1,psb_mpi_mpk_,mpi_i4amx_op,root_,ictxt,info) if (iam == root_) dat = dat_ endif @@ -1656,15 +1656,15 @@ contains call psb_realloc(size(dat),dat_,iinfo) dat_=dat if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),& - & psb_mpi_mpk_int,mpi_i4amx_op,ictxt,info) + & psb_mpi_mpk_,mpi_i4amx_op,ictxt,info) else if (iam == root_) then call psb_realloc(size(dat),dat_,iinfo) dat_=dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_mpk_int,mpi_i4amx_op,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_mpk_,mpi_i4amx_op,root_,ictxt,info) else call psb_realloc(1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_mpk_int,mpi_i4amx_op,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_mpk_,mpi_i4amx_op,root_,ictxt,info) end if endif #endif @@ -1700,15 +1700,15 @@ contains call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_=dat if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),& - & psb_mpi_mpk_int,mpi_i4amx_op,ictxt,info) + & psb_mpi_mpk_,mpi_i4amx_op,ictxt,info) else if (iam == root_) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_=dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_mpk_int,mpi_i4amx_op,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_mpk_,mpi_i4amx_op,root_,ictxt,info) else call psb_realloc(1,1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_mpk_int,mpi_i4amx_op,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_mpk_,mpi_i4amx_op,root_,ictxt,info) end if endif #endif @@ -1744,10 +1744,10 @@ contains root_ = -1 endif if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,psb_mpi_lpk_int,mpi_i8amx_op,ictxt,info) + call mpi_allreduce(dat,dat_,1,psb_mpi_lpk_,mpi_i8amx_op,ictxt,info) dat = dat_ else - call mpi_reduce(dat,dat_,1,psb_mpi_lpk_int,mpi_i8amx_op,root_,ictxt,info) + call mpi_reduce(dat,dat_,1,psb_mpi_lpk_,mpi_i8amx_op,root_,ictxt,info) if (iam == root_) dat = dat_ endif @@ -1784,15 +1784,15 @@ contains call psb_realloc(size(dat),dat_,iinfo) dat_=dat if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),& - & psb_mpi_lpk_int,mpi_i8amx_op,ictxt,info) + & psb_mpi_lpk_,mpi_i8amx_op,ictxt,info) else if (iam == root_) then call psb_realloc(size(dat),dat_,iinfo) dat_=dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_lpk_int,mpi_i8amx_op,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_lpk_,mpi_i8amx_op,root_,ictxt,info) else call psb_realloc(1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_lpk_int,mpi_i8amx_op,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_lpk_,mpi_i8amx_op,root_,ictxt,info) end if endif #endif @@ -1828,15 +1828,15 @@ contains call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_=dat if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),& - & psb_mpi_lpk_int,mpi_i8amx_op,ictxt,info) + & psb_mpi_lpk_,mpi_i8amx_op,ictxt,info) else if (iam == root_) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_=dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_lpk_int,mpi_i8amx_op,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_lpk_,mpi_i8amx_op,root_,ictxt,info) else call psb_realloc(1,1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_lpk_int,mpi_i8amx_op,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_lpk_,mpi_i8amx_op,root_,ictxt,info) end if endif #endif @@ -2376,10 +2376,10 @@ contains root_ = -1 endif if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,psb_mpi_ipk_int,mpi_iamn_op,ictxt,info) + call mpi_allreduce(dat,dat_,1,psb_mpi_ipk_,mpi_iamn_op,ictxt,info) dat = dat_ else - call mpi_reduce(dat,dat_,1,psb_mpi_ipk_int,mpi_iamn_op,root_,ictxt,info) + call mpi_reduce(dat,dat_,1,psb_mpi_ipk_,mpi_iamn_op,root_,ictxt,info) if (iam == root_) dat = dat_ endif @@ -2416,15 +2416,15 @@ contains call psb_realloc(size(dat),dat_,iinfo) dat_=dat if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),& - & psb_mpi_ipk_int,mpi_iamn_op,ictxt,info) + & psb_mpi_ipk_,mpi_iamn_op,ictxt,info) else if (iam == root_) then call psb_realloc(size(dat),dat_,iinfo) dat_=dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_ipk_int,mpi_iamn_op,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_ipk_,mpi_iamn_op,root_,ictxt,info) else call psb_realloc(1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_ipk_int,mpi_iamn_op,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_ipk_,mpi_iamn_op,root_,ictxt,info) end if endif #endif @@ -2460,15 +2460,15 @@ contains call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_=dat if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),& - & psb_mpi_ipk_int,mpi_iamn_op,ictxt,info) + & psb_mpi_ipk_,mpi_iamn_op,ictxt,info) else if (iam == root_) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_=dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_ipk_int,mpi_iamn_op,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_ipk_,mpi_iamn_op,root_,ictxt,info) else call psb_realloc(1,1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_ipk_int,mpi_iamn_op,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_ipk_,mpi_iamn_op,root_,ictxt,info) end if endif #endif @@ -2503,10 +2503,10 @@ contains root_ = -1 endif if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,psb_mpi_mpk_int,mpi_i4amn_op,ictxt,info) + call mpi_allreduce(dat,dat_,1,psb_mpi_mpk_,mpi_i4amn_op,ictxt,info) dat = dat_ else - call mpi_reduce(dat,dat_,1,psb_mpi_mpk_int,mpi_i4amn_op,root_,ictxt,info) + call mpi_reduce(dat,dat_,1,psb_mpi_mpk_,mpi_i4amn_op,root_,ictxt,info) if (iam == root_) dat = dat_ endif @@ -2543,15 +2543,15 @@ contains call psb_realloc(size(dat),dat_,iinfo) dat_=dat if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),& - & psb_mpi_mpk_int,mpi_i4amn_op,ictxt,info) + & psb_mpi_mpk_,mpi_i4amn_op,ictxt,info) else if (iam == root_) then call psb_realloc(size(dat),dat_,iinfo) dat_=dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_mpk_int,mpi_i4amn_op,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_mpk_,mpi_i4amn_op,root_,ictxt,info) else call psb_realloc(1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_mpk_int,mpi_i4amn_op,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_mpk_,mpi_i4amn_op,root_,ictxt,info) end if endif #endif @@ -2587,15 +2587,15 @@ contains call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_=dat if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),& - & psb_mpi_mpk_int,mpi_i4amn_op,ictxt,info) + & psb_mpi_mpk_,mpi_i4amn_op,ictxt,info) else if (iam == root_) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_=dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_mpk_int,mpi_i4amn_op,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_mpk_,mpi_i4amn_op,root_,ictxt,info) else call psb_realloc(1,1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_mpk_int,mpi_i4amn_op,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_mpk_,mpi_i4amn_op,root_,ictxt,info) end if endif #endif @@ -2631,10 +2631,10 @@ contains root_ = -1 endif if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,psb_mpi_lpk_int,mpi_i8amn_op,ictxt,info) + call mpi_allreduce(dat,dat_,1,psb_mpi_lpk_,mpi_i8amn_op,ictxt,info) dat = dat_ else - call mpi_reduce(dat,dat_,1,psb_mpi_lpk_int,mpi_i8amn_op,root_,ictxt,info) + call mpi_reduce(dat,dat_,1,psb_mpi_lpk_,mpi_i8amn_op,root_,ictxt,info) if (iam == root_) dat = dat_ endif @@ -2671,15 +2671,15 @@ contains call psb_realloc(size(dat),dat_,iinfo) dat_=dat if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),& - & psb_mpi_lpk_int,mpi_i8amn_op,ictxt,info) + & psb_mpi_lpk_,mpi_i8amn_op,ictxt,info) else if (iam == root_) then call psb_realloc(size(dat),dat_,iinfo) dat_=dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_lpk_int,mpi_i8amn_op,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_lpk_,mpi_i8amn_op,root_,ictxt,info) else call psb_realloc(1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_lpk_int,mpi_i8amn_op,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_lpk_,mpi_i8amn_op,root_,ictxt,info) end if endif #endif @@ -2715,15 +2715,15 @@ contains call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_=dat if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),& - & psb_mpi_lpk_int,mpi_i8amn_op,ictxt,info) + & psb_mpi_lpk_,mpi_i8amn_op,ictxt,info) else if (iam == root_) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_=dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_lpk_int,mpi_i8amn_op,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_lpk_,mpi_i8amn_op,root_,ictxt,info) else call psb_realloc(1,1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_lpk_int,mpi_i8amn_op,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_lpk_,mpi_i8amn_op,root_,ictxt,info) end if endif #endif @@ -3262,10 +3262,10 @@ contains root_ = -1 endif if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,psb_mpi_ipk_int,mpi_sum,ictxt,info) + call mpi_allreduce(dat,dat_,1,psb_mpi_ipk_,mpi_sum,ictxt,info) dat = dat_ else - call mpi_reduce(dat,dat_,1,psb_mpi_ipk_int,mpi_sum,root_,ictxt,info) + call mpi_reduce(dat,dat_,1,psb_mpi_ipk_,mpi_sum,root_,ictxt,info) if (iam == root_) dat = dat_ endif @@ -3303,15 +3303,15 @@ contains dat_=dat if (iinfo == psb_success_)& & call mpi_allreduce(dat_,dat,size(dat),& - & psb_mpi_ipk_int,mpi_sum,ictxt,info) + & psb_mpi_ipk_,mpi_sum,ictxt,info) else if (iam == root_) then call psb_realloc(size(dat),dat_,iinfo) dat_=dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_ipk_int,mpi_sum,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_ipk_,mpi_sum,root_,ictxt,info) else call psb_realloc(1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_ipk_int,mpi_sum,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_ipk_,mpi_sum,root_,ictxt,info) end if endif #endif @@ -3347,15 +3347,15 @@ contains call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_=dat if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),& - & psb_mpi_ipk_int,mpi_sum,ictxt,info) + & psb_mpi_ipk_,mpi_sum,ictxt,info) else if (iam == root_) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_=dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_ipk_int,mpi_sum,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_ipk_,mpi_sum,root_,ictxt,info) else call psb_realloc(1,1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_ipk_int,mpi_sum,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_ipk_,mpi_sum,root_,ictxt,info) end if endif #endif @@ -3390,10 +3390,10 @@ contains root_ = -1 endif if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,psb_mpi_mpk_int2,mpi_sum,ictxt,info) + call mpi_allreduce(dat,dat_,1,psb_mpi_mpk_2,mpi_sum,ictxt,info) dat = dat_ else - call mpi_reduce(dat,dat_,1,psb_mpi_mpk_int2,mpi_sum,root_,ictxt,info) + call mpi_reduce(dat,dat_,1,psb_mpi_mpk_2,mpi_sum,root_,ictxt,info) if (iam == root_) dat = dat_ endif @@ -3430,14 +3430,14 @@ contains call psb_realloc(size(dat),dat_,iinfo) dat_=dat if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),& - & psb_mpi_mpk_int2,mpi_sum,ictxt,info) + & psb_mpi_mpk_2,mpi_sum,ictxt,info) else if (iam == root_) then call psb_realloc(size(dat),dat_,iinfo) dat_=dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_mpk_int2,mpi_sum,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_mpk_2,mpi_sum,root_,ictxt,info) else - call mpi_reduce(dat,dat_,size(dat),psb_mpi_mpk_int2,mpi_sum,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_mpk_2,mpi_sum,root_,ictxt,info) end if endif #endif @@ -3473,14 +3473,14 @@ contains call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_=dat if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),& - & psb_mpi_mpk_int2,mpi_sum,ictxt,info) + & psb_mpi_mpk_2,mpi_sum,ictxt,info) else if (iam == root_) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_=dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_mpk_int2,mpi_sum,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_mpk_2,mpi_sum,root_,ictxt,info) else - call mpi_reduce(dat,dat_,size(dat),psb_mpi_mpk_int2,mpi_sum,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_mpk_2,mpi_sum,root_,ictxt,info) end if endif #endif @@ -3517,10 +3517,10 @@ contains root_ = -1 endif if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,psb_mpi_mpk_int,mpi_sum,ictxt,info) + call mpi_allreduce(dat,dat_,1,psb_mpi_mpk_,mpi_sum,ictxt,info) dat = dat_ else - call mpi_reduce(dat,dat_,1,psb_mpi_mpk_int,mpi_sum,root_,ictxt,info) + call mpi_reduce(dat,dat_,1,psb_mpi_mpk_,mpi_sum,root_,ictxt,info) if (iam == root_) dat = dat_ endif @@ -3556,15 +3556,15 @@ contains call psb_realloc(size(dat),dat_,info) dat_=dat if (info == psb_success_) call mpi_allreduce(dat_,dat,size(dat),& - & psb_mpi_mpk_int,mpi_sum,ictxt,info) + & psb_mpi_mpk_,mpi_sum,ictxt,info) else if (iam == root_) then call psb_realloc(size(dat),dat_,info) dat_=dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_mpk_int,mpi_sum,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_mpk_,mpi_sum,root_,ictxt,info) else call psb_realloc(1,dat_,info) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_mpk_int,mpi_sum,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_mpk_,mpi_sum,root_,ictxt,info) end if endif #endif @@ -3598,15 +3598,15 @@ contains call psb_realloc(size(dat,1),size(dat,2),dat_,info) dat_=dat if (info == psb_success_) call mpi_allreduce(dat_,dat,size(dat),& - & psb_mpi_mpk_int,mpi_sum,ictxt,info) + & psb_mpi_mpk_,mpi_sum,ictxt,info) else if (iam == root_) then call psb_realloc(size(dat,1),size(dat,2),dat_,info) dat_=dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_mpk_int,mpi_sum,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_mpk_,mpi_sum,root_,ictxt,info) else call psb_realloc(1,1,dat_,info) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_mpk_int,mpi_sum,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_mpk_,mpi_sum,root_,ictxt,info) end if endif #endif @@ -3642,10 +3642,10 @@ contains root_ = -1 endif if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,psb_mpi_lpk_int,mpi_sum,ictxt,info) + call mpi_allreduce(dat,dat_,1,psb_mpi_lpk_,mpi_sum,ictxt,info) dat = dat_ else - call mpi_reduce(dat,dat_,1,psb_mpi_lpk_int,mpi_sum,root_,ictxt,info) + call mpi_reduce(dat,dat_,1,psb_mpi_lpk_,mpi_sum,root_,ictxt,info) if (iam == root_) dat = dat_ endif @@ -3682,15 +3682,15 @@ contains call psb_realloc(size(dat),dat_,iinfo) dat_=dat if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),& - & psb_mpi_lpk_int,mpi_sum,ictxt,info) + & psb_mpi_lpk_,mpi_sum,ictxt,info) else if (iam == root_) then call psb_realloc(size(dat),dat_,iinfo) dat_=dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_lpk_int,mpi_sum,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_lpk_,mpi_sum,root_,ictxt,info) else call psb_realloc(1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_lpk_int,mpi_sum,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_lpk_,mpi_sum,root_,ictxt,info) end if endif #endif @@ -3726,15 +3726,15 @@ contains call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_=dat if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),& - & psb_mpi_lpk_int,mpi_sum,ictxt,info) + & psb_mpi_lpk_,mpi_sum,ictxt,info) else if (iam == root_) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_=dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_lpk_int,mpi_sum,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_lpk_,mpi_sum,root_,ictxt,info) else call psb_realloc(1,1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_lpk_int,mpi_sum,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_lpk_,mpi_sum,root_,ictxt,info) end if endif #endif diff --git a/base/tools/psb_ccdbldext.F90 b/base/tools/psb_ccdbldext.F90 index eb78376da..38474ae46 100644 --- a/base/tools/psb_ccdbldext.F90 +++ b/base/tools/psb_ccdbldext.F90 @@ -468,8 +468,8 @@ Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info, extype) ! accumulated RECV requests, we have an all-to-all to build ! matchings SENDs. ! - call mpi_alltoall(sdsz,1,psb_mpi_mpk_int,rvsz,1, & - & psb_mpi_mpk_int,icomm,minfo) + call mpi_alltoall(sdsz,1,psb_mpi_mpk_,rvsz,1, & + & psb_mpi_mpk_,icomm,minfo) if (minfo /= psb_success_) then info=psb_err_from_subroutine_ call psb_errpush(info,name,a_err='mpi_alltoall') @@ -504,8 +504,8 @@ Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info, extype) lworkr = max(iszr,1) end if - call mpi_alltoallv(works,sdsz,bsdindx,psb_mpi_ipk_int,& - & workr,rvsz,brvindx,psb_mpi_ipk_int,icomm,minfo) + call mpi_alltoallv(works,sdsz,bsdindx,psb_mpi_ipk_,& + & workr,rvsz,brvindx,psb_mpi_ipk_,icomm,minfo) if (minfo /= psb_success_) then info=psb_err_from_subroutine_ call psb_errpush(info,name,a_err='mpi_alltoallv') diff --git a/base/tools/psb_csphalo.F90 b/base/tools/psb_csphalo.F90 index f1a278b17..5647035e9 100644 --- a/base/tools/psb_csphalo.F90 +++ b/base/tools/psb_csphalo.F90 @@ -195,8 +195,8 @@ Subroutine psb_csphalo(a,desc_a,blk,info,rowcnv,colcnv,& counter = counter+n_el_send+3 Enddo - call mpi_alltoall(sdsz,1,psb_mpi_mpk_int,& - & rvsz,1,psb_mpi_mpk_int,icomm,minfo) + call mpi_alltoall(sdsz,1,psb_mpi_mpk_,& + & rvsz,1,psb_mpi_mpk_,icomm,minfo) if (info /= psb_success_) then info=psb_err_from_subroutine_ ch_err='mpi_alltoall' @@ -281,10 +281,10 @@ Subroutine psb_csphalo(a,desc_a,blk,info,rowcnv,colcnv,& call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_c_spk_,& & acoo%val,rvsz,brvindx,psb_mpi_c_spk_,icomm,minfo) - call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_ipk_int,& - & acoo%ia,rvsz,brvindx,psb_mpi_ipk_int,icomm,minfo) - call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_ipk_int,& - & acoo%ja,rvsz,brvindx,psb_mpi_ipk_int,icomm,minfo) + call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_ipk_,& + & acoo%ia,rvsz,brvindx,psb_mpi_ipk_,icomm,minfo) + call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_ipk_,& + & acoo%ja,rvsz,brvindx,psb_mpi_ipk_,icomm,minfo) if (info /= psb_success_) then info=psb_err_from_subroutine_ ch_err='mpi_alltoallv' diff --git a/base/tools/psb_dcdbldext.F90 b/base/tools/psb_dcdbldext.F90 index bb2e3567e..80d4f8e8d 100644 --- a/base/tools/psb_dcdbldext.F90 +++ b/base/tools/psb_dcdbldext.F90 @@ -468,8 +468,8 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype) ! accumulated RECV requests, we have an all-to-all to build ! matchings SENDs. ! - call mpi_alltoall(sdsz,1,psb_mpi_mpk_int,rvsz,1, & - & psb_mpi_mpk_int,icomm,minfo) + call mpi_alltoall(sdsz,1,psb_mpi_mpk_,rvsz,1, & + & psb_mpi_mpk_,icomm,minfo) if (minfo /= psb_success_) then info=psb_err_from_subroutine_ call psb_errpush(info,name,a_err='mpi_alltoall') @@ -504,8 +504,8 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype) lworkr = max(iszr,1) end if - call mpi_alltoallv(works,sdsz,bsdindx,psb_mpi_ipk_int,& - & workr,rvsz,brvindx,psb_mpi_ipk_int,icomm,minfo) + call mpi_alltoallv(works,sdsz,bsdindx,psb_mpi_ipk_,& + & workr,rvsz,brvindx,psb_mpi_ipk_,icomm,minfo) if (minfo /= psb_success_) then info=psb_err_from_subroutine_ call psb_errpush(info,name,a_err='mpi_alltoallv') diff --git a/base/tools/psb_dsphalo.F90 b/base/tools/psb_dsphalo.F90 index f250c660e..fc6ade55b 100644 --- a/base/tools/psb_dsphalo.F90 +++ b/base/tools/psb_dsphalo.F90 @@ -195,8 +195,8 @@ Subroutine psb_dsphalo(a,desc_a,blk,info,rowcnv,colcnv,& counter = counter+n_el_send+3 Enddo - call mpi_alltoall(sdsz,1,psb_mpi_mpk_int,& - & rvsz,1,psb_mpi_mpk_int,icomm,minfo) + call mpi_alltoall(sdsz,1,psb_mpi_mpk_,& + & rvsz,1,psb_mpi_mpk_,icomm,minfo) if (info /= psb_success_) then info=psb_err_from_subroutine_ ch_err='mpi_alltoall' @@ -281,10 +281,10 @@ Subroutine psb_dsphalo(a,desc_a,blk,info,rowcnv,colcnv,& call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_r_dpk_,& & acoo%val,rvsz,brvindx,psb_mpi_r_dpk_,icomm,minfo) - call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_ipk_int,& - & acoo%ia,rvsz,brvindx,psb_mpi_ipk_int,icomm,minfo) - call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_ipk_int,& - & acoo%ja,rvsz,brvindx,psb_mpi_ipk_int,icomm,minfo) + call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_ipk_,& + & acoo%ia,rvsz,brvindx,psb_mpi_ipk_,icomm,minfo) + call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_ipk_,& + & acoo%ja,rvsz,brvindx,psb_mpi_ipk_,icomm,minfo) if (info /= psb_success_) then info=psb_err_from_subroutine_ ch_err='mpi_alltoallv' diff --git a/base/tools/psb_scdbldext.F90 b/base/tools/psb_scdbldext.F90 index b8d3c27bc..1d88e3d3a 100644 --- a/base/tools/psb_scdbldext.F90 +++ b/base/tools/psb_scdbldext.F90 @@ -468,8 +468,8 @@ Subroutine psb_scdbldext(a,desc_a,novr,desc_ov,info, extype) ! accumulated RECV requests, we have an all-to-all to build ! matchings SENDs. ! - call mpi_alltoall(sdsz,1,psb_mpi_mpk_int,rvsz,1, & - & psb_mpi_mpk_int,icomm,minfo) + call mpi_alltoall(sdsz,1,psb_mpi_mpk_,rvsz,1, & + & psb_mpi_mpk_,icomm,minfo) if (minfo /= psb_success_) then info=psb_err_from_subroutine_ call psb_errpush(info,name,a_err='mpi_alltoall') @@ -504,8 +504,8 @@ Subroutine psb_scdbldext(a,desc_a,novr,desc_ov,info, extype) lworkr = max(iszr,1) end if - call mpi_alltoallv(works,sdsz,bsdindx,psb_mpi_ipk_int,& - & workr,rvsz,brvindx,psb_mpi_ipk_int,icomm,minfo) + call mpi_alltoallv(works,sdsz,bsdindx,psb_mpi_ipk_,& + & workr,rvsz,brvindx,psb_mpi_ipk_,icomm,minfo) if (minfo /= psb_success_) then info=psb_err_from_subroutine_ call psb_errpush(info,name,a_err='mpi_alltoallv') diff --git a/base/tools/psb_ssphalo.F90 b/base/tools/psb_ssphalo.F90 index 2a478629d..360b7d071 100644 --- a/base/tools/psb_ssphalo.F90 +++ b/base/tools/psb_ssphalo.F90 @@ -195,8 +195,8 @@ Subroutine psb_ssphalo(a,desc_a,blk,info,rowcnv,colcnv,& counter = counter+n_el_send+3 Enddo - call mpi_alltoall(sdsz,1,psb_mpi_mpk_int,& - & rvsz,1,psb_mpi_mpk_int,icomm,minfo) + call mpi_alltoall(sdsz,1,psb_mpi_mpk_,& + & rvsz,1,psb_mpi_mpk_,icomm,minfo) if (info /= psb_success_) then info=psb_err_from_subroutine_ ch_err='mpi_alltoall' @@ -281,10 +281,10 @@ Subroutine psb_ssphalo(a,desc_a,blk,info,rowcnv,colcnv,& call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_r_spk_,& & acoo%val,rvsz,brvindx,psb_mpi_r_spk_,icomm,minfo) - call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_ipk_int,& - & acoo%ia,rvsz,brvindx,psb_mpi_ipk_int,icomm,minfo) - call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_ipk_int,& - & acoo%ja,rvsz,brvindx,psb_mpi_ipk_int,icomm,minfo) + call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_ipk_,& + & acoo%ia,rvsz,brvindx,psb_mpi_ipk_,icomm,minfo) + call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_ipk_,& + & acoo%ja,rvsz,brvindx,psb_mpi_ipk_,icomm,minfo) if (info /= psb_success_) then info=psb_err_from_subroutine_ ch_err='mpi_alltoallv' diff --git a/base/tools/psb_zcdbldext.F90 b/base/tools/psb_zcdbldext.F90 index af7ff2943..96bc3884e 100644 --- a/base/tools/psb_zcdbldext.F90 +++ b/base/tools/psb_zcdbldext.F90 @@ -468,8 +468,8 @@ Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info, extype) ! accumulated RECV requests, we have an all-to-all to build ! matchings SENDs. ! - call mpi_alltoall(sdsz,1,psb_mpi_mpk_int,rvsz,1, & - & psb_mpi_mpk_int,icomm,minfo) + call mpi_alltoall(sdsz,1,psb_mpi_mpk_,rvsz,1, & + & psb_mpi_mpk_,icomm,minfo) if (minfo /= psb_success_) then info=psb_err_from_subroutine_ call psb_errpush(info,name,a_err='mpi_alltoall') @@ -504,8 +504,8 @@ Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info, extype) lworkr = max(iszr,1) end if - call mpi_alltoallv(works,sdsz,bsdindx,psb_mpi_ipk_int,& - & workr,rvsz,brvindx,psb_mpi_ipk_int,icomm,minfo) + call mpi_alltoallv(works,sdsz,bsdindx,psb_mpi_ipk_,& + & workr,rvsz,brvindx,psb_mpi_ipk_,icomm,minfo) if (minfo /= psb_success_) then info=psb_err_from_subroutine_ call psb_errpush(info,name,a_err='mpi_alltoallv') diff --git a/base/tools/psb_zsphalo.F90 b/base/tools/psb_zsphalo.F90 index 4534cd5d2..0ac5de014 100644 --- a/base/tools/psb_zsphalo.F90 +++ b/base/tools/psb_zsphalo.F90 @@ -195,8 +195,8 @@ Subroutine psb_zsphalo(a,desc_a,blk,info,rowcnv,colcnv,& counter = counter+n_el_send+3 Enddo - call mpi_alltoall(sdsz,1,psb_mpi_mpk_int,& - & rvsz,1,psb_mpi_mpk_int,icomm,minfo) + call mpi_alltoall(sdsz,1,psb_mpi_mpk_,& + & rvsz,1,psb_mpi_mpk_,icomm,minfo) if (info /= psb_success_) then info=psb_err_from_subroutine_ ch_err='mpi_alltoall' @@ -281,10 +281,10 @@ Subroutine psb_zsphalo(a,desc_a,blk,info,rowcnv,colcnv,& call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_c_dpk_,& & acoo%val,rvsz,brvindx,psb_mpi_c_dpk_,icomm,minfo) - call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_ipk_int,& - & acoo%ia,rvsz,brvindx,psb_mpi_ipk_int,icomm,minfo) - call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_ipk_int,& - & acoo%ja,rvsz,brvindx,psb_mpi_ipk_int,icomm,minfo) + call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_ipk_,& + & acoo%ia,rvsz,brvindx,psb_mpi_ipk_,icomm,minfo) + call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_ipk_,& + & acoo%ja,rvsz,brvindx,psb_mpi_ipk_,icomm,minfo) if (info /= psb_success_) then info=psb_err_from_subroutine_ ch_err='mpi_alltoallv'