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

psblas3:

Browse Source 
base/comm/psb_cscatter.F90
 base/comm/psb_cspgather.F90
 base/comm/psb_dscatter.F90
 base/comm/psb_dspgather.F90
 base/comm/psb_sscatter.F90
 base/comm/psb_sspgather.F90
 base/comm/psb_zscatter.F90
 base/comm/psb_zspgather.F90
 base/internals/psi_cswapdata.F90
 base/internals/psi_cswaptran.F90
 base/internals/psi_dswapdata.F90
 base/internals/psi_dswaptran.F90
 base/internals/psi_sswapdata.F90
 base/internals/psi_sswaptran.F90
 base/internals/psi_zswapdata.F90
 base/internals/psi_zswaptran.F90
 base/modules/psb_const_mod.F90
 base/modules/psb_i_tools_mod.f90
 base/modules/psi_bcast_mod.F90
 base/modules/psi_comm_buffers_mod.F90
 base/modules/psi_p2p_mod.F90
 base/modules/psi_reduce_mod.F90
 base/tools/psb_csphalo.F90
 base/tools/psb_dsphalo.F90
 base/tools/psb_glob_to_loc.f90
 base/tools/psb_loc_to_glob.f90
 base/tools/psb_ssphalo.F90
 base/tools/psb_zsphalo.F90

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

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

@ -208,8 +208,8 @@ subroutine psb_cscatterm(globx, locx, desc_a, info, iroot)
! scatter !!!
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

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

@ -112,9 +112,9 @@ subroutine psb_csp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep
idisp(ip) = sum(nzbr(1:ip-1))
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)

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

@ -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

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

@ -112,9 +112,9 @@ subroutine psb_dsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep
idisp(ip) = sum(nzbr(1:ip-1))
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)

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

@ -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

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

@ -112,9 +112,9 @@ subroutine psb_ssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep
idisp(ip) = sum(nzbr(1:ip-1))
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)

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

@ -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

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

@ -112,9 +112,9 @@ subroutine psb_zsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep
idisp(ip) = sum(nzbr(1:ip-1))
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)

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

@ -302,8 +302,8 @@ subroutine psi_cswapidxm(iictxt,iicomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,wo
! swap elements using mpi_alltoallv
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

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

@ -320,8 +320,8 @@ subroutine psi_ctranidxm(iictxt,iicomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,wo
! swap elements using mpi_alltoallv
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

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

@ -302,8 +302,8 @@ subroutine psi_dswapidxm(iictxt,iicomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,wo
! swap elements using mpi_alltoallv
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

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

@ -320,8 +320,8 @@ subroutine psi_dtranidxm(iictxt,iicomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,wo
! swap elements using mpi_alltoallv
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

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

@ -302,8 +302,8 @@ subroutine psi_sswapidxm(iictxt,iicomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,wo
! swap elements using mpi_alltoallv
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

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

@ -320,8 +320,8 @@ subroutine psi_stranidxm(iictxt,iicomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,wo
! swap elements using mpi_alltoallv
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

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

@ -302,8 +302,8 @@ subroutine psi_zswapidxm(iictxt,iicomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,wo
! swap elements using mpi_alltoallv
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

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

@ -320,8 +320,8 @@ subroutine psi_ztranidxm(iictxt,iicomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,wo
! swap elements using mpi_alltoallv
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

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

@ -47,8 +47,8 @@ module psb_const_mod
! This is always a 4-byte integer, for MPI-related stuff
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

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

@ -146,7 +146,7 @@ module psb_i_tools_mod
interface psb_glob_to_loc
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

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

@ -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

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

@ -38,10 +38,10 @@ module mpi
integer(psb_mpik_), parameter :: mpi_status_size = 1
integer(psb_mpik_), parameter :: mpi_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)

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

@ -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

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

@ -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

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

@ -272,8 +272,8 @@ Subroutine psb_csphalo(a,desc_a,blk,info,rowcnv,colcnv,&
end if
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,&

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

@ -272,8 +272,8 @@ Subroutine psb_dsphalo(a,desc_a,blk,info,rowcnv,colcnv,&
end if
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,&

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

@ -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

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

@ -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

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

@ -272,8 +272,8 @@ Subroutine psb_ssphalo(a,desc_a,blk,info,rowcnv,colcnv,&
end if
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,&

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

@ -272,8 +272,8 @@ Subroutine psb_zsphalo(a,desc_a,blk,info,rowcnv,colcnv,&
end if
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,&

Write Preview
Loading…
Cancel
Save