From 57957c3f976eb2819a0cc4a35fdf84aea51453c7 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Tue, 4 Dec 2012 14:06:04 +0000 Subject: [PATCH] psblas3: base/comm/psb_cscatter.F90 base/comm/psb_cspgather.F90 base/comm/psb_dscatter.F90 base/comm/psb_dspgather.F90 base/comm/psb_sscatter.F90 base/comm/psb_sspgather.F90 base/comm/psb_zscatter.F90 base/comm/psb_zspgather.F90 base/internals/psi_cswapdata.F90 base/internals/psi_cswaptran.F90 base/internals/psi_dswapdata.F90 base/internals/psi_dswaptran.F90 base/internals/psi_sswapdata.F90 base/internals/psi_sswaptran.F90 base/internals/psi_zswapdata.F90 base/internals/psi_zswaptran.F90 base/modules/psb_const_mod.F90 base/modules/psb_i_tools_mod.f90 base/modules/psi_bcast_mod.F90 base/modules/psi_comm_buffers_mod.F90 base/modules/psi_p2p_mod.F90 base/modules/psi_reduce_mod.F90 base/tools/psb_csphalo.F90 base/tools/psb_dsphalo.F90 base/tools/psb_glob_to_loc.f90 base/tools/psb_loc_to_glob.f90 base/tools/psb_ssphalo.F90 base/tools/psb_zsphalo.F90 Parametrixe type identifiers in MPI operations. --- base/comm/psb_cscatter.F90 | 8 +- base/comm/psb_cspgather.F90 | 4 +- base/comm/psb_dscatter.F90 | 8 +- base/comm/psb_dspgather.F90 | 4 +- base/comm/psb_sscatter.F90 | 8 +- base/comm/psb_sspgather.F90 | 4 +- base/comm/psb_zscatter.F90 | 8 +- base/comm/psb_zspgather.F90 | 4 +- base/internals/psi_cswapdata.F90 | 30 +-- base/internals/psi_cswaptran.F90 | 30 +-- base/internals/psi_dswapdata.F90 | 30 +-- base/internals/psi_dswaptran.F90 | 30 +-- base/internals/psi_sswapdata.F90 | 30 +-- base/internals/psi_sswaptran.F90 | 30 +-- base/internals/psi_zswapdata.F90 | 30 +-- base/internals/psi_zswaptran.F90 | 30 +-- base/modules/psb_const_mod.F90 | 4 +- base/modules/psb_i_tools_mod.f90 | 27 ++- base/modules/psi_bcast_mod.F90 | 24 +-- base/modules/psi_comm_buffers_mod.F90 | 16 +- base/modules/psi_p2p_mod.F90 | 32 +-- base/modules/psi_reduce_mod.F90 | 276 +++++++++++++------------- base/tools/psb_csphalo.F90 | 4 +- base/tools/psb_dsphalo.F90 | 4 +- base/tools/psb_glob_to_loc.f90 | 22 +- base/tools/psb_loc_to_glob.f90 | 22 +- base/tools/psb_ssphalo.F90 | 4 +- base/tools/psb_zsphalo.F90 | 4 +- 28 files changed, 362 insertions(+), 365 deletions(-) diff --git a/base/comm/psb_cscatter.F90 b/base/comm/psb_cscatter.F90 index 0fd39275..57ccc7a1 100644 --- a/base/comm/psb_cscatter.F90 +++ b/base/comm/psb_cscatter.F90 @@ -208,8 +208,8 @@ subroutine psb_cscatterm(globx, locx, desc_a, info, iroot) ! scatter !!! call mpi_scatterv(scatterv,all_dim,displ,& - & mpi_complex,locx(1,jlocx+c-1),nrow,& - & mpi_complex,rootrank,icomm,info) + & psb_mpi_c_spk_,locx(1,jlocx+c-1),nrow,& + & psb_mpi_c_spk_,rootrank,icomm,info) end do @@ -417,8 +417,8 @@ subroutine psb_cscatterv(globx, locx, desc_a, info, iroot) end if call mpi_scatterv(scatterv,all_dim,displ,& - & mpi_complex,locx,nrow,& - & mpi_complex,rootrank,icomm,info) + & psb_mpi_c_spk_,locx,nrow,& + & psb_mpi_c_spk_,rootrank,icomm,info) if (me == root) deallocate(all_dim, l_t_g_all, displ, scatterv) end if diff --git a/base/comm/psb_cspgather.F90 b/base/comm/psb_cspgather.F90 index 5ac7fe6e..322b0704 100644 --- a/base/comm/psb_cspgather.F90 +++ b/base/comm/psb_cspgather.F90 @@ -112,9 +112,9 @@ subroutine psb_csp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep idisp(ip) = sum(nzbr(1:ip-1)) enddo ndx = nzbr(me+1) - call mpi_allgatherv(loc_coo%val,ndx,mpi_complex,& + call mpi_allgatherv(loc_coo%val,ndx,psb_mpi_c_spk_,& & glob_coo%val,nzbr,idisp,& - & mpi_complex,icomm,minfo) + & psb_mpi_c_spk_,icomm,minfo) if (minfo == psb_success_) call mpi_allgatherv(loc_coo%ia,ndx,psb_mpi_ipk_integer,& & glob_coo%ia,nzbr,idisp,& & psb_mpi_ipk_integer,icomm,minfo) diff --git a/base/comm/psb_dscatter.F90 b/base/comm/psb_dscatter.F90 index 6167a7d9..f157cd80 100644 --- a/base/comm/psb_dscatter.F90 +++ b/base/comm/psb_dscatter.F90 @@ -208,8 +208,8 @@ subroutine psb_dscatterm(globx, locx, desc_a, info, iroot) ! scatter !!! call mpi_scatterv(scatterv,all_dim,displ,& - & mpi_double_precision,locx(1,jlocx+c-1),nrow,& - & mpi_double_precision,rootrank,icomm,info) + & psb_mpi_r_dpk_,locx(1,jlocx+c-1),nrow,& + & psb_mpi_r_dpk_,rootrank,icomm,info) end do @@ -417,8 +417,8 @@ subroutine psb_dscatterv(globx, locx, desc_a, info, iroot) end if call mpi_scatterv(scatterv,all_dim,displ,& - & mpi_double_precision,locx,nrow,& - & mpi_double_precision,rootrank,icomm,info) + & psb_mpi_r_dpk_,locx,nrow,& + & psb_mpi_r_dpk_,rootrank,icomm,info) if (me == root) deallocate(all_dim, l_t_g_all, displ, scatterv) end if diff --git a/base/comm/psb_dspgather.F90 b/base/comm/psb_dspgather.F90 index 658145bf..8dbe4e35 100644 --- a/base/comm/psb_dspgather.F90 +++ b/base/comm/psb_dspgather.F90 @@ -112,9 +112,9 @@ subroutine psb_dsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep idisp(ip) = sum(nzbr(1:ip-1)) enddo ndx = nzbr(me+1) - call mpi_allgatherv(loc_coo%val,ndx,mpi_double_precision,& + call mpi_allgatherv(loc_coo%val,ndx,psb_mpi_r_dpk_,& & glob_coo%val,nzbr,idisp,& - & mpi_double_precision,icomm,minfo) + & psb_mpi_r_dpk_,icomm,minfo) if (minfo == psb_success_) call mpi_allgatherv(loc_coo%ia,ndx,psb_mpi_ipk_integer,& & glob_coo%ia,nzbr,idisp,& & psb_mpi_ipk_integer,icomm,minfo) diff --git a/base/comm/psb_sscatter.F90 b/base/comm/psb_sscatter.F90 index dc27ea7a..2a9f13e5 100644 --- a/base/comm/psb_sscatter.F90 +++ b/base/comm/psb_sscatter.F90 @@ -208,8 +208,8 @@ subroutine psb_sscatterm(globx, locx, desc_a, info, iroot) ! scatter !!! call mpi_scatterv(scatterv,all_dim,displ,& - & mpi_real,locx(1,jlocx+c-1),nrow,& - & mpi_real,rootrank,icomm,info) + & psb_mpi_r_spk_,locx(1,jlocx+c-1),nrow,& + & psb_mpi_r_spk_,rootrank,icomm,info) end do @@ -417,8 +417,8 @@ subroutine psb_sscatterv(globx, locx, desc_a, info, iroot) end if call mpi_scatterv(scatterv,all_dim,displ,& - & mpi_real,locx,nrow,& - & mpi_real,rootrank,icomm,info) + & psb_mpi_r_spk_,locx,nrow,& + & psb_mpi_r_spk_,rootrank,icomm,info) if (me == root) deallocate(all_dim, l_t_g_all, displ, scatterv) end if diff --git a/base/comm/psb_sspgather.F90 b/base/comm/psb_sspgather.F90 index 61c600ce..834656af 100644 --- a/base/comm/psb_sspgather.F90 +++ b/base/comm/psb_sspgather.F90 @@ -112,9 +112,9 @@ subroutine psb_ssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep idisp(ip) = sum(nzbr(1:ip-1)) enddo ndx = nzbr(me+1) - call mpi_allgatherv(loc_coo%val,ndx,mpi_real,& + call mpi_allgatherv(loc_coo%val,ndx,psb_mpi_r_spk_,& & glob_coo%val,nzbr,idisp,& - & mpi_real,icomm,minfo) + & psb_mpi_r_spk_,icomm,minfo) if (minfo == psb_success_) call mpi_allgatherv(loc_coo%ia,ndx,psb_mpi_ipk_integer,& & glob_coo%ia,nzbr,idisp,& & psb_mpi_ipk_integer,icomm,minfo) diff --git a/base/comm/psb_zscatter.F90 b/base/comm/psb_zscatter.F90 index 3d43804c..6327df58 100644 --- a/base/comm/psb_zscatter.F90 +++ b/base/comm/psb_zscatter.F90 @@ -208,8 +208,8 @@ subroutine psb_zscatterm(globx, locx, desc_a, info, iroot) ! scatter !!! call mpi_scatterv(scatterv,all_dim,displ,& - & mpi_double_complex,locx(1,jlocx+c-1),nrow,& - & mpi_double_complex,rootrank,icomm,info) + & psb_mpi_c_dpk_,locx(1,jlocx+c-1),nrow,& + & psb_mpi_c_dpk_,rootrank,icomm,info) end do @@ -417,8 +417,8 @@ subroutine psb_zscatterv(globx, locx, desc_a, info, iroot) end if call mpi_scatterv(scatterv,all_dim,displ,& - & mpi_double_complex,locx,nrow,& - & mpi_double_complex,rootrank,icomm,info) + & psb_mpi_c_dpk_,locx,nrow,& + & psb_mpi_c_dpk_,rootrank,icomm,info) if (me == root) deallocate(all_dim, l_t_g_all, displ, scatterv) end if diff --git a/base/comm/psb_zspgather.F90 b/base/comm/psb_zspgather.F90 index 4035a1c9..30620a33 100644 --- a/base/comm/psb_zspgather.F90 +++ b/base/comm/psb_zspgather.F90 @@ -112,9 +112,9 @@ subroutine psb_zsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep idisp(ip) = sum(nzbr(1:ip-1)) enddo ndx = nzbr(me+1) - call mpi_allgatherv(loc_coo%val,ndx,mpi_double_complex,& + call mpi_allgatherv(loc_coo%val,ndx,psb_mpi_c_dpk_,& & glob_coo%val,nzbr,idisp,& - & mpi_double_complex,icomm,minfo) + & psb_mpi_c_dpk_,icomm,minfo) if (minfo == psb_success_) call mpi_allgatherv(loc_coo%ia,ndx,psb_mpi_ipk_integer,& & glob_coo%ia,nzbr,idisp,& & psb_mpi_ipk_integer,icomm,minfo) diff --git a/base/internals/psi_cswapdata.F90 b/base/internals/psi_cswapdata.F90 index 4ada95b3..1ee39446 100644 --- a/base/internals/psi_cswapdata.F90 +++ b/base/internals/psi_cswapdata.F90 @@ -302,8 +302,8 @@ subroutine psi_cswapidxm(iictxt,iicomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,wo ! swap elements using mpi_alltoallv call mpi_alltoallv(sndbuf,sdsz,bsdidx,& - & mpi_complex,rcvbuf,rvsz,& - & brvidx,mpi_complex,icomm,iret) + & psb_mpi_c_spk_,rcvbuf,rvsz,& + & brvidx,psb_mpi_c_spk_,icomm,iret) if(iret /= mpi_success) then ierr(1) = iret info=psb_err_mpi_error_ @@ -363,7 +363,7 @@ subroutine psi_cswapidxm(iictxt,iicomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,wo if ((nerv>0).and.(proc_to_comm /= me)) then p2ptag = psb_complex_swap_tag call mpi_irecv(rcvbuf(rcv_pt),n*nerv,& - & mpi_complex,prcid(i),& + & psb_mpi_c_spk_,prcid(i),& & p2ptag, icomm,rvhd(i),iret) end if rcv_pt = rcv_pt + n*nerv @@ -388,11 +388,11 @@ subroutine psi_cswapidxm(iictxt,iicomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,wo if ((nesd>0).and.(proc_to_comm /= me)) then if (usersend) then call mpi_rsend(sndbuf(snd_pt),n*nesd,& - & mpi_complex,prcid(i),& + & psb_mpi_c_spk_,prcid(i),& & p2ptag,icomm,iret) else call mpi_send(sndbuf(snd_pt),n*nesd,& - & mpi_complex,prcid(i),& + & psb_mpi_c_spk_,prcid(i),& & p2ptag,icomm,iret) end if @@ -801,8 +801,8 @@ subroutine psi_cswapidxv(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,work ! swap elements using mpi_alltoallv call mpi_alltoallv(sndbuf,sdsz,bsdidx,& - & mpi_complex,rcvbuf,rvsz,& - & brvidx,mpi_complex,icomm,iret) + & psb_mpi_c_spk_,rcvbuf,rvsz,& + & brvidx,psb_mpi_c_spk_,icomm,iret) if(iret /= mpi_success) then ierr(1) = iret info=psb_err_mpi_error_ @@ -859,7 +859,7 @@ subroutine psi_cswapidxv(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,work if ((nerv>0).and.(proc_to_comm /= me)) then p2ptag = psb_complex_swap_tag call mpi_irecv(rcvbuf(rcv_pt),nerv,& - & mpi_complex,prcid(i),& + & psb_mpi_c_spk_,prcid(i),& & p2ptag, icomm,rvhd(i),iret) end if rcv_pt = rcv_pt + nerv @@ -884,11 +884,11 @@ subroutine psi_cswapidxv(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,work if ((nesd>0).and.(proc_to_comm /= me)) then if (usersend) then call mpi_rsend(sndbuf(snd_pt),nesd,& - & mpi_complex,prcid(i),& + & psb_mpi_c_spk_,prcid(i),& & p2ptag,icomm,iret) else call mpi_send(sndbuf(snd_pt),nesd,& - & mpi_complex,prcid(i),& + & psb_mpi_c_spk_,prcid(i),& & p2ptag,icomm,iret) end if @@ -1238,8 +1238,8 @@ subroutine psi_cswapidx_vect(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv, ! swap elements using mpi_alltoallv call mpi_alltoallv(sndbuf,sdsz,bsdidx,& - & mpi_complex,rcvbuf,rvsz,& - & brvidx,mpi_complex,icomm,iret) + & psb_mpi_c_spk_,rcvbuf,rvsz,& + & brvidx,psb_mpi_c_spk_,icomm,iret) if(iret /= mpi_success) then ierr(1) = iret info=psb_err_mpi_error_ @@ -1296,7 +1296,7 @@ subroutine psi_cswapidx_vect(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv, if ((nerv>0).and.(proc_to_comm /= me)) then p2ptag = psb_complex_swap_tag call mpi_irecv(rcvbuf(rcv_pt),nerv,& - & mpi_complex,prcid(i),& + & psb_mpi_c_spk_,prcid(i),& & p2ptag, icomm,rvhd(i),iret) end if rcv_pt = rcv_pt + nerv @@ -1321,11 +1321,11 @@ subroutine psi_cswapidx_vect(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv, if ((nesd>0).and.(proc_to_comm /= me)) then if (usersend) then call mpi_rsend(sndbuf(snd_pt),nesd,& - & mpi_complex,prcid(i),& + & psb_mpi_c_spk_,prcid(i),& & p2ptag,icomm,iret) else call mpi_send(sndbuf(snd_pt),nesd,& - & mpi_complex,prcid(i),& + & psb_mpi_c_spk_,prcid(i),& & p2ptag,icomm,iret) end if diff --git a/base/internals/psi_cswaptran.F90 b/base/internals/psi_cswaptran.F90 index 5627a7ed..469aeb75 100644 --- a/base/internals/psi_cswaptran.F90 +++ b/base/internals/psi_cswaptran.F90 @@ -320,8 +320,8 @@ subroutine psi_ctranidxm(iictxt,iicomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,wo ! swap elements using mpi_alltoallv call mpi_alltoallv(rcvbuf,rvsz,brvidx,& - & mpi_complex,& - & sndbuf,sdsz,bsdidx,mpi_complex,icomm,iret) + & psb_mpi_c_spk_,& + & sndbuf,sdsz,bsdidx,psb_mpi_c_spk_,icomm,iret) if(iret /= mpi_success) then ierr(1) = iret info=psb_err_mpi_error_ @@ -378,7 +378,7 @@ subroutine psi_ctranidxm(iictxt,iicomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,wo if ((nesd>0).and.(proc_to_comm /= me)) then p2ptag = psb_complex_swap_tag call mpi_irecv(sndbuf(snd_pt),n*nesd,& - & mpi_complex,prcid(i),& + & psb_mpi_c_spk_,prcid(i),& & p2ptag,icomm,rvhd(i),iret) end if rcv_pt = rcv_pt + n*nerv @@ -402,11 +402,11 @@ subroutine psi_ctranidxm(iictxt,iicomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,wo p2ptag = psb_complex_swap_tag if (usersend) then call mpi_rsend(rcvbuf(rcv_pt),n*nerv,& - & mpi_complex,prcid(i),& + & psb_mpi_c_spk_,prcid(i),& & p2ptag,icomm,iret) else call mpi_send(rcvbuf(rcv_pt),n*nerv,& - & mpi_complex,prcid(i),& + & psb_mpi_c_spk_,prcid(i),& & p2ptag,icomm,iret) end if @@ -824,8 +824,8 @@ subroutine psi_ctranidxv(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,work ! swap elements using mpi_alltoallv call mpi_alltoallv(rcvbuf,rvsz,brvidx,& - & mpi_complex,& - & sndbuf,sdsz,bsdidx,mpi_complex,icomm,iret) + & psb_mpi_c_spk_,& + & sndbuf,sdsz,bsdidx,psb_mpi_c_spk_,icomm,iret) if(iret /= mpi_success) then ierr(1) = iret info=psb_err_mpi_error_ @@ -882,7 +882,7 @@ subroutine psi_ctranidxv(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,work if ((nesd>0).and.(proc_to_comm /= me)) then p2ptag = psb_complex_swap_tag call mpi_irecv(sndbuf(snd_pt),nesd,& - & mpi_complex,prcid(i),& + & psb_mpi_c_spk_,prcid(i),& & p2ptag,icomm,rvhd(i),iret) end if rcv_pt = rcv_pt + nerv @@ -906,11 +906,11 @@ subroutine psi_ctranidxv(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,work p2ptag = psb_complex_swap_tag if (usersend) then call mpi_rsend(rcvbuf(rcv_pt),nerv,& - & mpi_complex,prcid(i),& + & psb_mpi_c_spk_,prcid(i),& & p2ptag, icomm,iret) else call mpi_send(rcvbuf(rcv_pt),nerv,& - & mpi_complex,prcid(i),& + & psb_mpi_c_spk_,prcid(i),& & p2ptag, icomm,iret) end if @@ -1273,8 +1273,8 @@ subroutine psi_ctranidx_vect(iictxt,iicomm,flag,beta,y,idx,& ! swap elements using mpi_alltoallv call mpi_alltoallv(rcvbuf,rvsz,brvidx,& - & mpi_complex,& - & sndbuf,sdsz,bsdidx,mpi_complex,icomm,iret) + & psb_mpi_c_spk_,& + & sndbuf,sdsz,bsdidx,psb_mpi_c_spk_,icomm,iret) if(iret /= mpi_success) then ierr(1) = iret info=psb_err_mpi_error_ @@ -1331,7 +1331,7 @@ subroutine psi_ctranidx_vect(iictxt,iicomm,flag,beta,y,idx,& if ((nesd>0).and.(proc_to_comm /= me)) then p2ptag = psb_complex_swap_tag call mpi_irecv(sndbuf(snd_pt),nesd,& - & mpi_complex,prcid(i),& + & psb_mpi_c_spk_,prcid(i),& & p2ptag,icomm,rvhd(i),iret) end if rcv_pt = rcv_pt + nerv @@ -1355,11 +1355,11 @@ subroutine psi_ctranidx_vect(iictxt,iicomm,flag,beta,y,idx,& p2ptag = psb_complex_swap_tag if (usersend) then call mpi_rsend(rcvbuf(rcv_pt),nerv,& - & mpi_complex,prcid(i),& + & psb_mpi_c_spk_,prcid(i),& & p2ptag, icomm,iret) else call mpi_send(rcvbuf(rcv_pt),nerv,& - & mpi_complex,prcid(i),& + & psb_mpi_c_spk_,prcid(i),& & p2ptag, icomm,iret) end if diff --git a/base/internals/psi_dswapdata.F90 b/base/internals/psi_dswapdata.F90 index 97d19a20..478feded 100644 --- a/base/internals/psi_dswapdata.F90 +++ b/base/internals/psi_dswapdata.F90 @@ -302,8 +302,8 @@ subroutine psi_dswapidxm(iictxt,iicomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,wo ! swap elements using mpi_alltoallv call mpi_alltoallv(sndbuf,sdsz,bsdidx,& - & mpi_double_precision,rcvbuf,rvsz,& - & brvidx,mpi_double_precision,icomm,iret) + & psb_mpi_r_dpk_,rcvbuf,rvsz,& + & brvidx,psb_mpi_r_dpk_,icomm,iret) if(iret /= mpi_success) then ierr(1) = iret info=psb_err_mpi_error_ @@ -363,7 +363,7 @@ subroutine psi_dswapidxm(iictxt,iicomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,wo if ((nerv>0).and.(proc_to_comm /= me)) then p2ptag = psb_double_swap_tag call mpi_irecv(rcvbuf(rcv_pt),n*nerv,& - & mpi_double_precision,prcid(i),& + & psb_mpi_r_dpk_,prcid(i),& & p2ptag, icomm,rvhd(i),iret) end if rcv_pt = rcv_pt + n*nerv @@ -388,11 +388,11 @@ subroutine psi_dswapidxm(iictxt,iicomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,wo if ((nesd>0).and.(proc_to_comm /= me)) then if (usersend) then call mpi_rsend(sndbuf(snd_pt),n*nesd,& - & mpi_double_precision,prcid(i),& + & psb_mpi_r_dpk_,prcid(i),& & p2ptag,icomm,iret) else call mpi_send(sndbuf(snd_pt),n*nesd,& - & mpi_double_precision,prcid(i),& + & psb_mpi_r_dpk_,prcid(i),& & p2ptag,icomm,iret) end if @@ -801,8 +801,8 @@ subroutine psi_dswapidxv(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,work ! swap elements using mpi_alltoallv call mpi_alltoallv(sndbuf,sdsz,bsdidx,& - & mpi_double_precision,rcvbuf,rvsz,& - & brvidx,mpi_double_precision,icomm,iret) + & psb_mpi_r_dpk_,rcvbuf,rvsz,& + & brvidx,psb_mpi_r_dpk_,icomm,iret) if(iret /= mpi_success) then ierr(1) = iret info=psb_err_mpi_error_ @@ -859,7 +859,7 @@ subroutine psi_dswapidxv(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,work if ((nerv>0).and.(proc_to_comm /= me)) then p2ptag = psb_double_swap_tag call mpi_irecv(rcvbuf(rcv_pt),nerv,& - & mpi_double_precision,prcid(i),& + & psb_mpi_r_dpk_,prcid(i),& & p2ptag, icomm,rvhd(i),iret) end if rcv_pt = rcv_pt + nerv @@ -884,11 +884,11 @@ subroutine psi_dswapidxv(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,work if ((nesd>0).and.(proc_to_comm /= me)) then if (usersend) then call mpi_rsend(sndbuf(snd_pt),nesd,& - & mpi_double_precision,prcid(i),& + & psb_mpi_r_dpk_,prcid(i),& & p2ptag,icomm,iret) else call mpi_send(sndbuf(snd_pt),nesd,& - & mpi_double_precision,prcid(i),& + & psb_mpi_r_dpk_,prcid(i),& & p2ptag,icomm,iret) end if @@ -1238,8 +1238,8 @@ subroutine psi_dswapidx_vect(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv, ! swap elements using mpi_alltoallv call mpi_alltoallv(sndbuf,sdsz,bsdidx,& - & mpi_double_precision,rcvbuf,rvsz,& - & brvidx,mpi_double_precision,icomm,iret) + & psb_mpi_r_dpk_,rcvbuf,rvsz,& + & brvidx,psb_mpi_r_dpk_,icomm,iret) if(iret /= mpi_success) then ierr(1) = iret info=psb_err_mpi_error_ @@ -1296,7 +1296,7 @@ subroutine psi_dswapidx_vect(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv, if ((nerv>0).and.(proc_to_comm /= me)) then p2ptag = psb_double_swap_tag call mpi_irecv(rcvbuf(rcv_pt),nerv,& - & mpi_double_precision,prcid(i),& + & psb_mpi_r_dpk_,prcid(i),& & p2ptag, icomm,rvhd(i),iret) end if rcv_pt = rcv_pt + nerv @@ -1321,11 +1321,11 @@ subroutine psi_dswapidx_vect(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv, if ((nesd>0).and.(proc_to_comm /= me)) then if (usersend) then call mpi_rsend(sndbuf(snd_pt),nesd,& - & mpi_double_precision,prcid(i),& + & psb_mpi_r_dpk_,prcid(i),& & p2ptag,icomm,iret) else call mpi_send(sndbuf(snd_pt),nesd,& - & mpi_double_precision,prcid(i),& + & psb_mpi_r_dpk_,prcid(i),& & p2ptag,icomm,iret) end if diff --git a/base/internals/psi_dswaptran.F90 b/base/internals/psi_dswaptran.F90 index 8866cbc6..c06d9bf9 100644 --- a/base/internals/psi_dswaptran.F90 +++ b/base/internals/psi_dswaptran.F90 @@ -320,8 +320,8 @@ subroutine psi_dtranidxm(iictxt,iicomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,wo ! swap elements using mpi_alltoallv call mpi_alltoallv(rcvbuf,rvsz,brvidx,& - & mpi_double_precision,& - & sndbuf,sdsz,bsdidx,mpi_double_precision,icomm,iret) + & psb_mpi_r_dpk_,& + & sndbuf,sdsz,bsdidx,psb_mpi_r_dpk_,icomm,iret) if(iret /= mpi_success) then ierr(1) = iret info=psb_err_mpi_error_ @@ -378,7 +378,7 @@ subroutine psi_dtranidxm(iictxt,iicomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,wo if ((nesd>0).and.(proc_to_comm /= me)) then p2ptag = psb_double_swap_tag call mpi_irecv(sndbuf(snd_pt),n*nesd,& - & mpi_double_precision,prcid(i),& + & psb_mpi_r_dpk_,prcid(i),& & p2ptag,icomm,rvhd(i),iret) end if rcv_pt = rcv_pt + n*nerv @@ -402,11 +402,11 @@ subroutine psi_dtranidxm(iictxt,iicomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,wo p2ptag = psb_double_swap_tag if (usersend) then call mpi_rsend(rcvbuf(rcv_pt),n*nerv,& - & mpi_double_precision,prcid(i),& + & psb_mpi_r_dpk_,prcid(i),& & p2ptag,icomm,iret) else call mpi_send(rcvbuf(rcv_pt),n*nerv,& - & mpi_double_precision,prcid(i),& + & psb_mpi_r_dpk_,prcid(i),& & p2ptag,icomm,iret) end if @@ -824,8 +824,8 @@ subroutine psi_dtranidxv(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,work ! swap elements using mpi_alltoallv call mpi_alltoallv(rcvbuf,rvsz,brvidx,& - & mpi_double_precision,& - & sndbuf,sdsz,bsdidx,mpi_double_precision,icomm,iret) + & psb_mpi_r_dpk_,& + & sndbuf,sdsz,bsdidx,psb_mpi_r_dpk_,icomm,iret) if(iret /= mpi_success) then ierr(1) = iret info=psb_err_mpi_error_ @@ -882,7 +882,7 @@ subroutine psi_dtranidxv(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,work if ((nesd>0).and.(proc_to_comm /= me)) then p2ptag = psb_double_swap_tag call mpi_irecv(sndbuf(snd_pt),nesd,& - & mpi_double_precision,prcid(i),& + & psb_mpi_r_dpk_,prcid(i),& & p2ptag,icomm,rvhd(i),iret) end if rcv_pt = rcv_pt + nerv @@ -906,11 +906,11 @@ subroutine psi_dtranidxv(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,work p2ptag = psb_double_swap_tag if (usersend) then call mpi_rsend(rcvbuf(rcv_pt),nerv,& - & mpi_double_precision,prcid(i),& + & psb_mpi_r_dpk_,prcid(i),& & p2ptag, icomm,iret) else call mpi_send(rcvbuf(rcv_pt),nerv,& - & mpi_double_precision,prcid(i),& + & psb_mpi_r_dpk_,prcid(i),& & p2ptag, icomm,iret) end if @@ -1273,8 +1273,8 @@ subroutine psi_dtranidx_vect(iictxt,iicomm,flag,beta,y,idx,& ! swap elements using mpi_alltoallv call mpi_alltoallv(rcvbuf,rvsz,brvidx,& - & mpi_double_precision,& - & sndbuf,sdsz,bsdidx,mpi_double_precision,icomm,iret) + & psb_mpi_r_dpk_,& + & sndbuf,sdsz,bsdidx,psb_mpi_r_dpk_,icomm,iret) if(iret /= mpi_success) then ierr(1) = iret info=psb_err_mpi_error_ @@ -1331,7 +1331,7 @@ subroutine psi_dtranidx_vect(iictxt,iicomm,flag,beta,y,idx,& if ((nesd>0).and.(proc_to_comm /= me)) then p2ptag = psb_double_swap_tag call mpi_irecv(sndbuf(snd_pt),nesd,& - & mpi_double_precision,prcid(i),& + & psb_mpi_r_dpk_,prcid(i),& & p2ptag,icomm,rvhd(i),iret) end if rcv_pt = rcv_pt + nerv @@ -1355,11 +1355,11 @@ subroutine psi_dtranidx_vect(iictxt,iicomm,flag,beta,y,idx,& p2ptag = psb_double_swap_tag if (usersend) then call mpi_rsend(rcvbuf(rcv_pt),nerv,& - & mpi_double_precision,prcid(i),& + & psb_mpi_r_dpk_,prcid(i),& & p2ptag, icomm,iret) else call mpi_send(rcvbuf(rcv_pt),nerv,& - & mpi_double_precision,prcid(i),& + & psb_mpi_r_dpk_,prcid(i),& & p2ptag, icomm,iret) end if diff --git a/base/internals/psi_sswapdata.F90 b/base/internals/psi_sswapdata.F90 index 00b31725..d0b867f8 100644 --- a/base/internals/psi_sswapdata.F90 +++ b/base/internals/psi_sswapdata.F90 @@ -302,8 +302,8 @@ subroutine psi_sswapidxm(iictxt,iicomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,wo ! swap elements using mpi_alltoallv call mpi_alltoallv(sndbuf,sdsz,bsdidx,& - & mpi_real,rcvbuf,rvsz,& - & brvidx,mpi_real,icomm,iret) + & psb_mpi_r_spk_,rcvbuf,rvsz,& + & brvidx,psb_mpi_r_spk_,icomm,iret) if(iret /= mpi_success) then ierr(1) = iret info=psb_err_mpi_error_ @@ -363,7 +363,7 @@ subroutine psi_sswapidxm(iictxt,iicomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,wo if ((nerv>0).and.(proc_to_comm /= me)) then p2ptag = psb_real_swap_tag call mpi_irecv(rcvbuf(rcv_pt),n*nerv,& - & mpi_real,prcid(i),& + & psb_mpi_r_spk_,prcid(i),& & p2ptag, icomm,rvhd(i),iret) end if rcv_pt = rcv_pt + n*nerv @@ -388,11 +388,11 @@ subroutine psi_sswapidxm(iictxt,iicomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,wo if ((nesd>0).and.(proc_to_comm /= me)) then if (usersend) then call mpi_rsend(sndbuf(snd_pt),n*nesd,& - & mpi_real,prcid(i),& + & psb_mpi_r_spk_,prcid(i),& & p2ptag,icomm,iret) else call mpi_send(sndbuf(snd_pt),n*nesd,& - & mpi_real,prcid(i),& + & psb_mpi_r_spk_,prcid(i),& & p2ptag,icomm,iret) end if @@ -801,8 +801,8 @@ subroutine psi_sswapidxv(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,work ! swap elements using mpi_alltoallv call mpi_alltoallv(sndbuf,sdsz,bsdidx,& - & mpi_real,rcvbuf,rvsz,& - & brvidx,mpi_real,icomm,iret) + & psb_mpi_r_spk_,rcvbuf,rvsz,& + & brvidx,psb_mpi_r_spk_,icomm,iret) if(iret /= mpi_success) then ierr(1) = iret info=psb_err_mpi_error_ @@ -859,7 +859,7 @@ subroutine psi_sswapidxv(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,work if ((nerv>0).and.(proc_to_comm /= me)) then p2ptag = psb_real_swap_tag call mpi_irecv(rcvbuf(rcv_pt),nerv,& - & mpi_real,prcid(i),& + & psb_mpi_r_spk_,prcid(i),& & p2ptag, icomm,rvhd(i),iret) end if rcv_pt = rcv_pt + nerv @@ -884,11 +884,11 @@ subroutine psi_sswapidxv(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,work if ((nesd>0).and.(proc_to_comm /= me)) then if (usersend) then call mpi_rsend(sndbuf(snd_pt),nesd,& - & mpi_real,prcid(i),& + & psb_mpi_r_spk_,prcid(i),& & p2ptag,icomm,iret) else call mpi_send(sndbuf(snd_pt),nesd,& - & mpi_real,prcid(i),& + & psb_mpi_r_spk_,prcid(i),& & p2ptag,icomm,iret) end if @@ -1238,8 +1238,8 @@ subroutine psi_sswapidx_vect(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv, ! swap elements using mpi_alltoallv call mpi_alltoallv(sndbuf,sdsz,bsdidx,& - & mpi_real,rcvbuf,rvsz,& - & brvidx,mpi_real,icomm,iret) + & psb_mpi_r_spk_,rcvbuf,rvsz,& + & brvidx,psb_mpi_r_spk_,icomm,iret) if(iret /= mpi_success) then ierr(1) = iret info=psb_err_mpi_error_ @@ -1296,7 +1296,7 @@ subroutine psi_sswapidx_vect(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv, if ((nerv>0).and.(proc_to_comm /= me)) then p2ptag = psb_real_swap_tag call mpi_irecv(rcvbuf(rcv_pt),nerv,& - & mpi_real,prcid(i),& + & psb_mpi_r_spk_,prcid(i),& & p2ptag, icomm,rvhd(i),iret) end if rcv_pt = rcv_pt + nerv @@ -1321,11 +1321,11 @@ subroutine psi_sswapidx_vect(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv, if ((nesd>0).and.(proc_to_comm /= me)) then if (usersend) then call mpi_rsend(sndbuf(snd_pt),nesd,& - & mpi_real,prcid(i),& + & psb_mpi_r_spk_,prcid(i),& & p2ptag,icomm,iret) else call mpi_send(sndbuf(snd_pt),nesd,& - & mpi_real,prcid(i),& + & psb_mpi_r_spk_,prcid(i),& & p2ptag,icomm,iret) end if diff --git a/base/internals/psi_sswaptran.F90 b/base/internals/psi_sswaptran.F90 index 14a4e245..14f50a57 100644 --- a/base/internals/psi_sswaptran.F90 +++ b/base/internals/psi_sswaptran.F90 @@ -320,8 +320,8 @@ subroutine psi_stranidxm(iictxt,iicomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,wo ! swap elements using mpi_alltoallv call mpi_alltoallv(rcvbuf,rvsz,brvidx,& - & mpi_real,& - & sndbuf,sdsz,bsdidx,mpi_real,icomm,iret) + & psb_mpi_r_spk_,& + & sndbuf,sdsz,bsdidx,psb_mpi_r_spk_,icomm,iret) if(iret /= mpi_success) then ierr(1) = iret info=psb_err_mpi_error_ @@ -378,7 +378,7 @@ subroutine psi_stranidxm(iictxt,iicomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,wo if ((nesd>0).and.(proc_to_comm /= me)) then p2ptag = psb_real_swap_tag call mpi_irecv(sndbuf(snd_pt),n*nesd,& - & mpi_real,prcid(i),& + & psb_mpi_r_spk_,prcid(i),& & p2ptag,icomm,rvhd(i),iret) end if rcv_pt = rcv_pt + n*nerv @@ -402,11 +402,11 @@ subroutine psi_stranidxm(iictxt,iicomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,wo p2ptag = psb_real_swap_tag if (usersend) then call mpi_rsend(rcvbuf(rcv_pt),n*nerv,& - & mpi_real,prcid(i),& + & psb_mpi_r_spk_,prcid(i),& & p2ptag,icomm,iret) else call mpi_send(rcvbuf(rcv_pt),n*nerv,& - & mpi_real,prcid(i),& + & psb_mpi_r_spk_,prcid(i),& & p2ptag,icomm,iret) end if @@ -824,8 +824,8 @@ subroutine psi_stranidxv(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,work ! swap elements using mpi_alltoallv call mpi_alltoallv(rcvbuf,rvsz,brvidx,& - & mpi_real,& - & sndbuf,sdsz,bsdidx,mpi_real,icomm,iret) + & psb_mpi_r_spk_,& + & sndbuf,sdsz,bsdidx,psb_mpi_r_spk_,icomm,iret) if(iret /= mpi_success) then ierr(1) = iret info=psb_err_mpi_error_ @@ -882,7 +882,7 @@ subroutine psi_stranidxv(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,work if ((nesd>0).and.(proc_to_comm /= me)) then p2ptag = psb_real_swap_tag call mpi_irecv(sndbuf(snd_pt),nesd,& - & mpi_real,prcid(i),& + & psb_mpi_r_spk_,prcid(i),& & p2ptag,icomm,rvhd(i),iret) end if rcv_pt = rcv_pt + nerv @@ -906,11 +906,11 @@ subroutine psi_stranidxv(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,work p2ptag = psb_real_swap_tag if (usersend) then call mpi_rsend(rcvbuf(rcv_pt),nerv,& - & mpi_real,prcid(i),& + & psb_mpi_r_spk_,prcid(i),& & p2ptag, icomm,iret) else call mpi_send(rcvbuf(rcv_pt),nerv,& - & mpi_real,prcid(i),& + & psb_mpi_r_spk_,prcid(i),& & p2ptag, icomm,iret) end if @@ -1273,8 +1273,8 @@ subroutine psi_stranidx_vect(iictxt,iicomm,flag,beta,y,idx,& ! swap elements using mpi_alltoallv call mpi_alltoallv(rcvbuf,rvsz,brvidx,& - & mpi_real,& - & sndbuf,sdsz,bsdidx,mpi_real,icomm,iret) + & psb_mpi_r_spk_,& + & sndbuf,sdsz,bsdidx,psb_mpi_r_spk_,icomm,iret) if(iret /= mpi_success) then ierr(1) = iret info=psb_err_mpi_error_ @@ -1331,7 +1331,7 @@ subroutine psi_stranidx_vect(iictxt,iicomm,flag,beta,y,idx,& if ((nesd>0).and.(proc_to_comm /= me)) then p2ptag = psb_real_swap_tag call mpi_irecv(sndbuf(snd_pt),nesd,& - & mpi_real,prcid(i),& + & psb_mpi_r_spk_,prcid(i),& & p2ptag,icomm,rvhd(i),iret) end if rcv_pt = rcv_pt + nerv @@ -1355,11 +1355,11 @@ subroutine psi_stranidx_vect(iictxt,iicomm,flag,beta,y,idx,& p2ptag = psb_real_swap_tag if (usersend) then call mpi_rsend(rcvbuf(rcv_pt),nerv,& - & mpi_real,prcid(i),& + & psb_mpi_r_spk_,prcid(i),& & p2ptag, icomm,iret) else call mpi_send(rcvbuf(rcv_pt),nerv,& - & mpi_real,prcid(i),& + & psb_mpi_r_spk_,prcid(i),& & p2ptag, icomm,iret) end if diff --git a/base/internals/psi_zswapdata.F90 b/base/internals/psi_zswapdata.F90 index e8a753a4..569a7ecf 100644 --- a/base/internals/psi_zswapdata.F90 +++ b/base/internals/psi_zswapdata.F90 @@ -302,8 +302,8 @@ subroutine psi_zswapidxm(iictxt,iicomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,wo ! swap elements using mpi_alltoallv call mpi_alltoallv(sndbuf,sdsz,bsdidx,& - & mpi_double_complex,rcvbuf,rvsz,& - & brvidx,mpi_double_complex,icomm,iret) + & psb_mpi_c_dpk_,rcvbuf,rvsz,& + & brvidx,psb_mpi_c_dpk_,icomm,iret) if(iret /= mpi_success) then ierr(1) = iret info=psb_err_mpi_error_ @@ -363,7 +363,7 @@ subroutine psi_zswapidxm(iictxt,iicomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,wo if ((nerv>0).and.(proc_to_comm /= me)) then p2ptag = psb_dcomplex_swap_tag call mpi_irecv(rcvbuf(rcv_pt),n*nerv,& - & mpi_double_complex,prcid(i),& + & psb_mpi_c_dpk_,prcid(i),& & p2ptag, icomm,rvhd(i),iret) end if rcv_pt = rcv_pt + n*nerv @@ -388,11 +388,11 @@ subroutine psi_zswapidxm(iictxt,iicomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,wo if ((nesd>0).and.(proc_to_comm /= me)) then if (usersend) then call mpi_rsend(sndbuf(snd_pt),n*nesd,& - & mpi_double_complex,prcid(i),& + & psb_mpi_c_dpk_,prcid(i),& & p2ptag,icomm,iret) else call mpi_send(sndbuf(snd_pt),n*nesd,& - & mpi_double_complex,prcid(i),& + & psb_mpi_c_dpk_,prcid(i),& & p2ptag,icomm,iret) end if @@ -801,8 +801,8 @@ subroutine psi_zswapidxv(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,work ! swap elements using mpi_alltoallv call mpi_alltoallv(sndbuf,sdsz,bsdidx,& - & mpi_double_complex,rcvbuf,rvsz,& - & brvidx,mpi_double_complex,icomm,iret) + & psb_mpi_c_dpk_,rcvbuf,rvsz,& + & brvidx,psb_mpi_c_dpk_,icomm,iret) if(iret /= mpi_success) then ierr(1) = iret info=psb_err_mpi_error_ @@ -859,7 +859,7 @@ subroutine psi_zswapidxv(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,work if ((nerv>0).and.(proc_to_comm /= me)) then p2ptag = psb_dcomplex_swap_tag call mpi_irecv(rcvbuf(rcv_pt),nerv,& - & mpi_double_complex,prcid(i),& + & psb_mpi_c_dpk_,prcid(i),& & p2ptag, icomm,rvhd(i),iret) end if rcv_pt = rcv_pt + nerv @@ -884,11 +884,11 @@ subroutine psi_zswapidxv(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,work if ((nesd>0).and.(proc_to_comm /= me)) then if (usersend) then call mpi_rsend(sndbuf(snd_pt),nesd,& - & mpi_double_complex,prcid(i),& + & psb_mpi_c_dpk_,prcid(i),& & p2ptag,icomm,iret) else call mpi_send(sndbuf(snd_pt),nesd,& - & mpi_double_complex,prcid(i),& + & psb_mpi_c_dpk_,prcid(i),& & p2ptag,icomm,iret) end if @@ -1238,8 +1238,8 @@ subroutine psi_zswapidx_vect(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv, ! swap elements using mpi_alltoallv call mpi_alltoallv(sndbuf,sdsz,bsdidx,& - & mpi_double_complex,rcvbuf,rvsz,& - & brvidx,mpi_double_complex,icomm,iret) + & psb_mpi_c_dpk_,rcvbuf,rvsz,& + & brvidx,psb_mpi_c_dpk_,icomm,iret) if(iret /= mpi_success) then ierr(1) = iret info=psb_err_mpi_error_ @@ -1296,7 +1296,7 @@ subroutine psi_zswapidx_vect(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv, if ((nerv>0).and.(proc_to_comm /= me)) then p2ptag = psb_dcomplex_swap_tag call mpi_irecv(rcvbuf(rcv_pt),nerv,& - & mpi_double_complex,prcid(i),& + & psb_mpi_c_dpk_,prcid(i),& & p2ptag, icomm,rvhd(i),iret) end if rcv_pt = rcv_pt + nerv @@ -1321,11 +1321,11 @@ subroutine psi_zswapidx_vect(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv, if ((nesd>0).and.(proc_to_comm /= me)) then if (usersend) then call mpi_rsend(sndbuf(snd_pt),nesd,& - & mpi_double_complex,prcid(i),& + & psb_mpi_c_dpk_,prcid(i),& & p2ptag,icomm,iret) else call mpi_send(sndbuf(snd_pt),nesd,& - & mpi_double_complex,prcid(i),& + & psb_mpi_c_dpk_,prcid(i),& & p2ptag,icomm,iret) end if diff --git a/base/internals/psi_zswaptran.F90 b/base/internals/psi_zswaptran.F90 index 7c62ec09..7e3f4e66 100644 --- a/base/internals/psi_zswaptran.F90 +++ b/base/internals/psi_zswaptran.F90 @@ -320,8 +320,8 @@ subroutine psi_ztranidxm(iictxt,iicomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,wo ! swap elements using mpi_alltoallv call mpi_alltoallv(rcvbuf,rvsz,brvidx,& - & mpi_double_complex,& - & sndbuf,sdsz,bsdidx,mpi_double_complex,icomm,iret) + & psb_mpi_c_dpk_,& + & sndbuf,sdsz,bsdidx,psb_mpi_c_dpk_,icomm,iret) if(iret /= mpi_success) then ierr(1) = iret info=psb_err_mpi_error_ @@ -378,7 +378,7 @@ subroutine psi_ztranidxm(iictxt,iicomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,wo if ((nesd>0).and.(proc_to_comm /= me)) then p2ptag = psb_dcomplex_swap_tag call mpi_irecv(sndbuf(snd_pt),n*nesd,& - & mpi_double_complex,prcid(i),& + & psb_mpi_c_dpk_,prcid(i),& & p2ptag,icomm,rvhd(i),iret) end if rcv_pt = rcv_pt + n*nerv @@ -402,11 +402,11 @@ subroutine psi_ztranidxm(iictxt,iicomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,wo p2ptag = psb_dcomplex_swap_tag if (usersend) then call mpi_rsend(rcvbuf(rcv_pt),n*nerv,& - & mpi_double_complex,prcid(i),& + & psb_mpi_c_dpk_,prcid(i),& & p2ptag,icomm,iret) else call mpi_send(rcvbuf(rcv_pt),n*nerv,& - & mpi_double_complex,prcid(i),& + & psb_mpi_c_dpk_,prcid(i),& & p2ptag,icomm,iret) end if @@ -824,8 +824,8 @@ subroutine psi_ztranidxv(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,work ! swap elements using mpi_alltoallv call mpi_alltoallv(rcvbuf,rvsz,brvidx,& - & mpi_double_complex,& - & sndbuf,sdsz,bsdidx,mpi_double_complex,icomm,iret) + & psb_mpi_c_dpk_,& + & sndbuf,sdsz,bsdidx,psb_mpi_c_dpk_,icomm,iret) if(iret /= mpi_success) then ierr(1) = iret info=psb_err_mpi_error_ @@ -882,7 +882,7 @@ subroutine psi_ztranidxv(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,work if ((nesd>0).and.(proc_to_comm /= me)) then p2ptag = psb_dcomplex_swap_tag call mpi_irecv(sndbuf(snd_pt),nesd,& - & mpi_double_complex,prcid(i),& + & psb_mpi_c_dpk_,prcid(i),& & p2ptag,icomm,rvhd(i),iret) end if rcv_pt = rcv_pt + nerv @@ -906,11 +906,11 @@ subroutine psi_ztranidxv(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,work p2ptag = psb_dcomplex_swap_tag if (usersend) then call mpi_rsend(rcvbuf(rcv_pt),nerv,& - & mpi_double_complex,prcid(i),& + & psb_mpi_c_dpk_,prcid(i),& & p2ptag, icomm,iret) else call mpi_send(rcvbuf(rcv_pt),nerv,& - & mpi_double_complex,prcid(i),& + & psb_mpi_c_dpk_,prcid(i),& & p2ptag, icomm,iret) end if @@ -1273,8 +1273,8 @@ subroutine psi_ztranidx_vect(iictxt,iicomm,flag,beta,y,idx,& ! swap elements using mpi_alltoallv call mpi_alltoallv(rcvbuf,rvsz,brvidx,& - & mpi_double_complex,& - & sndbuf,sdsz,bsdidx,mpi_double_complex,icomm,iret) + & psb_mpi_c_dpk_,& + & sndbuf,sdsz,bsdidx,psb_mpi_c_dpk_,icomm,iret) if(iret /= mpi_success) then ierr(1) = iret info=psb_err_mpi_error_ @@ -1331,7 +1331,7 @@ subroutine psi_ztranidx_vect(iictxt,iicomm,flag,beta,y,idx,& if ((nesd>0).and.(proc_to_comm /= me)) then p2ptag = psb_dcomplex_swap_tag call mpi_irecv(sndbuf(snd_pt),nesd,& - & mpi_double_complex,prcid(i),& + & psb_mpi_c_dpk_,prcid(i),& & p2ptag,icomm,rvhd(i),iret) end if rcv_pt = rcv_pt + nerv @@ -1355,11 +1355,11 @@ subroutine psi_ztranidx_vect(iictxt,iicomm,flag,beta,y,idx,& p2ptag = psb_dcomplex_swap_tag if (usersend) then call mpi_rsend(rcvbuf(rcv_pt),nerv,& - & mpi_double_complex,prcid(i),& + & psb_mpi_c_dpk_,prcid(i),& & p2ptag, icomm,iret) else call mpi_send(rcvbuf(rcv_pt),nerv,& - & mpi_double_complex,prcid(i),& + & psb_mpi_c_dpk_,prcid(i),& & p2ptag, icomm,iret) end if diff --git a/base/modules/psb_const_mod.F90 b/base/modules/psb_const_mod.F90 index 8d3446f9..c3beda08 100644 --- a/base/modules/psb_const_mod.F90 +++ b/base/modules/psb_const_mod.F90 @@ -47,8 +47,8 @@ module psb_const_mod ! This is always a 4-byte integer, for MPI-related stuff integer, parameter :: psb_mpik_ = kind(1) ! - ! These must be the kind parameter corresponding to MPI_DOUBLE_PRECISION - ! and MPI_REAL + ! These must be the kind parameter corresponding to psb_mpi_r_dpk_ + ! and psb_mpi_r_spk_ ! integer(psb_mpik_), parameter :: psb_spk_p_ = 6 integer(psb_mpik_), parameter :: psb_spk_r_ = 37 diff --git a/base/modules/psb_i_tools_mod.f90 b/base/modules/psb_i_tools_mod.f90 index 0bc878c5..ba5d6a74 100644 --- a/base/modules/psb_i_tools_mod.f90 +++ b/base/modules/psb_i_tools_mod.f90 @@ -146,7 +146,7 @@ module psb_i_tools_mod interface psb_glob_to_loc - subroutine psb_glob_to_loc2(x,y,desc_a,info,iact,owned) + subroutine psb_glob_to_loc2v(x,y,desc_a,info,iact,owned) import :: psb_ipk_, psb_desc_type type(psb_desc_type), intent(in) :: desc_a integer(psb_ipk_),intent(in) :: x(:) @@ -154,15 +154,15 @@ module psb_i_tools_mod integer(psb_ipk_), intent(out) :: info logical, intent(in), optional :: owned character, intent(in), optional :: iact - end subroutine psb_glob_to_loc2 - subroutine psb_glob_to_loc(x,desc_a,info,iact,owned) + end subroutine psb_glob_to_loc2v + subroutine psb_glob_to_loc1v(x,desc_a,info,iact,owned) import :: psb_ipk_, psb_desc_type type(psb_desc_type), intent(in) :: desc_a integer(psb_ipk_),intent(inout) :: x(:) integer(psb_ipk_), intent(out) :: info logical, intent(in), optional :: owned character, intent(in), optional :: iact - end subroutine psb_glob_to_loc + end subroutine psb_glob_to_loc1v subroutine psb_glob_to_loc2s(x,y,desc_a,info,iact,owned) import :: psb_ipk_, psb_desc_type implicit none @@ -172,10 +172,8 @@ module psb_i_tools_mod integer(psb_ipk_), intent(out) :: info character, intent(in), optional :: iact logical, intent(in), optional :: owned - end subroutine psb_glob_to_loc2s - - subroutine psb_glob_to_locs(x,desc_a,info,iact,owned) + subroutine psb_glob_to_loc1s(x,desc_a,info,iact,owned) import :: psb_ipk_, psb_desc_type implicit none type(psb_desc_type), intent(in) :: desc_a @@ -183,25 +181,25 @@ module psb_i_tools_mod integer(psb_ipk_), intent(out) :: info character, intent(in), optional :: iact logical, intent(in), optional :: owned - end subroutine psb_glob_to_locs + end subroutine psb_glob_to_loc1s end interface interface psb_loc_to_glob - subroutine psb_loc_to_glob2(x,y,desc_a,info,iact) + subroutine psb_loc_to_glob2v(x,y,desc_a,info,iact) import :: psb_ipk_, psb_desc_type type(psb_desc_type), intent(in) :: desc_a integer(psb_ipk_),intent(in) :: x(:) integer(psb_ipk_),intent(out) :: y(:) integer(psb_ipk_), intent(out) :: info character, intent(in), optional :: iact - end subroutine psb_loc_to_glob2 - subroutine psb_loc_to_glob(x,desc_a,info,iact) + end subroutine psb_loc_to_glob2v + subroutine psb_loc_to_glob1v(x,desc_a,info,iact) import :: psb_ipk_, psb_desc_type type(psb_desc_type), intent(in) :: desc_a integer(psb_ipk_),intent(inout) :: x(:) integer(psb_ipk_), intent(out) :: info character, intent(in), optional :: iact - end subroutine psb_loc_to_glob + end subroutine psb_loc_to_glob1v subroutine psb_loc_to_glob2s(x,y,desc_a,info,iact) import :: psb_ipk_, psb_desc_type implicit none @@ -210,15 +208,14 @@ module psb_i_tools_mod integer(psb_ipk_),intent(out) :: y integer(psb_ipk_), intent(out) :: info character, intent(in), optional :: iact - end subroutine psb_loc_to_glob2s - subroutine psb_loc_to_globs(x,desc_a,info,iact) + subroutine psb_loc_to_glob1s(x,desc_a,info,iact) import :: psb_ipk_, psb_desc_type type(psb_desc_type), intent(in) :: desc_a integer(psb_ipk_),intent(inout) :: x integer(psb_ipk_), intent(out) :: info character, intent(in), optional :: iact - end subroutine psb_loc_to_globs + end subroutine psb_loc_to_glob1s end interface diff --git a/base/modules/psi_bcast_mod.F90 b/base/modules/psi_bcast_mod.F90 index 0faabf27..f5045d3c 100644 --- a/base/modules/psi_bcast_mod.F90 +++ b/base/modules/psi_bcast_mod.F90 @@ -169,7 +169,7 @@ contains endif call psb_info(ictxt,iam,np) - call mpi_bcast(dat,1,mpi_real,root_,ictxt,info) + call mpi_bcast(dat,1,psb_mpi_r_spk_,root_,ictxt,info) #endif end subroutine psb_sbcasts @@ -196,7 +196,7 @@ contains endif call psb_info(ictxt,iam,np) - call mpi_bcast(dat,size(dat),mpi_real,root_,ictxt,info) + call mpi_bcast(dat,size(dat),psb_mpi_r_spk_,root_,ictxt,info) #endif end subroutine psb_sbcastv @@ -223,7 +223,7 @@ contains endif call psb_info(ictxt,iam,np) - call mpi_bcast(dat,size(dat),mpi_real,root_,ictxt,info) + call mpi_bcast(dat,size(dat),psb_mpi_r_spk_,root_,ictxt,info) #endif end subroutine psb_sbcastm @@ -251,7 +251,7 @@ contains endif call psb_info(ictxt,iam,np) - call mpi_bcast(dat,1,mpi_double_precision,root_,ictxt,info) + call mpi_bcast(dat,1,psb_mpi_r_dpk_,root_,ictxt,info) #endif end subroutine psb_dbcasts @@ -278,7 +278,7 @@ contains endif call psb_info(ictxt,iam,np) - call mpi_bcast(dat,size(dat),mpi_double_precision,root_,ictxt,info) + call mpi_bcast(dat,size(dat),psb_mpi_r_dpk_,root_,ictxt,info) #endif end subroutine psb_dbcastv @@ -304,7 +304,7 @@ contains endif call psb_info(ictxt,iam,np) - call mpi_bcast(dat,size(dat),mpi_double_precision,root_,ictxt,info) + call mpi_bcast(dat,size(dat),psb_mpi_r_dpk_,root_,ictxt,info) #endif end subroutine psb_dbcastm @@ -330,7 +330,7 @@ contains endif call psb_info(ictxt,iam,np) - call mpi_bcast(dat,1,mpi_complex,root_,ictxt,info) + call mpi_bcast(dat,1,psb_mpi_c_spk_,root_,ictxt,info) #endif end subroutine psb_cbcasts @@ -356,7 +356,7 @@ contains endif call psb_info(ictxt,iam,np) - call mpi_bcast(dat,size(dat),mpi_complex,root_,ictxt,info) + call mpi_bcast(dat,size(dat),psb_mpi_c_spk_,root_,ictxt,info) #endif end subroutine psb_cbcastv @@ -382,7 +382,7 @@ contains endif call psb_info(ictxt,iam,np) - call mpi_bcast(dat,size(dat),mpi_complex,root_,ictxt,info) + call mpi_bcast(dat,size(dat),psb_mpi_c_spk_,root_,ictxt,info) #endif end subroutine psb_cbcastm @@ -408,7 +408,7 @@ contains endif call psb_info(ictxt,iam,np) - call mpi_bcast(dat,1,mpi_double_complex,root_,ictxt,info) + call mpi_bcast(dat,1,psb_mpi_c_dpk_,root_,ictxt,info) #endif end subroutine psb_zbcasts @@ -434,7 +434,7 @@ contains endif call psb_info(ictxt,iam,np) - call mpi_bcast(dat,size(dat),mpi_double_complex,root_,ictxt,info) + call mpi_bcast(dat,size(dat),psb_mpi_c_dpk_,root_,ictxt,info) #endif end subroutine psb_zbcastv @@ -460,7 +460,7 @@ contains endif call psb_info(ictxt,iam,np) - call mpi_bcast(dat,size(dat),mpi_double_complex,root_,ictxt,info) + call mpi_bcast(dat,size(dat),psb_mpi_c_dpk_,root_,ictxt,info) #endif end subroutine psb_zbcastm diff --git a/base/modules/psi_comm_buffers_mod.F90 b/base/modules/psi_comm_buffers_mod.F90 index eaa7541a..f9b57834 100644 --- a/base/modules/psi_comm_buffers_mod.F90 +++ b/base/modules/psi_comm_buffers_mod.F90 @@ -38,10 +38,10 @@ module mpi integer(psb_mpik_), parameter :: mpi_status_size = 1 integer(psb_mpik_), parameter :: mpi_integer = 1 integer(psb_mpik_), parameter :: mpi_integer8 = 2 - integer(psb_mpik_), parameter :: mpi_real = 3 - integer(psb_mpik_), parameter :: mpi_double_precision = 4 - integer(psb_mpik_), parameter :: mpi_complex = 5 - integer(psb_mpik_), parameter :: mpi_double_complex = 6 + integer(psb_mpik_), parameter :: psb_mpi_r_spk_ = 3 + integer(psb_mpik_), parameter :: psb_mpi_r_dpk_ = 4 + integer(psb_mpik_), parameter :: psb_mpi_c_spk_ = 5 + integer(psb_mpik_), parameter :: psb_mpi_c_dpk_ = 6 integer(psb_mpik_), parameter :: mpi_character = 7 integer(psb_mpik_), parameter :: mpi_logical = 8 integer(psb_mpik_), parameter :: mpi_integer2 = 9 @@ -446,7 +446,7 @@ contains write(psb_err_unit,*) 'Fatal memory error inside communication subsystem' return end if - call mpi_isend(node%realbuf,size(node%realbuf),mpi_real,& + call mpi_isend(node%realbuf,size(node%realbuf),psb_mpi_r_spk_,& & dest,tag,icontxt,node%request,minfo) info = minfo call psb_insert_node(mesg_queue,node) @@ -482,7 +482,7 @@ contains write(psb_err_unit,*) 'Fatal memory error inside communication subsystem' return end if - call mpi_isend(node%doublebuf,size(node%doublebuf),mpi_double_precision,& + call mpi_isend(node%doublebuf,size(node%doublebuf),psb_mpi_r_dpk_,& & dest,tag,icontxt,node%request,minfo) info = minfo call psb_insert_node(mesg_queue,node) @@ -518,7 +518,7 @@ contains write(psb_err_unit,*) 'Fatal memory error inside communication subsystem' return end if - call mpi_isend(node%complexbuf,size(node%complexbuf),mpi_complex,& + call mpi_isend(node%complexbuf,size(node%complexbuf),psb_mpi_c_spk_,& & dest,tag,icontxt,node%request,minfo) info = minfo call psb_insert_node(mesg_queue,node) @@ -554,7 +554,7 @@ contains write(psb_err_unit,*) 'Fatal memory error inside communication subsystem' return end if - call mpi_isend(node%dcomplbuf,size(node%dcomplbuf),mpi_double_complex,& + call mpi_isend(node%dcomplbuf,size(node%dcomplbuf),psb_mpi_c_dpk_,& & dest,tag,icontxt,node%request,minfo) 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 e81b6f5a..880647d2 100644 --- a/base/modules/psi_p2p_mod.F90 +++ b/base/modules/psi_p2p_mod.F90 @@ -1067,7 +1067,7 @@ contains #if defined(SERIAL_MPI) ! do nothing #else - call mpi_recv(dat,1,mpi_real,src,psb_real_tag,ictxt,status,info) + call mpi_recv(dat,1,psb_mpi_r_spk_,src,psb_real_tag,ictxt,status,info) call psb_test_nodes(psb_mesg_queue) #endif end subroutine psb_srcvs @@ -1090,7 +1090,7 @@ contains integer(psb_mpik_) :: status(mpi_status_size) #if defined(SERIAL_MPI) #else - call mpi_recv(dat,size(dat),mpi_real,src,psb_real_tag,ictxt,status,info) + call mpi_recv(dat,size(dat),psb_mpi_r_spk_,src,psb_real_tag,ictxt,status,info) call psb_test_nodes(psb_mesg_queue) #endif @@ -1121,13 +1121,13 @@ contains m_ = m ld = size(dat,1) n_ = size(dat,2) - call mpi_type_vector(n_,m_,ld,mpi_real,mp_rcv_type,info) + call mpi_type_vector(n_,m_,ld,psb_mpi_r_spk_,mp_rcv_type,info) if (info == mpi_success) call mpi_type_commit(mp_rcv_type,info) if (info == mpi_success) call mpi_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),mpi_real,src,psb_real_tag,ictxt,status,info) + call mpi_recv(dat,size(dat),psb_mpi_r_spk_,src,psb_real_tag,ictxt,status,info) end if if (info /= mpi_success) then write(psb_err_unit,*) 'Error in psb_recv', info @@ -1154,7 +1154,7 @@ contains #if defined(SERIAL_MPI) ! do nothing #else - call mpi_recv(dat,1,mpi_double_precision,src,psb_double_tag,ictxt,status,info) + call mpi_recv(dat,1,psb_mpi_r_dpk_,src,psb_double_tag,ictxt,status,info) call psb_test_nodes(psb_mesg_queue) #endif end subroutine psb_drcvs @@ -1177,7 +1177,7 @@ contains integer(psb_mpik_) :: status(mpi_status_size) #if defined(SERIAL_MPI) #else - call mpi_recv(dat,size(dat),mpi_double_precision,src,psb_double_tag,ictxt,status,info) + call mpi_recv(dat,size(dat),psb_mpi_r_dpk_,src,psb_double_tag,ictxt,status,info) call psb_test_nodes(psb_mesg_queue) #endif @@ -1208,13 +1208,13 @@ contains m_ = m ld = size(dat,1) n_ = size(dat,2) - call mpi_type_vector(n_,m_,ld,mpi_double_precision,mp_rcv_type,info) + call mpi_type_vector(n_,m_,ld,psb_mpi_r_dpk_,mp_rcv_type,info) if (info == mpi_success) call mpi_type_commit(mp_rcv_type,info) if (info == mpi_success) call mpi_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),mpi_double_precision,src,& + call mpi_recv(dat,size(dat),psb_mpi_r_dpk_,src,& & psb_double_tag,ictxt,status,info) end if if (info /= mpi_success) then @@ -1242,7 +1242,7 @@ contains #if defined(SERIAL_MPI) ! do nothing #else - call mpi_recv(dat,1,mpi_complex,src,psb_complex_tag,ictxt,status,info) + call mpi_recv(dat,1,psb_mpi_c_spk_,src,psb_complex_tag,ictxt,status,info) call psb_test_nodes(psb_mesg_queue) #endif end subroutine psb_crcvs @@ -1265,7 +1265,7 @@ contains integer(psb_mpik_) :: status(mpi_status_size) #if defined(SERIAL_MPI) #else - call mpi_recv(dat,size(dat),mpi_complex,src,psb_complex_tag,ictxt,status,info) + call mpi_recv(dat,size(dat),psb_mpi_c_spk_,src,psb_complex_tag,ictxt,status,info) call psb_test_nodes(psb_mesg_queue) #endif @@ -1296,13 +1296,13 @@ contains m_ = m ld = size(dat,1) n_ = size(dat,2) - call mpi_type_vector(n_,m_,ld,mpi_complex,mp_rcv_type,info) + call mpi_type_vector(n_,m_,ld,psb_mpi_c_spk_,mp_rcv_type,info) if (info == mpi_success) call mpi_type_commit(mp_rcv_type,info) if (info == mpi_success) call mpi_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),mpi_complex,src,& + call mpi_recv(dat,size(dat),psb_mpi_c_spk_,src,& & psb_complex_tag,ictxt,status,info) end if if (info /= mpi_success) then @@ -1330,7 +1330,7 @@ contains #if defined(SERIAL_MPI) ! do nothing #else - call mpi_recv(dat,1,mpi_double_complex,src,psb_dcomplex_tag,ictxt,status,info) + call mpi_recv(dat,1,psb_mpi_c_dpk_,src,psb_dcomplex_tag,ictxt,status,info) call psb_test_nodes(psb_mesg_queue) #endif end subroutine psb_zrcvs @@ -1353,7 +1353,7 @@ contains integer(psb_mpik_) :: status(mpi_status_size) #if defined(SERIAL_MPI) #else - call mpi_recv(dat,size(dat),mpi_double_complex,src,psb_dcomplex_tag,ictxt,status,info) + call mpi_recv(dat,size(dat),psb_mpi_c_dpk_,src,psb_dcomplex_tag,ictxt,status,info) call psb_test_nodes(psb_mesg_queue) #endif @@ -1384,13 +1384,13 @@ contains m_ = m ld = size(dat,1) n_ = size(dat,2) - call mpi_type_vector(n_,m_,ld,mpi_double_complex,mp_rcv_type,info) + call mpi_type_vector(n_,m_,ld,psb_mpi_c_dpk_,mp_rcv_type,info) if (info == mpi_success) call mpi_type_commit(mp_rcv_type,info) if (info == mpi_success) call mpi_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),mpi_double_complex,src,& + call mpi_recv(dat,size(dat),psb_mpi_c_dpk_,src,& & psb_dcomplex_tag,ictxt,status,info) end if if (info /= mpi_success) then diff --git a/base/modules/psi_reduce_mod.F90 b/base/modules/psi_reduce_mod.F90 index 582bca26..4e50e65e 100644 --- a/base/modules/psi_reduce_mod.F90 +++ b/base/modules/psi_reduce_mod.F90 @@ -601,10 +601,10 @@ contains root_ = -1 endif if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,mpi_real,mpi_max,ictxt,info) + call mpi_allreduce(dat,dat_,1,psb_mpi_r_spk_,mpi_max,ictxt,info) dat = dat_ else - call mpi_reduce(dat,dat_,1,mpi_real,mpi_max,root_,ictxt,info) + call mpi_reduce(dat,dat_,1,psb_mpi_r_spk_,mpi_max,root_,ictxt,info) dat = dat_ endif #endif @@ -640,15 +640,15 @@ contains call psb_realloc(size(dat),dat_,iinfo) dat_ = dat if (iinfo == psb_success_) & - & call mpi_allreduce(dat_,dat,size(dat),mpi_real,mpi_max,ictxt,info) + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_max,ictxt,info) else if (iam == root_) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),mpi_real,mpi_max,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_max,root_,ictxt,info) else call psb_realloc(1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),mpi_real,mpi_max,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_spk_,mpi_max,root_,ictxt,info) end if endif #endif @@ -684,15 +684,15 @@ contains call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat if (iinfo == psb_success_)& - & call mpi_allreduce(dat_,dat,size(dat),mpi_real,mpi_max,ictxt,info) + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_max,ictxt,info) else if (iam == root_) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),mpi_real,mpi_max,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_max,root_,ictxt,info) else call psb_realloc(1,1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),mpi_real,mpi_max,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_spk_,mpi_max,root_,ictxt,info) end if endif #endif @@ -724,10 +724,10 @@ contains root_ = -1 endif if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,mpi_double_precision,mpi_max,ictxt,info) + call mpi_allreduce(dat,dat_,1,psb_mpi_r_dpk_,mpi_max,ictxt,info) dat = dat_ else - call mpi_reduce(dat,dat_,1,mpi_double_precision,mpi_max,root_,ictxt,info) + call mpi_reduce(dat,dat_,1,psb_mpi_r_dpk_,mpi_max,root_,ictxt,info) dat = dat_ endif #endif @@ -763,16 +763,16 @@ contains call psb_realloc(size(dat),dat_,iinfo) dat_ = dat if (iinfo == psb_success_) & - & call mpi_allreduce(dat_,dat,size(dat),mpi_double_precision,& + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_dpk_,& & mpi_max,ictxt,info) else if (iam == root_) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),mpi_double_precision,mpi_max,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_dpk_,mpi_max,root_,ictxt,info) else call psb_realloc(1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),mpi_double_precision,mpi_max,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_dpk_,mpi_max,root_,ictxt,info) end if endif #endif @@ -808,15 +808,15 @@ contains call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat if (iinfo == psb_success_)& - & call mpi_allreduce(dat_,dat,size(dat),mpi_double_precision,mpi_max,ictxt,info) + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_dpk_,mpi_max,ictxt,info) else if (iam == root_) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),mpi_double_precision,mpi_max,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_dpk_,mpi_max,root_,ictxt,info) else call psb_realloc(1,1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),mpi_double_precision,mpi_max,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_dpk_,mpi_max,root_,ictxt,info) end if endif #endif @@ -1233,10 +1233,10 @@ contains root_ = -1 endif if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,mpi_real,mpi_min,ictxt,info) + call mpi_allreduce(dat,dat_,1,psb_mpi_r_spk_,mpi_min,ictxt,info) dat = dat_ else - call mpi_reduce(dat,dat_,1,mpi_real,mpi_min,root_,ictxt,info) + call mpi_reduce(dat,dat_,1,psb_mpi_r_spk_,mpi_min,root_,ictxt,info) dat = dat_ endif #endif @@ -1272,15 +1272,15 @@ contains call psb_realloc(size(dat),dat_,iinfo) dat_ = dat if (iinfo == psb_success_) & - & call mpi_allreduce(dat_,dat,size(dat),mpi_real,mpi_min,ictxt,info) + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_min,ictxt,info) else if (iam == root_) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),mpi_real,mpi_min,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_min,root_,ictxt,info) else call psb_realloc(1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),mpi_real,mpi_min,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_spk_,mpi_min,root_,ictxt,info) end if endif #endif @@ -1316,15 +1316,15 @@ contains call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat if (iinfo == psb_success_)& - & call mpi_allreduce(dat_,dat,size(dat),mpi_real,mpi_min,ictxt,info) + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_min,ictxt,info) else if (iam == root_) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),mpi_real,mpi_min,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_min,root_,ictxt,info) else call psb_realloc(1,1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),mpi_real,mpi_min,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_spk_,mpi_min,root_,ictxt,info) end if endif #endif @@ -1356,10 +1356,10 @@ contains root_ = -1 endif if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,mpi_double_precision,mpi_min,ictxt,info) + call mpi_allreduce(dat,dat_,1,psb_mpi_r_dpk_,mpi_min,ictxt,info) dat = dat_ else - call mpi_reduce(dat,dat_,1,mpi_double_precision,mpi_min,root_,ictxt,info) + call mpi_reduce(dat,dat_,1,psb_mpi_r_dpk_,mpi_min,root_,ictxt,info) dat = dat_ endif #endif @@ -1395,16 +1395,16 @@ contains call psb_realloc(size(dat),dat_,iinfo) dat_ = dat if (iinfo == psb_success_) & - & call mpi_allreduce(dat_,dat,size(dat),mpi_double_precision,& + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_dpk_,& & mpi_min,ictxt,info) else if (iam == root_) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),mpi_double_precision,mpi_min,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_dpk_,mpi_min,root_,ictxt,info) else call psb_realloc(1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),mpi_double_precision,mpi_min,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_dpk_,mpi_min,root_,ictxt,info) end if endif #endif @@ -1440,15 +1440,15 @@ contains call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat if (iinfo == psb_success_)& - & call mpi_allreduce(dat_,dat,size(dat),mpi_double_precision,mpi_min,ictxt,info) + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_dpk_,mpi_min,ictxt,info) else if (iam == root_) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),mpi_double_precision,mpi_min,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_dpk_,mpi_min,root_,ictxt,info) else call psb_realloc(1,1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),mpi_double_precision,mpi_min,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_dpk_,mpi_min,root_,ictxt,info) end if endif #endif @@ -1872,10 +1872,10 @@ contains root_ = -1 endif if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,mpi_real,mpi_samx_op,ictxt,info) + call mpi_allreduce(dat,dat_,1,psb_mpi_r_spk_,mpi_samx_op,ictxt,info) dat = dat_ else - call mpi_reduce(dat,dat_,1,mpi_real,mpi_samx_op,root_,ictxt,info) + call mpi_reduce(dat,dat_,1,psb_mpi_r_spk_,mpi_samx_op,root_,ictxt,info) dat = dat_ endif #endif @@ -1911,15 +1911,15 @@ contains call psb_realloc(size(dat),dat_,iinfo) dat_ = dat if (iinfo == psb_success_) & - & call mpi_allreduce(dat_,dat,size(dat),mpi_real,mpi_samx_op,ictxt,info) + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_samx_op,ictxt,info) else if (iam == root_) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),mpi_real,mpi_samx_op,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_samx_op,root_,ictxt,info) else call psb_realloc(1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),mpi_real,mpi_samx_op,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_spk_,mpi_samx_op,root_,ictxt,info) end if endif #endif @@ -1955,15 +1955,15 @@ contains call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat if (iinfo == psb_success_)& - & call mpi_allreduce(dat_,dat,size(dat),mpi_real,mpi_samx_op,ictxt,info) + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_samx_op,ictxt,info) else if (iam == root_) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),mpi_real,mpi_samx_op,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_samx_op,root_,ictxt,info) else call psb_realloc(1,1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),mpi_real,mpi_samx_op,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_spk_,mpi_samx_op,root_,ictxt,info) end if endif #endif @@ -1995,10 +1995,10 @@ contains root_ = -1 endif if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,mpi_double_precision,mpi_damx_op,ictxt,info) + call mpi_allreduce(dat,dat_,1,psb_mpi_r_dpk_,mpi_damx_op,ictxt,info) dat = dat_ else - call mpi_reduce(dat,dat_,1,mpi_double_precision,mpi_damx_op,root_,ictxt,info) + call mpi_reduce(dat,dat_,1,psb_mpi_r_dpk_,mpi_damx_op,root_,ictxt,info) dat = dat_ endif #endif @@ -2034,16 +2034,16 @@ contains call psb_realloc(size(dat),dat_,iinfo) dat_ = dat if (iinfo == psb_success_) & - & call mpi_allreduce(dat_,dat,size(dat),mpi_double_precision,& + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_dpk_,& & mpi_damx_op,ictxt,info) else if (iam == root_) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),mpi_double_precision,mpi_damx_op,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_dpk_,mpi_damx_op,root_,ictxt,info) else call psb_realloc(1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),mpi_double_precision,mpi_damx_op,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_dpk_,mpi_damx_op,root_,ictxt,info) end if endif #endif @@ -2079,15 +2079,15 @@ contains call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat if (iinfo == psb_success_)& - & call mpi_allreduce(dat_,dat,size(dat),mpi_double_precision,mpi_damx_op,ictxt,info) + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_dpk_,mpi_damx_op,ictxt,info) else if (iam == root_) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),mpi_double_precision,mpi_damx_op,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_dpk_,mpi_damx_op,root_,ictxt,info) else call psb_realloc(1,1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),mpi_double_precision,mpi_damx_op,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_dpk_,mpi_damx_op,root_,ictxt,info) end if endif #endif @@ -2120,10 +2120,10 @@ contains root_ = -1 endif if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,mpi_complex,mpi_camx_op,ictxt,info) + call mpi_allreduce(dat,dat_,1,psb_mpi_c_spk_,mpi_camx_op,ictxt,info) dat = dat_ else - call mpi_reduce(dat,dat_,1,mpi_complex,mpi_camx_op,root_,ictxt,info) + call mpi_reduce(dat,dat_,1,psb_mpi_c_spk_,mpi_camx_op,root_,ictxt,info) dat = dat_ endif #endif @@ -2159,15 +2159,15 @@ contains call psb_realloc(size(dat),dat_,iinfo) dat_ = dat if (iinfo == psb_success_) & - & call mpi_allreduce(dat_,dat,size(dat),mpi_complex,mpi_camx_op,ictxt,info) + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_camx_op,ictxt,info) else if (iam == root_) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),mpi_complex,mpi_camx_op,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_camx_op,root_,ictxt,info) else call psb_realloc(1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),mpi_complex,mpi_camx_op,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_spk_,mpi_camx_op,root_,ictxt,info) end if endif #endif @@ -2203,15 +2203,15 @@ contains call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat if (iinfo == psb_success_)& - & call mpi_allreduce(dat_,dat,size(dat),mpi_complex,mpi_camx_op,ictxt,info) + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_camx_op,ictxt,info) else if (iam == root_) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),mpi_complex,mpi_camx_op,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_camx_op,root_,ictxt,info) else call psb_realloc(1,1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),mpi_complex,mpi_camx_op,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_spk_,mpi_camx_op,root_,ictxt,info) end if endif #endif @@ -2243,10 +2243,10 @@ contains root_ = -1 endif if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,mpi_double_complex,mpi_zamx_op,ictxt,info) + call mpi_allreduce(dat,dat_,1,psb_mpi_c_dpk_,mpi_zamx_op,ictxt,info) dat = dat_ else - call mpi_reduce(dat,dat_,1,mpi_double_complex,mpi_zamx_op,root_,ictxt,info) + call mpi_reduce(dat,dat_,1,psb_mpi_c_dpk_,mpi_zamx_op,root_,ictxt,info) dat = dat_ endif #endif @@ -2282,16 +2282,16 @@ contains call psb_realloc(size(dat),dat_,iinfo) dat_ = dat if (iinfo == psb_success_) & - & call mpi_allreduce(dat_,dat,size(dat),mpi_double_complex,& + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_dpk_,& & mpi_zamx_op,ictxt,info) else if (iam == root_) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),mpi_double_complex,mpi_zamx_op,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_zamx_op,root_,ictxt,info) else call psb_realloc(1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),mpi_double_complex,mpi_zamx_op,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_dpk_,mpi_zamx_op,root_,ictxt,info) end if endif #endif @@ -2327,15 +2327,15 @@ contains call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat if (iinfo == psb_success_)& - & call mpi_allreduce(dat_,dat,size(dat),mpi_double_complex,mpi_zamx_op,ictxt,info) + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_zamx_op,ictxt,info) else if (iam == root_) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),mpi_double_complex,mpi_zamx_op,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_zamx_op,root_,ictxt,info) else call psb_realloc(1,1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),mpi_double_complex,mpi_zamx_op,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_dpk_,mpi_zamx_op,root_,ictxt,info) end if endif #endif @@ -2759,10 +2759,10 @@ contains root_ = -1 endif if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,mpi_real,mpi_samn_op,ictxt,info) + call mpi_allreduce(dat,dat_,1,psb_mpi_r_spk_,mpi_samn_op,ictxt,info) dat = dat_ else - call mpi_reduce(dat,dat_,1,mpi_real,mpi_samn_op,root_,ictxt,info) + call mpi_reduce(dat,dat_,1,psb_mpi_r_spk_,mpi_samn_op,root_,ictxt,info) dat = dat_ endif #endif @@ -2798,15 +2798,15 @@ contains call psb_realloc(size(dat),dat_,iinfo) dat_ = dat if (iinfo == psb_success_) & - & call mpi_allreduce(dat_,dat,size(dat),mpi_real,mpi_samn_op,ictxt,info) + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_samn_op,ictxt,info) else if (iam == root_) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),mpi_real,mpi_samn_op,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_samn_op,root_,ictxt,info) else call psb_realloc(1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),mpi_real,mpi_samn_op,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_spk_,mpi_samn_op,root_,ictxt,info) end if endif #endif @@ -2842,15 +2842,15 @@ contains call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat if (iinfo == psb_success_)& - & call mpi_allreduce(dat_,dat,size(dat),mpi_real,mpi_samn_op,ictxt,info) + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_samn_op,ictxt,info) else if (iam == root_) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),mpi_real,mpi_samn_op,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_samn_op,root_,ictxt,info) else call psb_realloc(1,1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),mpi_real,mpi_samn_op,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_spk_,mpi_samn_op,root_,ictxt,info) end if endif #endif @@ -2882,10 +2882,10 @@ contains root_ = -1 endif if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,mpi_double_precision,mpi_damn_op,ictxt,info) + call mpi_allreduce(dat,dat_,1,psb_mpi_r_dpk_,mpi_damn_op,ictxt,info) dat = dat_ else - call mpi_reduce(dat,dat_,1,mpi_double_precision,mpi_damn_op,root_,ictxt,info) + call mpi_reduce(dat,dat_,1,psb_mpi_r_dpk_,mpi_damn_op,root_,ictxt,info) dat = dat_ endif #endif @@ -2921,16 +2921,16 @@ contains call psb_realloc(size(dat),dat_,iinfo) dat_ = dat if (iinfo == psb_success_) & - & call mpi_allreduce(dat_,dat,size(dat),mpi_double_precision,& + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_dpk_,& & mpi_damn_op,ictxt,info) else if (iam == root_) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),mpi_double_precision,mpi_damn_op,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_dpk_,mpi_damn_op,root_,ictxt,info) else call psb_realloc(1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),mpi_double_precision,mpi_damn_op,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_dpk_,mpi_damn_op,root_,ictxt,info) end if endif #endif @@ -2966,15 +2966,15 @@ contains call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat if (iinfo == psb_success_)& - & call mpi_allreduce(dat_,dat,size(dat),mpi_double_precision,mpi_damn_op,ictxt,info) + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_dpk_,mpi_damn_op,ictxt,info) else if (iam == root_) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),mpi_double_precision,mpi_damn_op,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_dpk_,mpi_damn_op,root_,ictxt,info) else call psb_realloc(1,1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),mpi_double_precision,mpi_damn_op,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_dpk_,mpi_damn_op,root_,ictxt,info) end if endif #endif @@ -3007,10 +3007,10 @@ contains root_ = -1 endif if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,mpi_complex,mpi_camn_op,ictxt,info) + call mpi_allreduce(dat,dat_,1,psb_mpi_c_spk_,mpi_camn_op,ictxt,info) dat = dat_ else - call mpi_reduce(dat,dat_,1,mpi_complex,mpi_camn_op,root_,ictxt,info) + call mpi_reduce(dat,dat_,1,psb_mpi_c_spk_,mpi_camn_op,root_,ictxt,info) dat = dat_ endif #endif @@ -3046,15 +3046,15 @@ contains call psb_realloc(size(dat),dat_,iinfo) dat_ = dat if (iinfo == psb_success_) & - & call mpi_allreduce(dat_,dat,size(dat),mpi_complex,mpi_camn_op,ictxt,info) + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_camn_op,ictxt,info) else if (iam == root_) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),mpi_complex,mpi_camn_op,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_camn_op,root_,ictxt,info) else call psb_realloc(1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),mpi_complex,mpi_camn_op,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_spk_,mpi_camn_op,root_,ictxt,info) end if endif #endif @@ -3090,15 +3090,15 @@ contains call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat if (iinfo == psb_success_)& - & call mpi_allreduce(dat_,dat,size(dat),mpi_complex,mpi_camn_op,ictxt,info) + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_camn_op,ictxt,info) else if (iam == root_) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),mpi_complex,mpi_camn_op,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_camn_op,root_,ictxt,info) else call psb_realloc(1,1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),mpi_complex,mpi_camn_op,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_spk_,mpi_camn_op,root_,ictxt,info) end if endif #endif @@ -3130,10 +3130,10 @@ contains root_ = -1 endif if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,mpi_double_complex,mpi_zamn_op,ictxt,info) + call mpi_allreduce(dat,dat_,1,psb_mpi_c_dpk_,mpi_zamn_op,ictxt,info) dat = dat_ else - call mpi_reduce(dat,dat_,1,mpi_double_complex,mpi_zamn_op,root_,ictxt,info) + call mpi_reduce(dat,dat_,1,psb_mpi_c_dpk_,mpi_zamn_op,root_,ictxt,info) dat = dat_ endif #endif @@ -3169,16 +3169,16 @@ contains call psb_realloc(size(dat),dat_,iinfo) dat_ = dat if (iinfo == psb_success_) & - & call mpi_allreduce(dat_,dat,size(dat),mpi_double_complex,& + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_dpk_,& & mpi_zamn_op,ictxt,info) else if (iam == root_) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),mpi_double_complex,mpi_zamn_op,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_zamn_op,root_,ictxt,info) else call psb_realloc(1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),mpi_double_complex,mpi_zamn_op,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_dpk_,mpi_zamn_op,root_,ictxt,info) end if endif #endif @@ -3214,15 +3214,15 @@ contains call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat if (iinfo == psb_success_)& - & call mpi_allreduce(dat_,dat,size(dat),mpi_double_complex,mpi_zamn_op,ictxt,info) + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_zamn_op,ictxt,info) else if (iam == root_) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),mpi_double_complex,mpi_zamn_op,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_zamn_op,root_,ictxt,info) else call psb_realloc(1,1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),mpi_double_complex,mpi_zamn_op,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_dpk_,mpi_zamn_op,root_,ictxt,info) end if endif #endif @@ -3773,10 +3773,10 @@ contains root_ = -1 endif if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,mpi_real,mpi_sum,ictxt,info) + call mpi_allreduce(dat,dat_,1,psb_mpi_r_spk_,mpi_sum,ictxt,info) dat = dat_ else - call mpi_reduce(dat,dat_,1,mpi_real,mpi_sum,root_,ictxt,info) + call mpi_reduce(dat,dat_,1,psb_mpi_r_spk_,mpi_sum,root_,ictxt,info) dat = dat_ endif #endif @@ -3812,15 +3812,15 @@ contains call psb_realloc(size(dat),dat_,iinfo) dat_ = dat if (iinfo == psb_success_) & - & call mpi_allreduce(dat_,dat,size(dat),mpi_real,mpi_sum,ictxt,info) + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_sum,ictxt,info) else if (iam == root_) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),mpi_real,mpi_sum,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_sum,root_,ictxt,info) else call psb_realloc(1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),mpi_real,mpi_sum,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_spk_,mpi_sum,root_,ictxt,info) end if endif #endif @@ -3856,15 +3856,15 @@ contains call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat if (iinfo == psb_success_)& - & call mpi_allreduce(dat_,dat,size(dat),mpi_real,mpi_sum,ictxt,info) + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_sum,ictxt,info) else if (iam == root_) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),mpi_real,mpi_sum,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_sum,root_,ictxt,info) else call psb_realloc(1,1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),mpi_real,mpi_sum,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_spk_,mpi_sum,root_,ictxt,info) end if endif #endif @@ -3896,10 +3896,10 @@ contains root_ = -1 endif if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,mpi_double_precision,mpi_sum,ictxt,info) + call mpi_allreduce(dat,dat_,1,psb_mpi_r_dpk_,mpi_sum,ictxt,info) dat = dat_ else - call mpi_reduce(dat,dat_,1,mpi_double_precision,mpi_sum,root_,ictxt,info) + call mpi_reduce(dat,dat_,1,psb_mpi_r_dpk_,mpi_sum,root_,ictxt,info) dat = dat_ endif #endif @@ -3935,16 +3935,16 @@ contains call psb_realloc(size(dat),dat_,iinfo) dat_ = dat if (iinfo == psb_success_) & - & call mpi_allreduce(dat_,dat,size(dat),mpi_double_precision,& + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_dpk_,& & mpi_sum,ictxt,info) else if (iam == root_) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),mpi_double_precision,mpi_sum,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_dpk_,mpi_sum,root_,ictxt,info) else call psb_realloc(1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),mpi_double_precision,mpi_sum,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_dpk_,mpi_sum,root_,ictxt,info) end if endif #endif @@ -3980,15 +3980,15 @@ contains call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat if (iinfo == psb_success_)& - & call mpi_allreduce(dat_,dat,size(dat),mpi_double_precision,mpi_sum,ictxt,info) + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_dpk_,mpi_sum,ictxt,info) else if (iam == root_) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),mpi_double_precision,mpi_sum,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_dpk_,mpi_sum,root_,ictxt,info) else call psb_realloc(1,1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),mpi_double_precision,mpi_sum,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_dpk_,mpi_sum,root_,ictxt,info) end if endif #endif @@ -4021,10 +4021,10 @@ contains root_ = -1 endif if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,mpi_complex,mpi_sum,ictxt,info) + call mpi_allreduce(dat,dat_,1,psb_mpi_c_spk_,mpi_sum,ictxt,info) dat = dat_ else - call mpi_reduce(dat,dat_,1,mpi_complex,mpi_sum,root_,ictxt,info) + call mpi_reduce(dat,dat_,1,psb_mpi_c_spk_,mpi_sum,root_,ictxt,info) dat = dat_ endif #endif @@ -4060,15 +4060,15 @@ contains call psb_realloc(size(dat),dat_,iinfo) dat_ = dat if (iinfo == psb_success_) & - & call mpi_allreduce(dat_,dat,size(dat),mpi_complex,mpi_sum,ictxt,info) + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_sum,ictxt,info) else if (iam == root_) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),mpi_complex,mpi_sum,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_sum,root_,ictxt,info) else call psb_realloc(1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),mpi_complex,mpi_sum,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_spk_,mpi_sum,root_,ictxt,info) end if endif #endif @@ -4104,15 +4104,15 @@ contains call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat if (iinfo == psb_success_)& - & call mpi_allreduce(dat_,dat,size(dat),mpi_complex,mpi_sum,ictxt,info) + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_sum,ictxt,info) else if (iam == root_) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),mpi_complex,mpi_sum,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_sum,root_,ictxt,info) else call psb_realloc(1,1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),mpi_complex,mpi_sum,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_spk_,mpi_sum,root_,ictxt,info) end if endif #endif @@ -4144,10 +4144,10 @@ contains root_ = -1 endif if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,mpi_double_complex,mpi_sum,ictxt,info) + call mpi_allreduce(dat,dat_,1,psb_mpi_c_dpk_,mpi_sum,ictxt,info) dat = dat_ else - call mpi_reduce(dat,dat_,1,mpi_double_complex,mpi_sum,root_,ictxt,info) + call mpi_reduce(dat,dat_,1,psb_mpi_c_dpk_,mpi_sum,root_,ictxt,info) dat = dat_ endif #endif @@ -4183,16 +4183,16 @@ contains call psb_realloc(size(dat),dat_,iinfo) dat_ = dat if (iinfo == psb_success_) & - & call mpi_allreduce(dat_,dat,size(dat),mpi_double_complex,& + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_dpk_,& & mpi_sum,ictxt,info) else if (iam == root_) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),mpi_double_complex,mpi_sum,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_sum,root_,ictxt,info) else call psb_realloc(1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),mpi_double_complex,mpi_sum,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_dpk_,mpi_sum,root_,ictxt,info) end if endif #endif @@ -4228,15 +4228,15 @@ contains call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat if (iinfo == psb_success_)& - & call mpi_allreduce(dat_,dat,size(dat),mpi_double_complex,mpi_sum,ictxt,info) + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_sum,ictxt,info) else if (iam == root_) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),mpi_double_complex,mpi_sum,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_sum,root_,ictxt,info) else call psb_realloc(1,1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),mpi_double_complex,mpi_sum,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_dpk_,mpi_sum,root_,ictxt,info) end if endif #endif @@ -4273,10 +4273,10 @@ contains root_ = -1 endif if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,mpi_real,mpi_snrm2_op,ictxt,info) + call mpi_allreduce(dat,dat_,1,psb_mpi_r_spk_,mpi_snrm2_op,ictxt,info) dat = dat_ else - call mpi_reduce(dat,dat_,1,mpi_real,mpi_snrm2_op,root_,ictxt,info) + call mpi_reduce(dat,dat_,1,psb_mpi_r_spk_,mpi_snrm2_op,root_,ictxt,info) dat = dat_ endif #endif @@ -4308,10 +4308,10 @@ contains root_ = -1 endif if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,mpi_double_precision,mpi_dnrm2_op,ictxt,info) + call mpi_allreduce(dat,dat_,1,psb_mpi_r_dpk_,mpi_dnrm2_op,ictxt,info) dat = dat_ else - call mpi_reduce(dat,dat_,1,mpi_double_precision,mpi_dnrm2_op,root_,ictxt,info) + call mpi_reduce(dat,dat_,1,psb_mpi_r_dpk_,mpi_dnrm2_op,root_,ictxt,info) dat = dat_ endif #endif @@ -4347,17 +4347,17 @@ contains call psb_realloc(size(dat),dat_,iinfo) dat_ = dat if (iinfo == psb_success_) & - & call mpi_allreduce(dat_,dat,size(dat),mpi_real,& + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_spk_,& & mpi_snrm2_op,ictxt,info) else if (iam == root_) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),mpi_real,& + call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_spk_,& & mpi_snrm2_op,root_,ictxt,info) else call psb_realloc(1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),mpi_real,& + call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_spk_,& & mpi_snrm2_op,root_,ictxt,info) end if endif @@ -4394,17 +4394,17 @@ contains call psb_realloc(size(dat),dat_,iinfo) dat_ = dat if (iinfo == psb_success_) & - & call mpi_allreduce(dat_,dat,size(dat),mpi_double_precision,& + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_dpk_,& & mpi_dnrm2_op,ictxt,info) else if (iam == root_) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),mpi_double_precision,& + call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_dpk_,& & mpi_dnrm2_op,root_,ictxt,info) else call psb_realloc(1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),mpi_double_precision,& + call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_dpk_,& & mpi_dnrm2_op,root_,ictxt,info) end if endif diff --git a/base/tools/psb_csphalo.F90 b/base/tools/psb_csphalo.F90 index a25e326c..f2106826 100644 --- a/base/tools/psb_csphalo.F90 +++ b/base/tools/psb_csphalo.F90 @@ -272,8 +272,8 @@ Subroutine psb_csphalo(a,desc_a,blk,info,rowcnv,colcnv,& end if - call mpi_alltoallv(valsnd,sdsz,bsdindx,mpi_complex,& - & acoo%val,rvsz,brvindx,mpi_complex,icomm,info) + call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_c_spk_,& + & acoo%val,rvsz,brvindx,psb_mpi_c_spk_,icomm,info) call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_ipk_integer,& & acoo%ia,rvsz,brvindx,psb_mpi_ipk_integer,icomm,info) call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_ipk_integer,& diff --git a/base/tools/psb_dsphalo.F90 b/base/tools/psb_dsphalo.F90 index 47f91216..b04bc822 100644 --- a/base/tools/psb_dsphalo.F90 +++ b/base/tools/psb_dsphalo.F90 @@ -272,8 +272,8 @@ Subroutine psb_dsphalo(a,desc_a,blk,info,rowcnv,colcnv,& end if - call mpi_alltoallv(valsnd,sdsz,bsdindx,mpi_double_precision,& - & acoo%val,rvsz,brvindx,mpi_double_precision,icomm,info) + call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_r_dpk_,& + & acoo%val,rvsz,brvindx,psb_mpi_r_dpk_,icomm,info) call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_ipk_integer,& & acoo%ia,rvsz,brvindx,psb_mpi_ipk_integer,icomm,info) call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_ipk_integer,& diff --git a/base/tools/psb_glob_to_loc.f90 b/base/tools/psb_glob_to_loc.f90 index 4758ce1d..be4bda6f 100644 --- a/base/tools/psb_glob_to_loc.f90 +++ b/base/tools/psb_glob_to_loc.f90 @@ -31,7 +31,7 @@ !!$ ! File: psb_glob_to_loc.f90 ! -! Subroutine: psb_glob_to_loc2 +! Subroutine: psb_glob_to_loc2v ! Performs global to local index translation. If an index does not belong ! to the current process, a negative value is returned (see also iact). ! @@ -46,8 +46,8 @@ ! owned - logical, optional When .true. limits the input to indices strictly ! owned by the process, i.e. excludes halo. ! -subroutine psb_glob_to_loc2(x,y,desc_a,info,iact,owned) - use psb_base_mod, psb_protect_name => psb_glob_to_loc2 +subroutine psb_glob_to_loc2v(x,y,desc_a,info,iact,owned) + use psb_base_mod, psb_protect_name => psb_glob_to_loc2v use psi_mod implicit none @@ -116,7 +116,7 @@ subroutine psb_glob_to_loc2(x,y,desc_a,info,iact,owned) return -end subroutine psb_glob_to_loc2 +end subroutine psb_glob_to_loc2v !!$ @@ -150,7 +150,7 @@ end subroutine psb_glob_to_loc2 !!$ POSSIBILITY OF SUCH DAMAGE. !!$ !!$ -! Subroutine: psb_glob_to_loc +! Subroutine: psb_glob_to_loc1v ! Performs global to local index translation. If an index does not belong ! to the current process, a negative value is returned (see also iact). ! @@ -165,8 +165,8 @@ end subroutine psb_glob_to_loc2 ! owned - logical, optional When .true. limits the input to indices strictly ! owned by the process, i.e. excludes halo. ! -subroutine psb_glob_to_loc(x,desc_a,info,iact,owned) - use psb_base_mod, psb_protect_name => psb_glob_to_loc +subroutine psb_glob_to_loc1v(x,desc_a,info,iact,owned) + use psb_base_mod, psb_protect_name => psb_glob_to_loc1v use psi_mod implicit none @@ -238,7 +238,7 @@ subroutine psb_glob_to_loc(x,desc_a,info,iact,owned) end if return -end subroutine psb_glob_to_loc +end subroutine psb_glob_to_loc1v subroutine psb_glob_to_loc2s(x,y,desc_a,info,iact,owned) use psb_base_mod, psb_protect_name => psb_glob_to_loc2s @@ -257,8 +257,8 @@ subroutine psb_glob_to_loc2s(x,y,desc_a,info,iact,owned) y = iv2(1) end subroutine psb_glob_to_loc2s -subroutine psb_glob_to_locs(x,desc_a,info,iact,owned) - use psb_base_mod, psb_protect_name => psb_glob_to_locs +subroutine psb_glob_to_loc1s(x,desc_a,info,iact,owned) + use psb_base_mod, psb_protect_name => psb_glob_to_loc1s implicit none type(psb_desc_type), intent(in) :: desc_a integer(psb_ipk_),intent(inout) :: x @@ -271,5 +271,5 @@ subroutine psb_glob_to_locs(x,desc_a,info,iact,owned) call psb_glob_to_loc(iv1,desc_a,info,iact,owned) x = iv1(1) -end subroutine psb_glob_to_locs +end subroutine psb_glob_to_loc1s diff --git a/base/tools/psb_loc_to_glob.f90 b/base/tools/psb_loc_to_glob.f90 index 857f04e4..5f24c719 100644 --- a/base/tools/psb_loc_to_glob.f90 +++ b/base/tools/psb_loc_to_glob.f90 @@ -31,7 +31,7 @@ !!$ ! File: psb_loc_to_glob.f90 ! -! Subroutine: psb_loc_to_glob2 +! Subroutine: psb_loc_to_glob2v ! Performs local to global index translation. If an index is out of range ! a negative value is returned (see also iact). ! @@ -44,8 +44,8 @@ ! an out of range index ! 'I'gnore, 'W'arning, 'A'bort ! -subroutine psb_loc_to_glob2(x,y,desc_a,info,iact) - use psb_base_mod, psb_protect_name => psb_loc_to_glob2 +subroutine psb_loc_to_glob2v(x,y,desc_a,info,iact) + use psb_base_mod, psb_protect_name => psb_loc_to_glob2v implicit none !...parameters.... @@ -103,7 +103,7 @@ subroutine psb_loc_to_glob2(x,y,desc_a,info,iact) end if return -end subroutine psb_loc_to_glob2 +end subroutine psb_loc_to_glob2v !!$ @@ -137,7 +137,7 @@ end subroutine psb_loc_to_glob2 !!$ POSSIBILITY OF SUCH DAMAGE. !!$ !!$ -! Subroutine: psb_loc_to_glob +! Subroutine: psb_loc_to_glob1v ! Performs local to global index translation. If an index is out of range ! a negative value is returned (see also iact). ! @@ -150,8 +150,8 @@ end subroutine psb_loc_to_glob2 ! an out of range index ! 'I'gnore, 'W'arning, 'A'bort ! -subroutine psb_loc_to_glob(x,desc_a,info,iact) - use psb_base_mod, psb_protect_name => psb_loc_to_glob +subroutine psb_loc_to_glob1v(x,desc_a,info,iact) + use psb_base_mod, psb_protect_name => psb_loc_to_glob1v implicit none !...parameters.... @@ -208,7 +208,7 @@ subroutine psb_loc_to_glob(x,desc_a,info,iact) end if return -end subroutine psb_loc_to_glob +end subroutine psb_loc_to_glob1v subroutine psb_loc_to_glob2s(x,y,desc_a,info,iact) use psb_descriptor_type @@ -227,9 +227,9 @@ subroutine psb_loc_to_glob2s(x,y,desc_a,info,iact) y = iv2(1) end subroutine psb_loc_to_glob2s -subroutine psb_loc_to_globs(x,desc_a,info,iact) +subroutine psb_loc_to_glob1s(x,desc_a,info,iact) use psb_descriptor_type - use psb_tools_mod, psb_protect_name => psb_loc_to_globs + use psb_tools_mod, psb_protect_name => psb_loc_to_glob1s implicit none type(psb_desc_type), intent(in) :: desc_a integer(psb_ipk_),intent(inout) :: x @@ -241,5 +241,5 @@ subroutine psb_loc_to_globs(x,desc_a,info,iact) call psb_loc_to_glob(iv1,desc_a,info,iact) x = iv1(1) -end subroutine psb_loc_to_globs +end subroutine psb_loc_to_glob1s diff --git a/base/tools/psb_ssphalo.F90 b/base/tools/psb_ssphalo.F90 index e26db24e..4b4b319c 100644 --- a/base/tools/psb_ssphalo.F90 +++ b/base/tools/psb_ssphalo.F90 @@ -272,8 +272,8 @@ Subroutine psb_ssphalo(a,desc_a,blk,info,rowcnv,colcnv,& end if - call mpi_alltoallv(valsnd,sdsz,bsdindx,mpi_real,& - & acoo%val,rvsz,brvindx,mpi_real,icomm,info) + call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_r_spk_,& + & acoo%val,rvsz,brvindx,psb_mpi_r_spk_,icomm,info) call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_ipk_integer,& & acoo%ia,rvsz,brvindx,psb_mpi_ipk_integer,icomm,info) call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_ipk_integer,& diff --git a/base/tools/psb_zsphalo.F90 b/base/tools/psb_zsphalo.F90 index 2491dca6..6c85a040 100644 --- a/base/tools/psb_zsphalo.F90 +++ b/base/tools/psb_zsphalo.F90 @@ -272,8 +272,8 @@ Subroutine psb_zsphalo(a,desc_a,blk,info,rowcnv,colcnv,& end if - call mpi_alltoallv(valsnd,sdsz,bsdindx,mpi_double_complex,& - & acoo%val,rvsz,brvindx,mpi_double_complex,icomm,info) + call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_c_dpk_,& + & acoo%val,rvsz,brvindx,psb_mpi_c_dpk_,icomm,info) call mpi_alltoallv(iasnd,sdsz,bsdindx,psb_mpi_ipk_integer,& & acoo%ia,rvsz,brvindx,psb_mpi_ipk_integer,icomm,info) call mpi_alltoallv(jasnd,sdsz,bsdindx,psb_mpi_ipk_integer,&