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

[UPDATE] Refactor after template update for RMA routines

Browse Source
communication_v2
Stack-1 2 months ago
parent d231efe35a
commit 4b8e4dd4a3
550 changed files with 33732 additions and 7696 deletions
Show Stats Download Patch File Download Diff File

2
base/comm/internals/psi_covrl_restr.f90
Unescape Escape View File

@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may ! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED

2
base/comm/internals/psi_covrl_restr_a.f90
Unescape Escape View File

@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may ! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED

2
base/comm/internals/psi_covrl_save.f90
Unescape Escape View File

@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may ! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED

2
base/comm/internals/psi_covrl_save_a.f90
Unescape Escape View File

@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may ! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED

2
base/comm/internals/psi_covrl_upd.f90
Unescape Escape View File

@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may ! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED

2
base/comm/internals/psi_covrl_upd_a.f90
Unescape Escape View File

@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may ! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED

2612
base/comm/internals/psi_cswapdata.F90
View File

File diff suppressed because it is too large Load Diff

74
base/comm/internals/psi_cswapdata_a.F90
Unescape Escape View File

@ -39,7 +39,7 @@
! application environment. All the variants have the same structure ! application environment. All the variants have the same structure
! In all these subroutines X may be: I Integer ! In all these subroutines X may be: I Integer
! S real(psb_spk_) ! S real(psb_spk_)
! D real(psb_dpk_) ! D complex(psb_spk_)
! C complex(psb_spk_) ! C complex(psb_spk_)
! Z complex(psb_dpk_) ! Z complex(psb_dpk_)
! Basically the operation is as follows: on each process, we identify ! Basically the operation is as follows: on each process, we identify
@ -70,10 +70,10 @@
! !
! !
! n - integer Number of columns in Y ! n - integer Number of columns in Y
! beta - complex Choose overwrite or sum. ! beta - real Choose overwrite or sum.
! y(:,:) - complex The data area ! y(:,:) - real The data area
! desc_a - type(psb_desc_type). The communication descriptor. ! desc_a - type(psb_desc_type). The communication descriptor.
! work(:) - complex Buffer space. If not sufficient, will do ! work(:) - real Buffer space. If not sufficient, will do
! our own internal allocation. ! our own internal allocation.
! info - integer. return code. ! info - integer. return code.
! data - integer which list is to be used to exchange data ! data - integer which list is to be used to exchange data
@ -97,12 +97,13 @@ contains
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info integer(psb_mpk_), intent(in) :: n
complex(psb_spk_) :: y(:,:), beta complex(psb_spk_), intent(in) :: beta
complex(psb_spk_), target :: work(:) complex(psb_spk_), intent(inout) :: y(:,:)
type(psb_desc_type),target :: desc_a type(psb_desc_type),target :: desc_a
complex(psb_spk_), target :: work(:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional :: data integer(psb_ipk_), optional :: data
! locals ! locals
@ -165,11 +166,12 @@ complex(psb_spk_), target :: work(:)
#endif #endif
type(psb_ctxt_type), intent(in) :: ctxt type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(in) :: flag
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
complex(psb_spk_) :: y(:,:), beta complex(psb_spk_), intent(in) :: beta
complex(psb_spk_), target :: work(:) complex(psb_spk_), intent(inout) :: y(:,:)
complex(psb_spk_), target :: work(:)
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv
! locals ! locals
@ -293,8 +295,8 @@ complex(psb_spk_), pointer, dimension(:) :: sndbuf, rcvbuf
! swap elements using mpi_alltoallv ! swap elements using mpi_alltoallv
call mpi_alltoallv(sndbuf,sdsz,bsdidx,& call mpi_alltoallv(sndbuf,sdsz,bsdidx,&
& psb_mpi_c_spk_,rcvbuf,rvsz,& & psb_mpi_r_spk_,rcvbuf,rvsz,&
& brvidx,psb_mpi_c_spk_,icomm,iret) & brvidx,psb_mpi_r_spk_,icomm,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,m_err=(/iret/)) call psb_errpush(info,name,m_err=(/iret/))
@ -348,9 +350,9 @@ complex(psb_spk_), pointer, dimension(:) :: sndbuf, rcvbuf
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm) prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm)
if ((nerv>0).and.(proc_to_comm /= me)) then if ((nerv>0).and.(proc_to_comm /= me)) then
p2ptag = psb_complex_swap_tag p2ptag = psb_double_swap_tag
call mpi_irecv(rcvbuf(rcv_pt),n*nerv,& call mpi_irecv(rcvbuf(rcv_pt),n*nerv,&
& psb_mpi_c_spk_,prcid(i),& & psb_mpi_r_spk_,prcid(i),&
& p2ptag, icomm,rvhd(i),iret) & p2ptag, icomm,rvhd(i),iret)
end if end if
rcv_pt = rcv_pt + n*nerv rcv_pt = rcv_pt + n*nerv
@ -370,15 +372,15 @@ complex(psb_spk_), pointer, dimension(:) :: sndbuf, rcvbuf
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
p2ptag = psb_complex_swap_tag p2ptag = psb_double_swap_tag
if ((nesd>0).and.(proc_to_comm /= me)) then if ((nesd>0).and.(proc_to_comm /= me)) then
if (usersend) then if (usersend) then
call mpi_rsend(sndbuf(snd_pt),n*nesd,& call mpi_rsend(sndbuf(snd_pt),n*nesd,&
& psb_mpi_c_spk_,prcid(i),& & psb_mpi_r_spk_,prcid(i),&
& p2ptag,icomm,iret) & p2ptag,icomm,iret)
else else
call mpi_send(sndbuf(snd_pt),n*nesd,& call mpi_send(sndbuf(snd_pt),n*nesd,&
& psb_mpi_c_spk_,prcid(i),& & psb_mpi_r_spk_,prcid(i),&
& p2ptag,icomm,iret) & p2ptag,icomm,iret)
end if end if
@ -401,7 +403,7 @@ complex(psb_spk_), pointer, dimension(:) :: sndbuf, rcvbuf
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
p2ptag = psb_complex_swap_tag p2ptag = psb_double_swap_tag
if ((proc_to_comm /= me).and.(nerv>0)) then if ((proc_to_comm /= me).and.(nerv>0)) then
call mpi_wait(rvhd(i),p2pstat,iret) call mpi_wait(rvhd(i),p2pstat,iret)
@ -510,7 +512,7 @@ complex(psb_spk_), pointer, dimension(:) :: sndbuf, rcvbuf
! application environment. All the variants have the same structure ! application environment. All the variants have the same structure
! In all these subroutines X may be: I Integer ! In all these subroutines X may be: I Integer
! S real(psb_spk_) ! S real(psb_spk_)
! D real(psb_dpk_) ! D complex(psb_spk_)
! C complex(psb_spk_) ! C complex(psb_spk_)
! Z complex(psb_dpk_) ! Z complex(psb_dpk_)
! Basically the operation is as follows: on each process, we identify ! Basically the operation is as follows: on each process, we identify
@ -541,10 +543,10 @@ complex(psb_spk_), pointer, dimension(:) :: sndbuf, rcvbuf
! !
! !
! n - integer Number of columns in Y ! n - integer Number of columns in Y
! beta - complex Choose overwrite or sum. ! beta - real Choose overwrite or sum.
! y(:) - complex The data area ! y(:) - real The data area
! desc_a - type(psb_desc_type). The communication descriptor. ! desc_a - type(psb_desc_type). The communication descriptor.
! work(:) - complex Buffer space. If not sufficient, will do ! work(:) - real Buffer space. If not sufficient, will do
! our own internal allocation. ! our own internal allocation.
! info - integer. return code. ! info - integer. return code.
! data - integer which list is to be used to exchange data ! data - integer which list is to be used to exchange data
@ -566,10 +568,11 @@ complex(psb_spk_), pointer, dimension(:) :: sndbuf, rcvbuf
#endif #endif
integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info complex(psb_spk_), intent(in) :: beta
complex(psb_spk_) :: y(:), beta complex(psb_spk_), intent(inout) :: y(:)
complex(psb_spk_), target :: work(:)
type(psb_desc_type),target :: desc_a type(psb_desc_type),target :: desc_a
complex(psb_spk_), target :: work(:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional :: data integer(psb_ipk_), optional :: data
! locals ! locals
@ -648,7 +651,8 @@ complex(psb_spk_), pointer, dimension(:) :: sndbuf, rcvbuf
type(psb_ctxt_type), intent(in) :: ctxt type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
complex(psb_spk_) :: y(:), beta complex(psb_spk_), intent(in) :: beta
complex(psb_spk_), intent(inout) :: y(:)
complex(psb_spk_), target :: work(:) complex(psb_spk_), target :: work(:)
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv
@ -775,8 +779,8 @@ complex(psb_spk_), pointer, dimension(:) :: sndbuf, rcvbuf
! swap elements using mpi_alltoallv ! swap elements using mpi_alltoallv
call mpi_alltoallv(sndbuf,sdsz,bsdidx,& call mpi_alltoallv(sndbuf,sdsz,bsdidx,&
& psb_mpi_c_spk_,rcvbuf,rvsz,& & psb_mpi_r_spk_,rcvbuf,rvsz,&
& brvidx,psb_mpi_c_spk_,icomm,iret) & brvidx,psb_mpi_r_spk_,icomm,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,m_err=(/iret/)) call psb_errpush(info,name,m_err=(/iret/))
@ -830,9 +834,9 @@ complex(psb_spk_), pointer, dimension(:) :: sndbuf, rcvbuf
prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm) prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm)
if ((nerv>0).and.(proc_to_comm /= me)) then if ((nerv>0).and.(proc_to_comm /= me)) then
p2ptag = psb_complex_swap_tag p2ptag = psb_double_swap_tag
call mpi_irecv(rcvbuf(rcv_pt),nerv,& call mpi_irecv(rcvbuf(rcv_pt),nerv,&
& psb_mpi_c_spk_,prcid(i),& & psb_mpi_r_spk_,prcid(i),&
& p2ptag, icomm,rvhd(i),iret) & p2ptag, icomm,rvhd(i),iret)
end if end if
rcv_pt = rcv_pt + nerv rcv_pt = rcv_pt + nerv
@ -852,16 +856,16 @@ complex(psb_spk_), pointer, dimension(:) :: sndbuf, rcvbuf
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
p2ptag = psb_complex_swap_tag p2ptag = psb_double_swap_tag
if ((nesd>0).and.(proc_to_comm /= me)) then if ((nesd>0).and.(proc_to_comm /= me)) then
if (usersend) then if (usersend) then
call mpi_rsend(sndbuf(snd_pt),nesd,& call mpi_rsend(sndbuf(snd_pt),nesd,&
& psb_mpi_c_spk_,prcid(i),& & psb_mpi_r_spk_,prcid(i),&
& p2ptag,icomm,iret) & p2ptag,icomm,iret)
else else
call mpi_send(sndbuf(snd_pt),nesd,& call mpi_send(sndbuf(snd_pt),nesd,&
& psb_mpi_c_spk_,prcid(i),& & psb_mpi_r_spk_,prcid(i),&
& p2ptag,icomm,iret) & p2ptag,icomm,iret)
end if end if
@ -882,7 +886,7 @@ complex(psb_spk_), pointer, dimension(:) :: sndbuf, rcvbuf
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
p2ptag = psb_complex_swap_tag p2ptag = psb_double_swap_tag
if ((proc_to_comm /= me).and.(nerv>0)) then if ((proc_to_comm /= me).and.(nerv>0)) then
call mpi_wait(rvhd(i),p2pstat,iret) call mpi_wait(rvhd(i),p2pstat,iret)

1857
base/comm/internals/psi_cswaptran.F90
View File

File diff suppressed because it is too large Load Diff

72
base/comm/internals/psi_cswaptran_a.F90
Unescape Escape View File

@ -30,7 +30,7 @@
! !
! !
! !
! File: psi_cswaptran.F90 ! File: psi_cswaptran_a.F90
! !
! Subroutine: psi_cswaptranm ! Subroutine: psi_cswaptranm
! Implements the data exchange among processes. This is similar to Xswapdata, but ! Implements the data exchange among processes. This is similar to Xswapdata, but
@ -43,7 +43,7 @@
! application environment. All the variants have the same structure ! application environment. All the variants have the same structure
! In all these subroutines X may be: I Integer ! In all these subroutines X may be: I Integer
! S real(psb_spk_) ! S real(psb_spk_)
! D real(psb_dpk_) ! D complex(psb_spk_)
! C complex(psb_spk_) ! C complex(psb_spk_)
! Z complex(psb_dpk_) ! Z complex(psb_dpk_)
! Basically the operation is as follows: on each process, we identify ! Basically the operation is as follows: on each process, we identify
@ -74,10 +74,10 @@
! !
! !
! n - integer Number of columns in Y ! n - integer Number of columns in Y
! beta - complex Choose overwrite or sum. ! beta - real Choose overwrite or sum.
! y(:,:) - complex The data area ! y(:,:) - real The data area
! desc_a - type(psb_desc_type). The communication descriptor. ! desc_a - type(psb_desc_type). The communication descriptor.
! work(:) - complex Buffer space. If not sufficient, will do ! work(:) - real Buffer space. If not sufficient, will do
! our own internal allocation. ! our own internal allocation.
! info - integer. return code. ! info - integer. return code.
! data - integer which list is to be used to exchange data ! data - integer which list is to be used to exchange data
@ -101,12 +101,13 @@ contains
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info integer(psb_mpk_), intent(in) :: n
complex(psb_spk_) :: y(:,:), beta complex(psb_spk_), intent(in) :: beta
complex(psb_spk_), target :: work(:) complex(psb_spk_), intent(inout) :: y(:,:)
type(psb_desc_type),target :: desc_a type(psb_desc_type),target :: desc_a
complex(psb_spk_), target :: work(:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional :: data integer(psb_ipk_), optional :: data
! locals ! locals
@ -174,7 +175,8 @@ contains
integer(psb_mpk_), intent(in) :: n integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
complex(psb_spk_) :: y(:,:), beta complex(psb_spk_), intent(inout) :: y(:,:)
complex(psb_spk_), intent(in) :: beta
complex(psb_spk_), target :: work(:) complex(psb_spk_), target :: work(:)
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv
@ -305,8 +307,8 @@ contains
! swap elements using mpi_alltoallv ! swap elements using mpi_alltoallv
call mpi_alltoallv(rcvbuf,rvsz,brvidx,& call mpi_alltoallv(rcvbuf,rvsz,brvidx,&
& psb_mpi_c_spk_,& & psb_mpi_r_spk_,&
& sndbuf,sdsz,bsdidx,psb_mpi_c_spk_,icomm,iret) & sndbuf,sdsz,bsdidx,psb_mpi_r_spk_,icomm,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,m_err=(/iret/)) call psb_errpush(info,name,m_err=(/iret/))
@ -360,9 +362,9 @@ contains
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm) prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm)
if ((nesd>0).and.(proc_to_comm /= me)) then if ((nesd>0).and.(proc_to_comm /= me)) then
p2ptag = psb_complex_swap_tag p2ptag = psb_double_swap_tag
call mpi_irecv(sndbuf(snd_pt),n*nesd,& call mpi_irecv(sndbuf(snd_pt),n*nesd,&
& psb_mpi_c_spk_,prcid(i),& & psb_mpi_r_spk_,prcid(i),&
& p2ptag,icomm,rvhd(i),iret) & p2ptag,icomm,rvhd(i),iret)
end if end if
rcv_pt = rcv_pt + n*nerv rcv_pt = rcv_pt + n*nerv
@ -383,14 +385,14 @@ contains
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
if ((nerv>0).and.(proc_to_comm /= me)) then if ((nerv>0).and.(proc_to_comm /= me)) then
p2ptag = psb_complex_swap_tag p2ptag = psb_double_swap_tag
if (usersend) then if (usersend) then
call mpi_rsend(rcvbuf(rcv_pt),n*nerv,& call mpi_rsend(rcvbuf(rcv_pt),n*nerv,&
& psb_mpi_c_spk_,prcid(i),& & psb_mpi_r_spk_,prcid(i),&
& p2ptag,icomm,iret) & p2ptag,icomm,iret)
else else
call mpi_send(rcvbuf(rcv_pt),n*nerv,& call mpi_send(rcvbuf(rcv_pt),n*nerv,&
& psb_mpi_c_spk_,prcid(i),& & psb_mpi_r_spk_,prcid(i),&
& p2ptag,icomm,iret) & p2ptag,icomm,iret)
end if end if
@ -413,7 +415,7 @@ contains
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
p2ptag = psb_complex_swap_tag p2ptag = psb_double_swap_tag
if ((proc_to_comm /= me).and.(nesd>0)) then if ((proc_to_comm /= me).and.(nesd>0)) then
call mpi_wait(rvhd(i),p2pstat,iret) call mpi_wait(rvhd(i),p2pstat,iret)
@ -525,7 +527,7 @@ contains
! application environment. All the variants have the same structure ! application environment. All the variants have the same structure
! In all these subroutines X may be: I Integer ! In all these subroutines X may be: I Integer
! S real(psb_spk_) ! S real(psb_spk_)
! D real(psb_dpk_) ! D complex(psb_spk_)
! C complex(psb_spk_) ! C complex(psb_spk_)
! Z complex(psb_dpk_) ! Z complex(psb_dpk_)
! Basically the operation is as follows: on each process, we identify ! Basically the operation is as follows: on each process, we identify
@ -556,10 +558,10 @@ contains
! !
! !
! n - integer Number of columns in Y ! n - integer Number of columns in Y
! beta - complex Choose overwrite or sum. ! beta - real Choose overwrite or sum.
! y(:) - complex The data area ! y(:) - real The data area
! desc_a - type(psb_desc_type). The communication descriptor. ! desc_a - type(psb_desc_type). The communication descriptor.
! work(:) - complex Buffer space. If not sufficient, will do ! work(:) - real Buffer space. If not sufficient, will do
! our own internal allocation. ! our own internal allocation.
! info - integer. return code. ! info - integer. return code.
! data - integer which list is to be used to exchange data ! data - integer which list is to be used to exchange data
@ -580,10 +582,11 @@ contains
#endif #endif
integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info complex(psb_spk_), intent(in) :: beta
complex(psb_spk_) :: y(:), beta complex(psb_spk_), intent(inout) :: y(:)
complex(psb_spk_), target :: work(:)
type(psb_desc_type),target :: desc_a type(psb_desc_type),target :: desc_a
complex(psb_spk_), target :: work(:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional :: data integer(psb_ipk_), optional :: data
! locals ! locals
@ -659,7 +662,8 @@ contains
type(psb_ctxt_type), intent(in) :: ctxt type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
complex(psb_spk_) :: y(:), beta complex(psb_spk_), intent(inout) :: y(:)
complex(psb_spk_), intent(in) :: beta
complex(psb_spk_), target :: work(:) complex(psb_spk_), target :: work(:)
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv
@ -791,8 +795,8 @@ contains
! swap elements using mpi_alltoallv ! swap elements using mpi_alltoallv
call mpi_alltoallv(rcvbuf,rvsz,brvidx,& call mpi_alltoallv(rcvbuf,rvsz,brvidx,&
& psb_mpi_c_spk_,& & psb_mpi_r_spk_,&
& sndbuf,sdsz,bsdidx,psb_mpi_c_spk_,icomm,iret) & sndbuf,sdsz,bsdidx,psb_mpi_r_spk_,icomm,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,m_err=(/iret/)) call psb_errpush(info,name,m_err=(/iret/))
@ -845,9 +849,9 @@ contains
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm) prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm)
if ((nesd>0).and.(proc_to_comm /= me)) then if ((nesd>0).and.(proc_to_comm /= me)) then
p2ptag = psb_complex_swap_tag p2ptag = psb_double_swap_tag
call mpi_irecv(sndbuf(snd_pt),nesd,& call mpi_irecv(sndbuf(snd_pt),nesd,&
& psb_mpi_c_spk_,prcid(i),& & psb_mpi_r_spk_,prcid(i),&
& p2ptag,icomm,rvhd(i),iret) & p2ptag,icomm,rvhd(i),iret)
end if end if
rcv_pt = rcv_pt + nerv rcv_pt = rcv_pt + nerv
@ -868,14 +872,14 @@ contains
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
if ((nerv>0).and.(proc_to_comm /= me)) then if ((nerv>0).and.(proc_to_comm /= me)) then
p2ptag = psb_complex_swap_tag p2ptag = psb_double_swap_tag
if (usersend) then if (usersend) then
call mpi_rsend(rcvbuf(rcv_pt),nerv,& call mpi_rsend(rcvbuf(rcv_pt),nerv,&
& psb_mpi_c_spk_,prcid(i),& & psb_mpi_r_spk_,prcid(i),&
& p2ptag, icomm,iret) & p2ptag, icomm,iret)
else else
call mpi_send(rcvbuf(rcv_pt),nerv,& call mpi_send(rcvbuf(rcv_pt),nerv,&
& psb_mpi_c_spk_,prcid(i),& & psb_mpi_r_spk_,prcid(i),&
& p2ptag, icomm,iret) & p2ptag, icomm,iret)
end if end if
@ -896,7 +900,7 @@ contains
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
p2ptag = psb_complex_swap_tag p2ptag = psb_double_swap_tag
if ((proc_to_comm /= me).and.(nesd>0)) then if ((proc_to_comm /= me).and.(nesd>0)) then
call mpi_wait(rvhd(i),p2pstat,iret) call mpi_wait(rvhd(i),p2pstat,iret)

2
base/comm/internals/psi_dovrl_restr.f90
Unescape Escape View File

@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may ! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED

2
base/comm/internals/psi_dovrl_restr_a.f90
Unescape Escape View File

@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may ! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED

2
base/comm/internals/psi_dovrl_save.f90
Unescape Escape View File

@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may ! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED

2
base/comm/internals/psi_dovrl_save_a.f90
Unescape Escape View File

@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may ! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED

2
base/comm/internals/psi_dovrl_upd.f90
Unescape Escape View File

@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may ! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED

2
base/comm/internals/psi_dovrl_upd_a.f90
Unescape Escape View File

@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may ! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED

707
base/comm/internals/psi_dswapdata.F90
Unescape Escape View File

@ -53,7 +53,7 @@
! is scattered in the owned indices, and BETA=1. ! is scattered in the owned indices, and BETA=1.
! The first routine picks the desired exchange index list and passes it to the second. ! The first routine picks the desired exchange index list and passes it to the second.
! This version works on encapsulated vectors, and uses their methods to do GTH and SCT, ! This version works on encapsulated vectors, and uses their methods to do GTH and SCT,
! so that special versions (i.e. GPU vectors can override them ! so that special versions (i.e. GPU vectors can override them)
! !
! Arguments: ! Arguments:
! swap_status - integer Swap status selector. ! swap_status - integer Swap status selector.
@ -84,7 +84,8 @@ submodule (psi_d_comm_v_mod) psi_d_swapdata_impl
use psb_base_mod use psb_base_mod
use psb_error_mod, only: psb_get_debug_level, psb_get_debug_unit, psb_debug_ext_ use psb_error_mod, only: psb_get_debug_level, psb_get_debug_unit, psb_debug_ext_
use psb_comm_schemes_mod, only: psb_comm_isend_irecv_, psb_comm_ineighbor_alltoallv_, & use psb_comm_schemes_mod, only: psb_comm_isend_irecv_, psb_comm_ineighbor_alltoallv_, &
& psb_comm_persistent_ineighbor_alltoallv_, psb_comm_rma_pull_, psb_comm_rma_push_ & psb_comm_persistent_ineighbor_alltoallv_, psb_comm_rma_pull_, psb_comm_rma_push_, &
& psb_comm_handle_type
use psb_comm_rma_mod, only: psb_comm_rma_handle use psb_comm_rma_mod, only: psb_comm_rma_handle
use psb_comm_factory_mod use psb_comm_factory_mod
@ -526,8 +527,7 @@ contains
logical :: do_start, do_wait logical :: do_start, do_wait
logical :: debug logical :: debug
character(len=30) :: name character(len=30) :: name
integer(psb_ipk_) :: i, nesd, nerv, snd_pt, rcv_pt, pnti, n
info = psb_success_ info = psb_success_
name = 'psi_dswap_neighbor_topology_vect' name = 'psi_dswap_neighbor_topology_vect'
@ -584,20 +584,32 @@ contains
buffer_size = topology_total_send + topology_total_recv buffer_size = topology_total_send + topology_total_recv
if (buffer_size > 0) then if (buffer_size > 0) then
call y%new_buffer(buffer_size, info) call y%new_buffer(ione*size(comm_indexes%v), info)
if (info /= 0) then if (info /= 0) then
call psb_errpush(psb_err_alloc_dealloc_, name) call psb_errpush(psb_err_alloc_dealloc_, name)
goto 9999 goto 9999
end if end if
neighbor_comm_handle%comm_request = mpi_request_null neighbor_comm_handle%comm_request = mpi_request_null
pnti = 1
! Gather send data into contiguous send buffer (polymorphic for GPU) do i=1, num_neighbors
if (debug) write(*,*) my_rank,' nbr_vect: gathering send data,', topology_total_send,' elems' nerv = comm_indexes%v(pnti+psb_n_elem_recv_)
call y%gth(int(topology_total_send,psb_mpk_), & nesd = comm_indexes%v(pnti+nerv+psb_n_elem_send_)
& neighbor_comm_handle%send_indexes, & snd_pt = 1+pnti+nerv+psb_n_elem_send_
& y%combuf(1:topology_total_send)) rcv_pt = 1+pnti+psb_n_elem_recv_
if ((snd_pt < 1) .or. (nesd < 0) .or. (snd_pt+max(0,nesd)-1 > size(comm_indexes%v))) then
info = psb_err_internal_error_
call psb_errpush(info,name,a_err='baseline gather metadata out of bounds')
goto 9999
end if
if ((snd_pt < 1) .or. (nesd < 0) .or. (snd_pt+max(0,nesd)-1 > size(y%combuf))) then
info = psb_err_internal_error_
call psb_errpush(info,name,a_err='baseline gather combuf bounds error')
goto 9999
end if
call y%gth(snd_pt,nesd,comm_indexes)
pnti = pnti + nerv + nesd + 3
end do
else else
! No data to send/recv: ensure request indicates idle state
neighbor_comm_handle%comm_request = mpi_request_null neighbor_comm_handle%comm_request = mpi_request_null
end if end if
@ -609,10 +621,10 @@ contains
if (buffer_size > 0) then if (buffer_size > 0) then
call mpi_ineighbor_alltoallv( & call mpi_ineighbor_alltoallv( &
& y%combuf(1), & ! send buffer & y%combuf(1), & ! send buffer
& neighbor_comm_handle%send_counts, & & n*neighbor_comm_handle%send_counts, &
& neighbor_comm_handle%send_displs, & & n*neighbor_comm_handle%send_displs, &
& psb_mpi_r_dpk_, & & psb_mpi_r_dpk_, &
& y%combuf(topology_total_send + 1), & ! recv buffer & y%combuf(1), & ! recv buffer (baseline layout)
& neighbor_comm_handle%recv_counts, & & neighbor_comm_handle%recv_counts, &
& neighbor_comm_handle%recv_displs, & & neighbor_comm_handle%recv_displs, &
& psb_mpi_r_dpk_, & & psb_mpi_r_dpk_, &
@ -663,10 +675,29 @@ contains
! Scatter received data to local vector positions (polymorphic for GPU) ! Scatter received data to local vector positions (polymorphic for GPU)
if (debug) write(*,*) my_rank,' nbr_vect: scattering recv data,', topology_total_recv,' elems' if (debug) write(*,*) my_rank,' nbr_vect: scattering recv data,', topology_total_recv,' elems'
call y%sct(int(topology_total_recv,psb_mpk_), & pnti = 1
& neighbor_comm_handle%recv_indexes, & snd_pt = 1
& y%combuf(topology_total_send+1:topology_total_send+topology_total_recv), & rcv_pt = 1
& beta) do i=1, num_neighbors
nerv = comm_indexes%v(pnti+psb_n_elem_recv_)
nesd = comm_indexes%v(pnti+nerv+psb_n_elem_send_)
snd_pt = 1+pnti+nerv+psb_n_elem_send_
rcv_pt = 1+pnti+psb_n_elem_recv_
if ((1+pnti+psb_n_elem_recv_ < 1) .or. (nerv < 0) .or. &
& (1+pnti+psb_n_elem_recv_+max(0,nerv)-1 > size(comm_indexes%v))) then
info = psb_err_internal_error_
call psb_errpush(info,name,a_err='baseline scatter metadata out of bounds')
goto 9999
end if
if ((rcv_pt < 1) .or. (nerv < 0) .or. (rcv_pt+max(0,nerv)-1 > size(y%combuf))) then
info = psb_err_internal_error_
call psb_errpush(info,name,a_err='baseline scatter combuf bounds error')
goto 9999
end if
call y%sct(rcv_pt,nerv,comm_indexes,beta)
pnti = pnti + nerv + nesd + 3
end do
else else
! nothing to wait/scatter ! nothing to wait/scatter
end if end if
@ -722,8 +753,7 @@ contains
logical :: do_start, do_wait logical :: do_start, do_wait
logical :: debug logical :: debug
character(len=30) :: name character(len=30) :: name
integer(psb_ipk_) :: i, nesd, nerv, snd_pt, rcv_pt, pnti, n
info = psb_success_ info = psb_success_
name = 'psi_dswap_neighbor_persistent_topology_vect' name = 'psi_dswap_neighbor_persistent_topology_vect'
@ -820,11 +850,26 @@ contains
neighbor_comm_handle%comm_request = mpi_request_null neighbor_comm_handle%comm_request = mpi_request_null
if (buffer_size > 0) then if (buffer_size > 0) then
! Gather send data into contiguous send buffer (polymorphic for GPU) ! Gather send data into combuf using baseline-style gth calls
if (debug) write(*,*) my_rank,' nbr_vect: gathering send data,', topology_total_send,' elems' if (debug) write(*,*) my_rank,' nbr_vect: gathering send data (baseline layout),', topology_total_send,' elems'
call y%gth(int(topology_total_send,psb_mpk_), & pnti = 1
& neighbor_comm_handle%send_indexes, & do i=1, num_neighbors
& y%combuf(1:topology_total_send)) nerv = comm_indexes%v(pnti+psb_n_elem_recv_)
nesd = comm_indexes%v(pnti+nerv+psb_n_elem_send_)
snd_pt = 1+pnti+nerv+psb_n_elem_send_
if ((snd_pt < 1) .or. (nesd < 0) .or. (snd_pt+max(0,nesd)-1 > size(comm_indexes%v))) then
info = psb_err_internal_error_
call psb_errpush(info,name,a_err='baseline gather metadata out of bounds')
goto 9999
end if
if ((snd_pt < 1) .or. (nesd < 0) .or. (snd_pt+max(0,nesd)-1 > size(y%combuf))) then
info = psb_err_internal_error_
call psb_errpush(info,name,a_err='baseline gather combuf bounds error')
goto 9999
end if
call y%gth(snd_pt,nesd,comm_indexes)
pnti = pnti + nerv + nesd + 3
end do
else else
neighbor_comm_handle%persistent_in_flight = .false. neighbor_comm_handle%persistent_in_flight = .false.
end if end if
@ -841,7 +886,7 @@ contains
& neighbor_comm_handle%send_counts, & & neighbor_comm_handle%send_counts, &
& neighbor_comm_handle%send_displs, & & neighbor_comm_handle%send_displs, &
& psb_mpi_r_dpk_, & & psb_mpi_r_dpk_, &
& y%combuf(topology_total_send + 1), & ! recv buffer & y%combuf(1), & ! recv buffer (baseline layout)
& neighbor_comm_handle%recv_counts, & & neighbor_comm_handle%recv_counts, &
& neighbor_comm_handle%recv_displs, & & neighbor_comm_handle%recv_displs, &
& psb_mpi_r_dpk_, & & psb_mpi_r_dpk_, &
@ -906,12 +951,18 @@ contains
end if end if
neighbor_comm_handle%persistent_in_flight = .false. neighbor_comm_handle%persistent_in_flight = .false.
! Scatter received data to local vector positions (polymorphic for GPU) ! Scatter received data to local vector positions (baseline-style sct)
if (debug) write(*,*) my_rank,' nbr_vect: scattering recv data,', topology_total_recv,' elems' if (debug) write(*,*) my_rank,' nbr_vect: scattering recv data (baseline layout),', topology_total_recv,' elems'
call y%sct(int(topology_total_recv,psb_mpk_), & pnti = 1
& neighbor_comm_handle%recv_indexes, & do i=1, num_neighbors
& y%combuf(topology_total_send+1:topology_total_send+topology_total_recv), & nerv = comm_indexes%v(pnti+psb_n_elem_recv_)
& beta) nesd = comm_indexes%v(pnti+nerv+psb_n_elem_send_)
rcv_pt = 1+pnti+psb_n_elem_recv_
if (nerv > 0) then
call y%sct(rcv_pt,nerv,comm_indexes,beta)
end if
pnti = pnti + nerv + nesd + 3
end do
end if end if
call y%device_wait() call y%device_wait()
@ -955,6 +1006,8 @@ contains
logical :: do_start, do_wait, memory_buffer_layout_rebuild_needed logical :: do_start, do_wait, memory_buffer_layout_rebuild_needed
type(psb_comm_rma_handle), pointer :: rma_handle type(psb_comm_rma_handle), pointer :: rma_handle
character(len=30) :: name character(len=30) :: name
integer(psb_ipk_) :: i, nesd, nerv, snd_pt, rcv_pt, pnti, n
info = psb_success_ info = psb_success_
name = 'psi_dswap_rma_pull_vect' name = 'psi_dswap_rma_pull_vect'
@ -1020,12 +1073,14 @@ contains
if (buffer_size > 0) then if (buffer_size > 0) then
if (.not. allocated(y%combuf)) then if (.not. allocated(y%combuf)) then
call y%new_buffer(buffer_size, info) ! Allocate buffer with size of comm_indexes%v to include all metadata,
! matching baseline and topology buffer layout
call y%new_buffer(ione*size(comm_indexes%v), info)
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_alloc_dealloc_,name) call psb_errpush(psb_err_alloc_dealloc_,name)
goto 9999 goto 9999
end if end if
else if (size(y%combuf) < buffer_size) then else if (size(y%combuf) < size(comm_indexes%v)) then
! Need a larger exposed memory area: recreate the RMA window first, ! Need a larger exposed memory area: recreate the RMA window first,
! then reallocate combuf and lazily create a new window below. ! then reallocate combuf and lazily create a new window below.
if (rma_handle%window_open) then if (rma_handle%window_open) then
@ -1047,7 +1102,9 @@ contains
rma_handle%window_ready = .false. rma_handle%window_ready = .false.
rma_handle%win = mpi_win_null rma_handle%win = mpi_win_null
end if end if
call y%new_buffer(buffer_size, info) ! Allocate buffer with size of comm_indexes%v to include all metadata,
! matching baseline and topology buffer layout
call y%new_buffer(ione*size(comm_indexes%v), info)
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_alloc_dealloc_,name) call psb_errpush(psb_err_alloc_dealloc_,name)
goto 9999 goto 9999
@ -1075,15 +1132,7 @@ contains
end if end if
call y%device_wait() call y%device_wait()
call mpi_win_lock_all(0, rma_handle%win, iret) ! Pull data from each peer with per-neighbor passive lock (neighbor-only sync).
if (iret /= mpi_success) then
info = psb_err_mpi_error_
call psb_errpush(info,name,m_err=(/iret/))
goto 9999
end if
rma_handle%window_open = .true.
! Pull data from each peer. The metadata exchange stays local and simple.
do neighbor_idx=1, num_neighbors do neighbor_idx=1, num_neighbors
proc_to_comm = rma_handle%peer_proc(neighbor_idx) proc_to_comm = rma_handle%peer_proc(neighbor_idx)
recv_count = rma_handle%peer_recv_counts(neighbor_idx) recv_count = rma_handle%peer_recv_counts(neighbor_idx)
@ -1106,6 +1155,12 @@ contains
end if end if
if (recv_count > 0) then if (recv_count > 0) then
call mpi_win_lock(MPI_LOCK_SHARED, prc_rank, 0, rma_handle%win, iret)
if (iret /= mpi_success) then
info = psb_err_mpi_error_
call psb_errpush(info,name,m_err=(/iret/))
goto 9999
end if
remote_disp = int(remote_base - 1, kind=MPI_ADDRESS_KIND) remote_disp = int(remote_base - 1, kind=MPI_ADDRESS_KIND)
call mpi_get(y%combuf(recv_pos), recv_count, psb_mpi_r_dpk_, prc_rank, remote_disp, recv_count, psb_mpi_r_dpk_, & call mpi_get(y%combuf(recv_pos), recv_count, psb_mpi_r_dpk_, prc_rank, remote_disp, recv_count, psb_mpi_r_dpk_, &
& rma_handle%win, iret) & rma_handle%win, iret)
@ -1114,13 +1169,13 @@ contains
call psb_errpush(info,name,m_err=(/iret/)) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
end if call mpi_win_unlock(prc_rank, rma_handle%win, iret)
call mpi_win_flush(prc_rank, rma_handle%win, iret)
if (iret /= mpi_success) then if (iret /= mpi_success) then
info = psb_err_mpi_error_ info = psb_err_mpi_error_
call psb_errpush(info,name,m_err=(/iret/)) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
end if
else else
if (send_count /= recv_count) then if (send_count /= recv_count) then
info = psb_err_internal_error_ info = psb_err_internal_error_
@ -1133,18 +1188,8 @@ contains
end if end if
end if end if
! WAIT phase: close the epoch and scatter the received slice back into Y. ! WAIT phase: GETs already complete (per-neighbor unlock in START); scatter received data into Y.
if (do_wait) then if (do_wait) then
if (rma_handle%window_open) then
call mpi_win_unlock_all(rma_handle%win, iret)
if (iret /= mpi_success) then
info = psb_err_mpi_error_
call psb_errpush(info,name,m_err=(/iret/))
goto 9999
end if
rma_handle%window_open = .false.
end if
if (total_recv > 0) then if (total_recv > 0) then
call y%sct(int(total_recv,psb_mpk_), rma_handle%peer_recv_indexes, y%combuf(total_send+1:total_send+total_recv), beta) call y%sct(int(total_recv,psb_mpk_), rma_handle%peer_recv_indexes, y%combuf(total_send+1:total_send+total_recv), beta)
end if end if
@ -1184,6 +1229,7 @@ contains
integer(kind=MPI_ADDRESS_KIND) :: remote_disp, exposed_bytes integer(kind=MPI_ADDRESS_KIND) :: remote_disp, exposed_bytes
integer(psb_ipk_) :: err_act, neighbor_idx, buffer_size integer(psb_ipk_) :: err_act, neighbor_idx, buffer_size
integer(psb_ipk_), allocatable :: peer_mpi_rank(:) integer(psb_ipk_), allocatable :: peer_mpi_rank(:)
integer(psb_mpk_), parameter :: rma_push_notify_tag = 914_psb_mpk_
logical :: do_start, do_wait, memory_buffer_layout_rebuild_needed logical :: do_start, do_wait, memory_buffer_layout_rebuild_needed
type(psb_comm_rma_handle), pointer :: rma_handle type(psb_comm_rma_handle), pointer :: rma_handle
character(len=30) :: name character(len=30) :: name
@ -1252,12 +1298,14 @@ contains
if (buffer_size > 0) then if (buffer_size > 0) then
if (.not. allocated(y%combuf)) then if (.not. allocated(y%combuf)) then
call y%new_buffer(buffer_size, info) ! Allocate buffer with size of comm_indexes%v to include all metadata,
! matching baseline and topology buffer layout
call y%new_buffer(ione*size(comm_indexes%v), info)
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_alloc_dealloc_,name) call psb_errpush(psb_err_alloc_dealloc_,name)
goto 9999 goto 9999
end if end if
else if (size(y%combuf) < buffer_size) then else if (size(y%combuf) < size(comm_indexes%v)) then
! Need a larger exposed memory area: recreate the RMA window first, ! Need a larger exposed memory area: recreate the RMA window first,
! then reallocate combuf and lazily create a new window below. ! then reallocate combuf and lazily create a new window below.
if (rma_handle%window_open) then if (rma_handle%window_open) then
@ -1279,7 +1327,9 @@ contains
rma_handle%window_ready = .false. rma_handle%window_ready = .false.
rma_handle%win = mpi_win_null rma_handle%win = mpi_win_null
end if end if
call y%new_buffer(buffer_size, info) ! Allocate buffer with size of comm_indexes%v to include all metadata,
! matching baseline and topology buffer layout
call y%new_buffer(ione*size(comm_indexes%v), info)
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_alloc_dealloc_,name) call psb_errpush(psb_err_alloc_dealloc_,name)
goto 9999 goto 9999
@ -1307,6 +1357,25 @@ contains
end if end if
call y%device_wait() call y%device_wait()
! Pre-post notification receives before opening the window (prevents isend/irecv ordering issues).
if (num_neighbors > 0) then
rma_handle%notify_recv_reqs(1:num_neighbors) = MPI_REQUEST_NULL
rma_handle%notify_send_reqs(1:num_neighbors) = MPI_REQUEST_NULL
end if
do neighbor_idx=1, num_neighbors
proc_to_comm = rma_handle%peer_proc(neighbor_idx)
if (proc_to_comm /= my_rank) then
prc_rank = rma_handle%peer_mpi_rank(neighbor_idx)
call mpi_irecv(rma_handle%notify_buf(neighbor_idx), 1, psb_mpi_mpk_, prc_rank, &
& rma_push_notify_tag, icomm, rma_handle%notify_recv_reqs(neighbor_idx), iret)
if (iret /= mpi_success) then
info = psb_err_mpi_error_
call psb_errpush(info,name,m_err=(/iret/))
goto 9999
end if
end if
end do
call mpi_win_lock_all(0, rma_handle%win, iret) call mpi_win_lock_all(0, rma_handle%win, iret)
if (iret /= mpi_success) then if (iret /= mpi_success) then
info = psb_err_mpi_error_ info = psb_err_mpi_error_
@ -1315,7 +1384,7 @@ contains
end if end if
rma_handle%window_open = .true. rma_handle%window_open = .true.
! Push data to each peer. Only the base displacement and count are exchanged. ! Push data to each peer; after flush send a P2P notification so target knows data arrived.
do neighbor_idx=1, num_neighbors do neighbor_idx=1, num_neighbors
proc_to_comm = rma_handle%peer_proc(neighbor_idx) proc_to_comm = rma_handle%peer_proc(neighbor_idx)
recv_count = rma_handle%peer_recv_counts(neighbor_idx) recv_count = rma_handle%peer_recv_counts(neighbor_idx)
@ -1353,6 +1422,13 @@ contains
call psb_errpush(info,name,m_err=(/iret/)) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
call mpi_isend(rma_handle%notify_buf(neighbor_idx), 1, psb_mpi_mpk_, prc_rank, &
& rma_push_notify_tag, icomm, rma_handle%notify_send_reqs(neighbor_idx), iret)
if (iret /= mpi_success) then
info = psb_err_mpi_error_
call psb_errpush(info,name,m_err=(/iret/))
goto 9999
end if
else else
if (send_count /= recv_count) then if (send_count /= recv_count) then
info = psb_err_internal_error_ info = psb_err_internal_error_
@ -1365,7 +1441,7 @@ contains
end if end if
end if end if
! WAIT phase: close the epoch and apply the receive-side scatter. ! WAIT phase: close epoch, wait for P2P notifications, then scatter.
if (do_wait) then if (do_wait) then
if (rma_handle%window_open) then if (rma_handle%window_open) then
call mpi_win_unlock_all(rma_handle%win, iret) call mpi_win_unlock_all(rma_handle%win, iret)
@ -1377,12 +1453,20 @@ contains
rma_handle%window_open = .false. rma_handle%window_open = .false.
end if end if
call mpi_barrier(icomm, iret) if (num_neighbors > 0) then
call mpi_waitall(num_neighbors, rma_handle%notify_recv_reqs, MPI_STATUSES_IGNORE, iret)
if (iret /= mpi_success) then
info = psb_err_mpi_error_
call psb_errpush(info,name,m_err=(/iret/))
goto 9999
end if
call mpi_waitall(num_neighbors, rma_handle%notify_send_reqs, MPI_STATUSES_IGNORE, iret)
if (iret /= mpi_success) then if (iret /= mpi_success) then
info = psb_err_mpi_error_ info = psb_err_mpi_error_
call psb_errpush(info,name,m_err=(/iret/)) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
end if
if (total_recv > 0) then if (total_recv > 0) then
call y%sct(int(total_recv,psb_mpk_), rma_handle%peer_recv_indexes, y%combuf(total_send+1:total_send+total_recv), beta) call y%sct(int(total_recv,psb_mpk_), rma_handle%peer_recv_indexes, y%combuf(total_send+1:total_send+total_recv), beta)
@ -1431,6 +1515,7 @@ contains
type(psb_ctxt_type) :: ctxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm integer(psb_mpk_) :: icomm
integer(psb_ipk_) :: np, my_rank, total_send, total_recv, num_neighbors, data_, err_act integer(psb_ipk_) :: np, my_rank, total_send, total_recv, num_neighbors, data_, err_act
integer(psb_mpk_) :: n, total_send_, total_recv_
class(psb_i_base_vect_type), pointer :: comm_indexes class(psb_i_base_vect_type), pointer :: comm_indexes
character(len=30) :: name character(len=30) :: name
@ -1487,6 +1572,10 @@ contains
goto 9999 goto 9999
end if end if
n = y%get_ncols()
total_send_ = total_send * n
total_recv_ = total_recv * n
baseline = .false. baseline = .false.
ineighbor_a2av = .false. ineighbor_a2av = .false.
ineighbor_a2av_persistent = .false. ineighbor_a2av_persistent = .false.
@ -1495,10 +1584,20 @@ contains
ineighbor_a2av = .true. ineighbor_a2av = .true.
case(psb_comm_persistent_ineighbor_alltoallv_) case(psb_comm_persistent_ineighbor_alltoallv_)
ineighbor_a2av_persistent = .true. ineighbor_a2av_persistent = .true.
case(psb_comm_rma_pull_, psb_comm_rma_push_) case(psb_comm_rma_pull_)
info = psb_err_mpi_error_ call psi_dswap_rma_pull_multivect(ctxt,swap_status,beta,y,comm_indexes,num_neighbors,total_send,total_recv,&
call psb_errpush(info,name,a_err='RMA swap is not yet enabled for multivectors') & y%comm_handle,info)
if (info /= psb_success_) then
call psb_errpush(info,name,a_err='rma pull swap')
goto 9999
end if
case(psb_comm_rma_push_)
call psi_dswap_rma_push_multivect(ctxt,swap_status,beta,y,comm_indexes,num_neighbors,total_send,total_recv,&
& y%comm_handle,info)
if (info /= psb_success_) then
call psb_errpush(info,name,a_err='rma push swap')
goto 9999 goto 9999
end if
case default case default
baseline = .true. baseline = .true.
end select end select
@ -1611,7 +1710,7 @@ subroutine psi_dswap_baseline_multivect(ctxt,swap_status,beta,y,comm_indexes, &
end if end if
end if end if
if (debug) write(*,*) my_rank,'do_send start' if (debug) write(*,*) my_rank,'do_send start'
call y%new_buffer(ione*size(comm_indexes%v),info) call y%new_buffer(total_send_+total_recv_,info)
call psb_realloc(num_neighbors,2_psb_ipk_,baseline_comm_handle%comid,info) call psb_realloc(num_neighbors,2_psb_ipk_,baseline_comm_handle%comid,info)
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_alloc_dealloc_,name) call psb_errpush(psb_err_alloc_dealloc_,name)
@ -1815,10 +1914,12 @@ subroutine psi_dswap_neighbor_topology_multivect(ctxt,swap_status,beta,y,comm_in
! locals ! locals
integer(psb_mpk_) :: icomm integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: np, my_rank integer(psb_mpk_) :: np, my_rank, n
integer(psb_mpk_) :: iret, p2pstat(mpi_status_size) integer(psb_mpk_) :: iret, p2pstat(mpi_status_size)
type(psb_comm_neighbor_handle), pointer :: neighbor_comm_handle type(psb_comm_neighbor_handle), pointer :: neighbor_comm_handle
integer(psb_ipk_) :: err_act, topology_total_send, topology_total_recv, buffer_size integer(psb_ipk_) :: err_act, topology_total_send, topology_total_recv, buffer_size
integer(psb_mpk_) :: total_send_, total_recv_
integer(psb_mpk_) :: total_send_, total_recv_
logical :: do_start, do_wait logical :: do_start, do_wait
logical, parameter :: debug = .false. logical, parameter :: debug = .false.
character(len=30) :: name character(len=30) :: name
@ -1835,6 +1936,7 @@ subroutine psi_dswap_neighbor_topology_multivect(ctxt,swap_status,beta,y,comm_in
endif endif
icomm = ctxt%get_mpic() icomm = ctxt%get_mpic()
n = y%get_ncols()
neighbor_comm_handle => null() neighbor_comm_handle => null()
select type(ch => comm_handle) select type(ch => comm_handle)
@ -1867,11 +1969,15 @@ subroutine psi_dswap_neighbor_topology_multivect(ctxt,swap_status,beta,y,comm_in
end if end if
topology_total_send = neighbor_comm_handle%total_send topology_total_send = neighbor_comm_handle%total_send
topology_total_recv = neighbor_comm_handle%total_recv topology_total_recv = neighbor_comm_handle%total_recv
total_send_ = topology_total_send * n
total_recv_ = topology_total_recv * n
total_send_ = topology_total_send * n
total_recv_ = topology_total_recv * n
! Buffer layout: ! Buffer layout:
! combuf(1 : total_send) = send area ! combuf(1 : total_send) = send area
! combuf(total_send+1 : total_send+total_recv) = recv area ! combuf(total_send+1 : total_send+total_recv) = recv area
buffer_size = topology_total_send + topology_total_recv buffer_size = total_send_ + total_recv_
if (buffer_size > 0) then if (buffer_size > 0) then
call y%new_buffer(buffer_size, info) call y%new_buffer(buffer_size, info)
@ -1887,7 +1993,7 @@ subroutine psi_dswap_neighbor_topology_multivect(ctxt,swap_status,beta,y,comm_in
if (debug) write(*,*) my_rank,' nbr_vect: gathering send data,', topology_total_send,' elems' if (debug) write(*,*) my_rank,' nbr_vect: gathering send data,', topology_total_send,' elems'
call y%gth(int(topology_total_send,psb_mpk_), & call y%gth(int(topology_total_send,psb_mpk_), &
& neighbor_comm_handle%send_indexes, & & neighbor_comm_handle%send_indexes, &
& y%combuf(1:topology_total_send)) & y%combuf(1:total_send_))
end if end if
! Wait for device (important for GPU subclasses) ! Wait for device (important for GPU subclasses)
@ -1901,9 +2007,9 @@ subroutine psi_dswap_neighbor_topology_multivect(ctxt,swap_status,beta,y,comm_in
& neighbor_comm_handle%send_counts, & & neighbor_comm_handle%send_counts, &
& neighbor_comm_handle%send_displs, & & neighbor_comm_handle%send_displs, &
& psb_mpi_r_dpk_, & & psb_mpi_r_dpk_, &
& y%combuf(topology_total_send + 1), & ! recv buffer & y%combuf(total_send_ + 1), & ! recv buffer
& neighbor_comm_handle%recv_counts, & & n*neighbor_comm_handle%recv_counts, &
& neighbor_comm_handle%recv_displs, & & n*neighbor_comm_handle%recv_displs, &
& psb_mpi_r_dpk_, & & psb_mpi_r_dpk_, &
& neighbor_comm_handle%graph_comm, & & neighbor_comm_handle%graph_comm, &
& neighbor_comm_handle%comm_request, iret) & neighbor_comm_handle%comm_request, iret)
@ -1952,7 +2058,7 @@ subroutine psi_dswap_neighbor_topology_multivect(ctxt,swap_status,beta,y,comm_in
if (debug) write(*,*) my_rank,' nbr_vect: scattering recv data,', topology_total_recv,' elems' if (debug) write(*,*) my_rank,' nbr_vect: scattering recv data,', topology_total_recv,' elems'
call y%sct(int(topology_total_recv,psb_mpk_), & call y%sct(int(topology_total_recv,psb_mpk_), &
& neighbor_comm_handle%recv_indexes, & & neighbor_comm_handle%recv_indexes, &
& y%combuf(topology_total_send+1:topology_total_send+topology_total_recv), & & y%combuf(total_send_+1:total_send_+total_recv_), &
& beta) & beta)
end if end if
@ -2001,10 +2107,11 @@ subroutine psi_dswap_neighbor_topology_multivect_persistent(ctxt,swap_status,bet
! locals ! locals
integer(psb_mpk_) :: icomm integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: np, my_rank integer(psb_mpk_) :: np, my_rank, n
integer(psb_mpk_) :: iret, p2pstat(mpi_status_size) integer(psb_mpk_) :: iret, p2pstat(mpi_status_size)
type(psb_comm_neighbor_handle), pointer :: neighbor_comm_handle type(psb_comm_neighbor_handle), pointer :: neighbor_comm_handle
integer(psb_ipk_) :: err_act, topology_total_send, topology_total_recv, buffer_size integer(psb_ipk_) :: err_act, topology_total_send, topology_total_recv, buffer_size
integer(psb_mpk_) :: total_send_, total_recv_
logical :: do_start, do_wait logical :: do_start, do_wait
logical, parameter :: debug = .false. logical, parameter :: debug = .false.
character(len=30) :: name character(len=30) :: name
@ -2021,6 +2128,7 @@ subroutine psi_dswap_neighbor_topology_multivect_persistent(ctxt,swap_status,bet
endif endif
icomm = ctxt%get_mpic() icomm = ctxt%get_mpic()
n = y%get_ncols()
neighbor_comm_handle => null() neighbor_comm_handle => null()
select type(ch => comm_handle) select type(ch => comm_handle)
@ -2062,7 +2170,7 @@ subroutine psi_dswap_neighbor_topology_multivect_persistent(ctxt,swap_status,bet
! Buffer layout: ! Buffer layout:
! combuf(1 : total_send) = send area ! combuf(1 : total_send) = send area
! combuf(total_send+1 : total_send+total_recv) = recv area ! combuf(total_send+1 : total_send+total_recv) = recv area
buffer_size = topology_total_send + topology_total_recv buffer_size = total_send_ + total_recv_
if (buffer_size > 0) then if (buffer_size > 0) then
if (.not. allocated(y%combuf)) then if (.not. allocated(y%combuf)) then
@ -2104,7 +2212,7 @@ subroutine psi_dswap_neighbor_topology_multivect_persistent(ctxt,swap_status,bet
if (debug) write(*,*) my_rank,' nbr_vect: gathering send data,', topology_total_send,' elems' if (debug) write(*,*) my_rank,' nbr_vect: gathering send data,', topology_total_send,' elems'
call y%gth(int(topology_total_send,psb_mpk_), & call y%gth(int(topology_total_send,psb_mpk_), &
& neighbor_comm_handle%send_indexes, & & neighbor_comm_handle%send_indexes, &
& y%combuf(1:topology_total_send)) & y%combuf(1:total_send_))
else else
neighbor_comm_handle%persistent_in_flight = .false. neighbor_comm_handle%persistent_in_flight = .false.
end if end if
@ -2117,12 +2225,12 @@ subroutine psi_dswap_neighbor_topology_multivect_persistent(ctxt,swap_status,bet
if (debug) write(*,*) my_rank,' nbr_vect: posting MPI_Neighbor_alltoallv_init' if (debug) write(*,*) my_rank,' nbr_vect: posting MPI_Neighbor_alltoallv_init'
call mpi_neighbor_alltoallv_init( & call mpi_neighbor_alltoallv_init( &
& y%combuf(1), & ! send buffer & y%combuf(1), & ! send buffer
& neighbor_comm_handle%send_counts, & & n*neighbor_comm_handle%send_counts, &
& neighbor_comm_handle%send_displs, & & n*neighbor_comm_handle%send_displs, &
& psb_mpi_r_dpk_, & & psb_mpi_r_dpk_, &
& y%combuf(topology_total_send + 1), & ! recv buffer & y%combuf(total_send_ + 1), & ! recv buffer
& neighbor_comm_handle%recv_counts, & & n*neighbor_comm_handle%recv_counts, &
& neighbor_comm_handle%recv_displs, & & n*neighbor_comm_handle%recv_displs, &
& psb_mpi_r_dpk_, & & psb_mpi_r_dpk_, &
& neighbor_comm_handle%graph_comm, & & neighbor_comm_handle%graph_comm, &
& mpi_info_null, & & mpi_info_null, &
@ -2183,7 +2291,7 @@ subroutine psi_dswap_neighbor_topology_multivect_persistent(ctxt,swap_status,bet
if (debug) write(*,*) my_rank,' nbr_vect: scattering recv data,', topology_total_recv,' elems' if (debug) write(*,*) my_rank,' nbr_vect: scattering recv data,', topology_total_recv,' elems'
call y%sct(int(topology_total_recv,psb_mpk_), & call y%sct(int(topology_total_recv,psb_mpk_), &
& neighbor_comm_handle%recv_indexes, & & neighbor_comm_handle%recv_indexes, &
& y%combuf(topology_total_send+1:topology_total_send+topology_total_recv), & & y%combuf(total_send_+1:total_send_+total_recv_), &
& beta) & beta)
else else
neighbor_comm_handle%persistent_in_flight = .false. neighbor_comm_handle%persistent_in_flight = .false.
@ -2203,5 +2311,436 @@ subroutine psi_dswap_neighbor_topology_multivect_persistent(ctxt,swap_status,bet
end subroutine psi_dswap_neighbor_topology_multivect_persistent end subroutine psi_dswap_neighbor_topology_multivect_persistent
subroutine psi_dswap_rma_pull_multivect(ctxt,swap_status,beta,y,comm_indexes,num_neighbors,total_send,total_recv,comm_handle,info)
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_ipk_), intent(in) :: swap_status
real(psb_dpk_), intent(in) :: beta
class(psb_d_base_multivect_type), intent(inout) :: y
class(psb_i_base_vect_type), intent(inout) :: comm_indexes
integer(psb_ipk_), intent(in) :: num_neighbors, total_send, total_recv
class(psb_comm_handle_type), intent(inout) :: comm_handle
integer(psb_ipk_), intent(out) :: info
integer(psb_mpk_) :: np, my_rank, iret, element_bytes, icomm, n
integer(psb_mpk_) :: proc_to_comm, prc_rank, recv_count, send_count, send_pos, recv_pos, list_pos
integer(psb_mpk_) :: remote_base
integer(kind=MPI_ADDRESS_KIND) :: remote_disp, exposed_bytes
integer(psb_ipk_) :: err_act, neighbor_idx, buffer_size, total_send_, total_recv_
integer(psb_ipk_), allocatable :: peer_mpi_rank(:)
logical :: do_start, do_wait, memory_buffer_layout_rebuild_needed
type(psb_comm_rma_handle), pointer :: rma_handle
character(len=30) :: name
info = psb_success_
name = 'psi_dswap_rma_pull_multivect'
call psb_erractionsave(err_act)
call psb_info(ctxt,my_rank,np)
if (np == -1) then
info = psb_err_context_error_
call psb_errpush(info,name)
goto 9999
end if
icomm = ctxt%get_mpic()
n = y%get_ncols()
total_send_ = total_send * n
total_recv_ = total_recv * n
select type(ch => comm_handle)
type is(psb_comm_rma_handle)
rma_handle => ch
class default
info = psb_err_mpi_error_
call psb_errpush(info,name,a_err='Expected RMA comm_handle for pull mode')
goto 9999
end select
do_start = (swap_status == psb_comm_status_start_) .or. (swap_status == psb_comm_status_sync_)
do_wait = (swap_status == psb_comm_status_wait_) .or. (swap_status == psb_comm_status_sync_)
call comm_indexes%sync()
if (do_start) then
buffer_size = total_send_ + total_recv_
memory_buffer_layout_rebuild_needed = (.not. rma_handle%layout_ready) .or. &
& (rma_handle%layout_nnbr /= num_neighbors) .or. &
& (rma_handle%layout_send /= total_send) .or. &
& (rma_handle%layout_recv /= total_recv)
if (memory_buffer_layout_rebuild_needed) then
if (allocated(peer_mpi_rank)) deallocate(peer_mpi_rank)
if (num_neighbors > 0) then
allocate(peer_mpi_rank(num_neighbors), stat=iret)
if (iret /= 0) then
info = psb_err_alloc_dealloc_
call psb_errpush(info,name,a_err='RMA pull rank cache allocation')
goto 9999
end if
end if
list_pos = 1
do neighbor_idx = 1, num_neighbors
proc_to_comm = comm_indexes%v(list_pos+psb_proc_id_)
peer_mpi_rank(neighbor_idx) = psb_get_mpi_rank(ctxt,proc_to_comm)
recv_count = comm_indexes%v(list_pos+psb_n_elem_recv_)
send_count = comm_indexes%v(list_pos+recv_count+psb_n_elem_send_)
list_pos = list_pos + recv_count + send_count + 3
end do
call rma_handle%init_memory_buffer_layout(info, comm_indexes%v, peer_mpi_rank, &
& num_neighbors, total_send, total_recv, my_rank, icomm)
if (info /= psb_success_) then
call psb_errpush(info,name,a_err='RMA pull init_memory_buffer_layout failure')
goto 9999
end if
end if
if (buffer_size > 0) then
if (.not. allocated(y%combuf)) then
call y%new_buffer(buffer_size, info)
if (info /= psb_success_) then
call psb_errpush(psb_err_alloc_dealloc_,name)
goto 9999
end if
else if (size(y%combuf) < buffer_size) then
call y%new_buffer(buffer_size, info)
if (info /= psb_success_) then
call psb_errpush(psb_err_alloc_dealloc_,name)
goto 9999
end if
end if
end if
if ((buffer_size > 0).and.(.not. rma_handle%window_ready)) then
element_bytes = storage_size(y%combuf(1))/8
exposed_bytes = int(size(y%combuf),kind=MPI_ADDRESS_KIND) * int(element_bytes,kind=MPI_ADDRESS_KIND)
call mpi_win_create(y%combuf, exposed_bytes, element_bytes, &
& mpi_info_null, ctxt%get_mpic(), rma_handle%win, iret)
if (iret /= mpi_success) then
info = psb_err_mpi_error_
call psb_errpush(info,name,m_err=(/iret/))
goto 9999
end if
rma_handle%window_ready = .true.
end if
if (buffer_size > 0) then
if (total_send > 0) then
call y%gth(int(total_send,psb_mpk_), rma_handle%peer_send_indexes, y%combuf(1:total_send_))
end if
call y%device_wait()
! Pull data from each peer with per-neighbor passive lock (neighbor-only sync).
do neighbor_idx=1, num_neighbors
proc_to_comm = rma_handle%peer_proc(neighbor_idx)
recv_count = rma_handle%peer_recv_counts(neighbor_idx)
send_count = rma_handle%peer_send_counts(neighbor_idx)
prc_rank = rma_handle%peer_mpi_rank(neighbor_idx)
send_pos = rma_handle%peer_send_displs(neighbor_idx)*n + 1
recv_pos = total_send_ + rma_handle%peer_recv_displs(neighbor_idx)*n + 1
if (proc_to_comm /= my_rank) then
remote_base = rma_handle%peer_remote_send_displs(neighbor_idx)
if (remote_base < 1) then
info = psb_err_internal_error_
call psb_errpush(info,name,a_err='Invalid remote metadata in RMA pull')
goto 9999
end if
if (recv_count > 0) then
call mpi_win_lock(MPI_LOCK_SHARED, prc_rank, 0, rma_handle%win, iret)
if (iret /= mpi_success) then
info = psb_err_mpi_error_
call psb_errpush(info,name,m_err=(/iret/))
goto 9999
end if
remote_disp = int((remote_base - 1) * n, kind=MPI_ADDRESS_KIND)
call mpi_get(y%combuf(recv_pos), recv_count*n, psb_mpi_r_dpk_, prc_rank, remote_disp, recv_count*n, psb_mpi_r_dpk_, &
& rma_handle%win, iret)
if (iret /= mpi_success) then
info = psb_err_mpi_error_
call psb_errpush(info,name,m_err=(/iret/))
goto 9999
end if
call mpi_win_unlock(prc_rank, rma_handle%win, iret)
if (iret /= mpi_success) then
info = psb_err_mpi_error_
call psb_errpush(info,name,m_err=(/iret/))
goto 9999
end if
end if
else
if (send_count /= recv_count) then
info = psb_err_internal_error_
call psb_errpush(info,name,a_err='RMA pull self-copy mismatch')
goto 9999
end if
y%combuf(recv_pos:recv_pos+recv_count*n-1) = y%combuf(send_pos:send_pos+send_count*n-1)
end if
end do
end if
end if
! WAIT phase: GETs already complete (per-neighbor unlock in START); scatter received data into Y.
if (do_wait) then
if (total_recv > 0) then
call y%sct(int(total_recv,psb_mpk_), rma_handle%peer_recv_indexes, y%combuf(total_send_+1:total_send_+total_recv_), beta)
end if
call y%device_wait()
end if
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(ctxt,err_act)
return
end subroutine psi_dswap_rma_pull_multivect
subroutine psi_dswap_rma_push_multivect(ctxt,swap_status,beta,y,comm_indexes,num_neighbors,total_send,total_recv,comm_handle,info)
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_ipk_), intent(in) :: swap_status
real(psb_dpk_), intent(in) :: beta
class(psb_d_base_multivect_type), intent(inout) :: y
class(psb_i_base_vect_type), intent(inout) :: comm_indexes
integer(psb_ipk_), intent(in) :: num_neighbors, total_send, total_recv
class(psb_comm_handle_type), intent(inout) :: comm_handle
integer(psb_ipk_), intent(out) :: info
integer(psb_mpk_) :: np, my_rank, iret, element_bytes, icomm, n
integer(psb_mpk_) :: proc_to_comm, prc_rank, recv_count, send_count, send_pos, recv_pos, list_pos
integer(psb_mpk_) :: remote_base
integer(kind=MPI_ADDRESS_KIND) :: remote_disp, exposed_bytes
integer(psb_ipk_) :: err_act, neighbor_idx, buffer_size, total_send_, total_recv_
integer(psb_ipk_), allocatable :: peer_mpi_rank(:)
integer(psb_mpk_), parameter :: rma_push_notify_tag = 914_psb_mpk_
logical :: do_start, do_wait, memory_buffer_layout_rebuild_needed
type(psb_comm_rma_handle), pointer :: rma_handle
character(len=30) :: name
info = psb_success_
name = 'psi_dswap_rma_push_multivect'
call psb_erractionsave(err_act)
call psb_info(ctxt,my_rank,np)
if (np == -1) then
info = psb_err_context_error_
call psb_errpush(info,name)
goto 9999
end if
icomm = ctxt%get_mpic()
n = y%get_ncols()
total_send_ = total_send * n
total_recv_ = total_recv * n
select type(ch => comm_handle)
type is(psb_comm_rma_handle)
rma_handle => ch
class default
info = psb_err_mpi_error_
call psb_errpush(info,name,a_err='Expected RMA comm_handle for push mode')
goto 9999
end select
do_start = (swap_status == psb_comm_status_start_) .or. (swap_status == psb_comm_status_sync_)
do_wait = (swap_status == psb_comm_status_wait_) .or. (swap_status == psb_comm_status_sync_)
call comm_indexes%sync()
if (do_start) then
buffer_size = total_send_ + total_recv_
memory_buffer_layout_rebuild_needed = (.not. rma_handle%layout_ready) .or. &
& (rma_handle%layout_nnbr /= num_neighbors) .or. &
& (rma_handle%layout_send /= total_send) .or. &
& (rma_handle%layout_recv /= total_recv)
if (memory_buffer_layout_rebuild_needed) then
if (allocated(peer_mpi_rank)) deallocate(peer_mpi_rank)
if (num_neighbors > 0) then
allocate(peer_mpi_rank(num_neighbors), stat=iret)
if (iret /= 0) then
info = psb_err_alloc_dealloc_
call psb_errpush(info,name,a_err='RMA put rank cache allocation')
goto 9999
end if
end if
list_pos = 1
do neighbor_idx = 1, num_neighbors
proc_to_comm = comm_indexes%v(list_pos+psb_proc_id_)
peer_mpi_rank(neighbor_idx) = psb_get_mpi_rank(ctxt,proc_to_comm)
recv_count = comm_indexes%v(list_pos+psb_n_elem_recv_)
send_count = comm_indexes%v(list_pos+recv_count+psb_n_elem_send_)
list_pos = list_pos + recv_count + send_count + 3
end do
call rma_handle%init_memory_buffer_layout(info, comm_indexes%v, peer_mpi_rank, &
& num_neighbors, total_send, total_recv, my_rank, icomm)
if (info /= psb_success_) then
call psb_errpush(info,name,a_err='RMA put ini_memory_buffer_layout')
goto 9999
end if
end if
if (buffer_size > 0) then
if (.not. allocated(y%combuf)) then
call y%new_buffer(buffer_size, info)
if (info /= psb_success_) then
call psb_errpush(psb_err_alloc_dealloc_,name)
goto 9999
end if
else if (size(y%combuf) < buffer_size) then
call y%new_buffer(buffer_size, info)
if (info /= psb_success_) then
call psb_errpush(psb_err_alloc_dealloc_,name)
goto 9999
end if
end if
end if
if ((buffer_size > 0).and.(.not. rma_handle%window_ready)) then
element_bytes = storage_size(y%combuf(1))/8
exposed_bytes = int(size(y%combuf),kind=MPI_ADDRESS_KIND) * int(element_bytes,kind=MPI_ADDRESS_KIND)
call mpi_win_create(y%combuf, exposed_bytes, element_bytes, &
& mpi_info_null, ctxt%get_mpic(), rma_handle%win, iret)
if (iret /= mpi_success) then
info = psb_err_mpi_error_
call psb_errpush(info,name,m_err=(/iret/))
goto 9999
end if
rma_handle%window_ready = .true.
end if
if (buffer_size > 0) then
if (total_send > 0) then
call y%gth(int(total_send,psb_mpk_), rma_handle%peer_send_indexes, y%combuf(1:total_send_))
end if
call y%device_wait()
! Pre-post notification receives before opening the window.
if (num_neighbors > 0) then
rma_handle%notify_recv_reqs(1:num_neighbors) = MPI_REQUEST_NULL
rma_handle%notify_send_reqs(1:num_neighbors) = MPI_REQUEST_NULL
end if
do neighbor_idx=1, num_neighbors
proc_to_comm = rma_handle%peer_proc(neighbor_idx)
if (proc_to_comm /= my_rank) then
prc_rank = rma_handle%peer_mpi_rank(neighbor_idx)
call mpi_irecv(rma_handle%notify_buf(neighbor_idx), 1, psb_mpi_mpk_, prc_rank, &
& rma_push_notify_tag, icomm, rma_handle%notify_recv_reqs(neighbor_idx), iret)
if (iret /= mpi_success) then
info = psb_err_mpi_error_
call psb_errpush(info,name,m_err=(/iret/))
goto 9999
end if
end if
end do
call mpi_win_lock_all(0, rma_handle%win, iret)
if (iret /= mpi_success) then
info = psb_err_mpi_error_
call psb_errpush(info,name,m_err=(/iret/))
goto 9999
end if
rma_handle%window_open = .true.
do neighbor_idx=1, num_neighbors
proc_to_comm = rma_handle%peer_proc(neighbor_idx)
recv_count = rma_handle%peer_recv_counts(neighbor_idx)
send_count = rma_handle%peer_send_counts(neighbor_idx)
prc_rank = rma_handle%peer_mpi_rank(neighbor_idx)
send_pos = rma_handle%peer_send_displs(neighbor_idx)*n + 1
recv_pos = total_send_ + rma_handle%peer_recv_displs(neighbor_idx)*n + 1
if (proc_to_comm /= my_rank) then
remote_base = rma_handle%peer_remote_recv_displs(neighbor_idx)
if (remote_base < 1) then
info = psb_err_internal_error_
call psb_errpush(info,name,a_err='Invalid remote metadata in RMA push')
goto 9999
end if
if (send_count > 0) then
remote_disp = int((remote_base - 1) * n, kind=MPI_ADDRESS_KIND)
call mpi_put(y%combuf(send_pos), send_count*n, psb_mpi_r_dpk_, prc_rank, remote_disp, send_count*n, psb_mpi_r_dpk_, &
& rma_handle%win, iret)
if (iret /= mpi_success) then
info = psb_err_mpi_error_
call psb_errpush(info,name,m_err=(/iret/))
goto 9999
end if
end if
call mpi_win_flush(prc_rank, rma_handle%win, iret)
if (iret /= mpi_success) then
info = psb_err_mpi_error_
call psb_errpush(info,name,m_err=(/iret/))
goto 9999
end if
call mpi_isend(rma_handle%notify_buf(neighbor_idx), 1, psb_mpi_mpk_, prc_rank, &
& rma_push_notify_tag, icomm, rma_handle%notify_send_reqs(neighbor_idx), iret)
if (iret /= mpi_success) then
info = psb_err_mpi_error_
call psb_errpush(info,name,m_err=(/iret/))
goto 9999
end if
else
if (send_count /= recv_count) then
info = psb_err_internal_error_
call psb_errpush(info,name,a_err='RMA push self-copy mismatch')
goto 9999
end if
y%combuf(recv_pos:recv_pos+recv_count*n-1) = y%combuf(send_pos:send_pos+send_count*n-1)
end if
end do
end if
end if
! WAIT phase: close epoch, wait for P2P notifications, then scatter.
if (do_wait) then
if (rma_handle%window_open) then
call mpi_win_unlock_all(rma_handle%win, iret)
if (iret /= mpi_success) then
info = psb_err_mpi_error_
call psb_errpush(info,name,m_err=(/iret/))
goto 9999
end if
rma_handle%window_open = .false.
end if
if (num_neighbors > 0) then
call mpi_waitall(num_neighbors, rma_handle%notify_recv_reqs, MPI_STATUSES_IGNORE, iret)
if (iret /= mpi_success) then
info = psb_err_mpi_error_
call psb_errpush(info,name,m_err=(/iret/))
goto 9999
end if
call mpi_waitall(num_neighbors, rma_handle%notify_send_reqs, MPI_STATUSES_IGNORE, iret)
if (iret /= mpi_success) then
info = psb_err_mpi_error_
call psb_errpush(info,name,m_err=(/iret/))
goto 9999
end if
end if
if (total_recv > 0) then
call y%sct(int(total_recv,psb_mpk_), rma_handle%peer_recv_indexes, y%combuf(total_send_+1:total_send_+total_recv_), beta)
end if
call y%device_wait()
end if
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(ctxt,err_act)
return
end subroutine psi_dswap_rma_push_multivect
end submodule psi_d_swapdata_impl end submodule psi_d_swapdata_impl

1423
base/comm/internals/psi_dswaptran.F90
View File

File diff suppressed because it is too large Load Diff

2
base/comm/internals/psi_eovrl_restr_a.f90
Unescape Escape View File

@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may ! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED

2
base/comm/internals/psi_eovrl_save_a.f90
Unescape Escape View File

@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may ! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED

2
base/comm/internals/psi_eovrl_upd_a.f90
Unescape Escape View File

@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may ! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED

54
base/comm/internals/psi_eswapdata_a.F90
Unescape Escape View File

@ -39,7 +39,7 @@
! application environment. All the variants have the same structure ! application environment. All the variants have the same structure
! In all these subroutines X may be: I Integer ! In all these subroutines X may be: I Integer
! S real(psb_spk_) ! S real(psb_spk_)
! D real(psb_dpk_) ! D integer(psb_epk_)
! C complex(psb_spk_) ! C complex(psb_spk_)
! Z complex(psb_dpk_) ! Z complex(psb_dpk_)
! Basically the operation is as follows: on each process, we identify ! Basically the operation is as follows: on each process, we identify
@ -70,10 +70,10 @@
! !
! !
! n - integer Number of columns in Y ! n - integer Number of columns in Y
! beta - integer Choose overwrite or sum. ! beta - real Choose overwrite or sum.
! y(:,:) - integer The data area ! y(:,:) - real The data area
! desc_a - type(psb_desc_type). The communication descriptor. ! desc_a - type(psb_desc_type). The communication descriptor.
! work(:) - integer Buffer space. If not sufficient, will do ! work(:) - real Buffer space. If not sufficient, will do
! our own internal allocation. ! our own internal allocation.
! info - integer. return code. ! info - integer. return code.
! data - integer which list is to be used to exchange data ! data - integer which list is to be used to exchange data
@ -97,12 +97,13 @@ contains
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info integer(psb_mpk_), intent(in) :: n
integer(psb_epk_) :: y(:,:), beta integer(psb_epk_), intent(in) :: beta
integer(psb_epk_), target :: work(:) integer(psb_epk_), intent(inout) :: y(:,:)
type(psb_desc_type),target :: desc_a type(psb_desc_type),target :: desc_a
integer(psb_epk_), target :: work(:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional :: data integer(psb_ipk_), optional :: data
! locals ! locals
@ -165,11 +166,12 @@ integer(psb_epk_), target :: work(:)
#endif #endif
type(psb_ctxt_type), intent(in) :: ctxt type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(in) :: flag
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_epk_) :: y(:,:), beta integer(psb_epk_), intent(in) :: beta
integer(psb_epk_), target :: work(:) integer(psb_epk_), intent(inout) :: y(:,:)
integer(psb_epk_), target :: work(:)
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv
! locals ! locals
@ -348,7 +350,7 @@ integer(psb_epk_), pointer, dimension(:) :: sndbuf, rcvbuf
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm) prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm)
if ((nerv>0).and.(proc_to_comm /= me)) then if ((nerv>0).and.(proc_to_comm /= me)) then
p2ptag = psb_int8_swap_tag p2ptag = psb_double_swap_tag
call mpi_irecv(rcvbuf(rcv_pt),n*nerv,& call mpi_irecv(rcvbuf(rcv_pt),n*nerv,&
& psb_mpi_epk_,prcid(i),& & psb_mpi_epk_,prcid(i),&
& p2ptag, icomm,rvhd(i),iret) & p2ptag, icomm,rvhd(i),iret)
@ -370,7 +372,7 @@ integer(psb_epk_), pointer, dimension(:) :: sndbuf, rcvbuf
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
p2ptag = psb_int8_swap_tag p2ptag = psb_double_swap_tag
if ((nesd>0).and.(proc_to_comm /= me)) then if ((nesd>0).and.(proc_to_comm /= me)) then
if (usersend) then if (usersend) then
call mpi_rsend(sndbuf(snd_pt),n*nesd,& call mpi_rsend(sndbuf(snd_pt),n*nesd,&
@ -401,7 +403,7 @@ integer(psb_epk_), pointer, dimension(:) :: sndbuf, rcvbuf
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
p2ptag = psb_int8_swap_tag p2ptag = psb_double_swap_tag
if ((proc_to_comm /= me).and.(nerv>0)) then if ((proc_to_comm /= me).and.(nerv>0)) then
call mpi_wait(rvhd(i),p2pstat,iret) call mpi_wait(rvhd(i),p2pstat,iret)
@ -510,7 +512,7 @@ integer(psb_epk_), pointer, dimension(:) :: sndbuf, rcvbuf
! application environment. All the variants have the same structure ! application environment. All the variants have the same structure
! In all these subroutines X may be: I Integer ! In all these subroutines X may be: I Integer
! S real(psb_spk_) ! S real(psb_spk_)
! D real(psb_dpk_) ! D integer(psb_epk_)
! C complex(psb_spk_) ! C complex(psb_spk_)
! Z complex(psb_dpk_) ! Z complex(psb_dpk_)
! Basically the operation is as follows: on each process, we identify ! Basically the operation is as follows: on each process, we identify
@ -541,10 +543,10 @@ integer(psb_epk_), pointer, dimension(:) :: sndbuf, rcvbuf
! !
! !
! n - integer Number of columns in Y ! n - integer Number of columns in Y
! beta - integer Choose overwrite or sum. ! beta - real Choose overwrite or sum.
! y(:) - integer The data area ! y(:) - real The data area
! desc_a - type(psb_desc_type). The communication descriptor. ! desc_a - type(psb_desc_type). The communication descriptor.
! work(:) - integer Buffer space. If not sufficient, will do ! work(:) - real Buffer space. If not sufficient, will do
! our own internal allocation. ! our own internal allocation.
! info - integer. return code. ! info - integer. return code.
! data - integer which list is to be used to exchange data ! data - integer which list is to be used to exchange data
@ -566,10 +568,11 @@ integer(psb_epk_), pointer, dimension(:) :: sndbuf, rcvbuf
#endif #endif
integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info integer(psb_epk_), intent(in) :: beta
integer(psb_epk_) :: y(:), beta integer(psb_epk_), intent(inout) :: y(:)
integer(psb_epk_), target :: work(:)
type(psb_desc_type),target :: desc_a type(psb_desc_type),target :: desc_a
integer(psb_epk_), target :: work(:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional :: data integer(psb_ipk_), optional :: data
! locals ! locals
@ -648,7 +651,8 @@ integer(psb_epk_), pointer, dimension(:) :: sndbuf, rcvbuf
type(psb_ctxt_type), intent(in) :: ctxt type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_epk_) :: y(:), beta integer(psb_epk_), intent(in) :: beta
integer(psb_epk_), intent(inout) :: y(:)
integer(psb_epk_), target :: work(:) integer(psb_epk_), target :: work(:)
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv
@ -830,7 +834,7 @@ integer(psb_epk_), pointer, dimension(:) :: sndbuf, rcvbuf
prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm) prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm)
if ((nerv>0).and.(proc_to_comm /= me)) then if ((nerv>0).and.(proc_to_comm /= me)) then
p2ptag = psb_int8_swap_tag p2ptag = psb_double_swap_tag
call mpi_irecv(rcvbuf(rcv_pt),nerv,& call mpi_irecv(rcvbuf(rcv_pt),nerv,&
& psb_mpi_epk_,prcid(i),& & psb_mpi_epk_,prcid(i),&
& p2ptag, icomm,rvhd(i),iret) & p2ptag, icomm,rvhd(i),iret)
@ -852,7 +856,7 @@ integer(psb_epk_), pointer, dimension(:) :: sndbuf, rcvbuf
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
p2ptag = psb_int8_swap_tag p2ptag = psb_double_swap_tag
if ((nesd>0).and.(proc_to_comm /= me)) then if ((nesd>0).and.(proc_to_comm /= me)) then
if (usersend) then if (usersend) then
@ -882,7 +886,7 @@ integer(psb_epk_), pointer, dimension(:) :: sndbuf, rcvbuf
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
p2ptag = psb_int8_swap_tag p2ptag = psb_double_swap_tag
if ((proc_to_comm /= me).and.(nerv>0)) then if ((proc_to_comm /= me).and.(nerv>0)) then
call mpi_wait(rvhd(i),p2pstat,iret) call mpi_wait(rvhd(i),p2pstat,iret)

50
base/comm/internals/psi_eswaptran_a.F90
Unescape Escape View File

@ -43,7 +43,7 @@
! application environment. All the variants have the same structure ! application environment. All the variants have the same structure
! In all these subroutines X may be: I Integer ! In all these subroutines X may be: I Integer
! S real(psb_spk_) ! S real(psb_spk_)
! D real(psb_dpk_) ! D integer(psb_epk_)
! C complex(psb_spk_) ! C complex(psb_spk_)
! Z complex(psb_dpk_) ! Z complex(psb_dpk_)
! Basically the operation is as follows: on each process, we identify ! Basically the operation is as follows: on each process, we identify
@ -74,10 +74,10 @@
! !
! !
! n - integer Number of columns in Y ! n - integer Number of columns in Y
! beta - integer Choose overwrite or sum. ! beta - real Choose overwrite or sum.
! y(:,:) - integer The data area ! y(:,:) - real The data area
! desc_a - type(psb_desc_type). The communication descriptor. ! desc_a - type(psb_desc_type). The communication descriptor.
! work(:) - integer Buffer space. If not sufficient, will do ! work(:) - real Buffer space. If not sufficient, will do
! our own internal allocation. ! our own internal allocation.
! info - integer. return code. ! info - integer. return code.
! data - integer which list is to be used to exchange data ! data - integer which list is to be used to exchange data
@ -101,12 +101,13 @@ contains
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info integer(psb_mpk_), intent(in) :: n
integer(psb_epk_) :: y(:,:), beta integer(psb_epk_), intent(in) :: beta
integer(psb_epk_), target :: work(:) integer(psb_epk_), intent(inout) :: y(:,:)
type(psb_desc_type),target :: desc_a type(psb_desc_type),target :: desc_a
integer(psb_epk_), target :: work(:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional :: data integer(psb_ipk_), optional :: data
! locals ! locals
@ -174,7 +175,8 @@ contains
integer(psb_mpk_), intent(in) :: n integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_epk_) :: y(:,:), beta integer(psb_epk_), intent(inout) :: y(:,:)
integer(psb_epk_), intent(in) :: beta
integer(psb_epk_), target :: work(:) integer(psb_epk_), target :: work(:)
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv
@ -360,7 +362,7 @@ contains
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm) prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm)
if ((nesd>0).and.(proc_to_comm /= me)) then if ((nesd>0).and.(proc_to_comm /= me)) then
p2ptag = psb_int8_swap_tag p2ptag = psb_double_swap_tag
call mpi_irecv(sndbuf(snd_pt),n*nesd,& call mpi_irecv(sndbuf(snd_pt),n*nesd,&
& psb_mpi_epk_,prcid(i),& & psb_mpi_epk_,prcid(i),&
& p2ptag,icomm,rvhd(i),iret) & p2ptag,icomm,rvhd(i),iret)
@ -383,7 +385,7 @@ contains
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
if ((nerv>0).and.(proc_to_comm /= me)) then if ((nerv>0).and.(proc_to_comm /= me)) then
p2ptag = psb_int8_swap_tag p2ptag = psb_double_swap_tag
if (usersend) then if (usersend) then
call mpi_rsend(rcvbuf(rcv_pt),n*nerv,& call mpi_rsend(rcvbuf(rcv_pt),n*nerv,&
& psb_mpi_epk_,prcid(i),& & psb_mpi_epk_,prcid(i),&
@ -413,7 +415,7 @@ contains
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
p2ptag = psb_int8_swap_tag p2ptag = psb_double_swap_tag
if ((proc_to_comm /= me).and.(nesd>0)) then if ((proc_to_comm /= me).and.(nesd>0)) then
call mpi_wait(rvhd(i),p2pstat,iret) call mpi_wait(rvhd(i),p2pstat,iret)
@ -525,7 +527,7 @@ contains
! application environment. All the variants have the same structure ! application environment. All the variants have the same structure
! In all these subroutines X may be: I Integer ! In all these subroutines X may be: I Integer
! S real(psb_spk_) ! S real(psb_spk_)
! D real(psb_dpk_) ! D integer(psb_epk_)
! C complex(psb_spk_) ! C complex(psb_spk_)
! Z complex(psb_dpk_) ! Z complex(psb_dpk_)
! Basically the operation is as follows: on each process, we identify ! Basically the operation is as follows: on each process, we identify
@ -556,10 +558,10 @@ contains
! !
! !
! n - integer Number of columns in Y ! n - integer Number of columns in Y
! beta - integer Choose overwrite or sum. ! beta - real Choose overwrite or sum.
! y(:) - integer The data area ! y(:) - real The data area
! desc_a - type(psb_desc_type). The communication descriptor. ! desc_a - type(psb_desc_type). The communication descriptor.
! work(:) - integer Buffer space. If not sufficient, will do ! work(:) - real Buffer space. If not sufficient, will do
! our own internal allocation. ! our own internal allocation.
! info - integer. return code. ! info - integer. return code.
! data - integer which list is to be used to exchange data ! data - integer which list is to be used to exchange data
@ -580,10 +582,11 @@ contains
#endif #endif
integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info integer(psb_epk_), intent(in) :: beta
integer(psb_epk_) :: y(:), beta integer(psb_epk_), intent(inout) :: y(:)
integer(psb_epk_), target :: work(:)
type(psb_desc_type),target :: desc_a type(psb_desc_type),target :: desc_a
integer(psb_epk_), target :: work(:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional :: data integer(psb_ipk_), optional :: data
! locals ! locals
@ -659,7 +662,8 @@ contains
type(psb_ctxt_type), intent(in) :: ctxt type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_epk_) :: y(:), beta integer(psb_epk_), intent(inout) :: y(:)
integer(psb_epk_), intent(in) :: beta
integer(psb_epk_), target :: work(:) integer(psb_epk_), target :: work(:)
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv
@ -845,7 +849,7 @@ contains
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm) prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm)
if ((nesd>0).and.(proc_to_comm /= me)) then if ((nesd>0).and.(proc_to_comm /= me)) then
p2ptag = psb_int8_swap_tag p2ptag = psb_double_swap_tag
call mpi_irecv(sndbuf(snd_pt),nesd,& call mpi_irecv(sndbuf(snd_pt),nesd,&
& psb_mpi_epk_,prcid(i),& & psb_mpi_epk_,prcid(i),&
& p2ptag,icomm,rvhd(i),iret) & p2ptag,icomm,rvhd(i),iret)
@ -868,7 +872,7 @@ contains
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
if ((nerv>0).and.(proc_to_comm /= me)) then if ((nerv>0).and.(proc_to_comm /= me)) then
p2ptag = psb_int8_swap_tag p2ptag = psb_double_swap_tag
if (usersend) then if (usersend) then
call mpi_rsend(rcvbuf(rcv_pt),nerv,& call mpi_rsend(rcvbuf(rcv_pt),nerv,&
& psb_mpi_epk_,prcid(i),& & psb_mpi_epk_,prcid(i),&
@ -896,7 +900,7 @@ contains
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
p2ptag = psb_int8_swap_tag p2ptag = psb_double_swap_tag
if ((proc_to_comm /= me).and.(nesd>0)) then if ((proc_to_comm /= me).and.(nesd>0)) then
call mpi_wait(rvhd(i),p2pstat,iret) call mpi_wait(rvhd(i),p2pstat,iret)

2
base/comm/internals/psi_i2ovrl_restr_a.f90
Unescape Escape View File

@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may ! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED

2
base/comm/internals/psi_i2ovrl_save_a.f90
Unescape Escape View File

@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may ! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED

2
base/comm/internals/psi_i2ovrl_upd_a.f90
Unescape Escape View File

@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may ! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED

54
base/comm/internals/psi_i2swapdata_a.F90
Unescape Escape View File

@ -39,7 +39,7 @@
! application environment. All the variants have the same structure ! application environment. All the variants have the same structure
! In all these subroutines X may be: I Integer ! In all these subroutines X may be: I Integer
! S real(psb_spk_) ! S real(psb_spk_)
! D real(psb_dpk_) ! D integer(psb_i2pk_)
! C complex(psb_spk_) ! C complex(psb_spk_)
! Z complex(psb_dpk_) ! Z complex(psb_dpk_)
! Basically the operation is as follows: on each process, we identify ! Basically the operation is as follows: on each process, we identify
@ -70,10 +70,10 @@
! !
! !
! n - integer Number of columns in Y ! n - integer Number of columns in Y
! beta - integer Choose overwrite or sum. ! beta - real Choose overwrite or sum.
! y(:,:) - integer The data area ! y(:,:) - real The data area
! desc_a - type(psb_desc_type). The communication descriptor. ! desc_a - type(psb_desc_type). The communication descriptor.
! work(:) - integer Buffer space. If not sufficient, will do ! work(:) - real Buffer space. If not sufficient, will do
! our own internal allocation. ! our own internal allocation.
! info - integer. return code. ! info - integer. return code.
! data - integer which list is to be used to exchange data ! data - integer which list is to be used to exchange data
@ -97,12 +97,13 @@ contains
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info integer(psb_mpk_), intent(in) :: n
integer(psb_i2pk_) :: y(:,:), beta integer(psb_i2pk_), intent(in) :: beta
integer(psb_i2pk_), target :: work(:) integer(psb_i2pk_), intent(inout) :: y(:,:)
type(psb_desc_type),target :: desc_a type(psb_desc_type),target :: desc_a
integer(psb_i2pk_), target :: work(:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional :: data integer(psb_ipk_), optional :: data
! locals ! locals
@ -165,11 +166,12 @@ integer(psb_i2pk_), target :: work(:)
#endif #endif
type(psb_ctxt_type), intent(in) :: ctxt type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(in) :: flag
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_i2pk_) :: y(:,:), beta integer(psb_i2pk_), intent(in) :: beta
integer(psb_i2pk_), target :: work(:) integer(psb_i2pk_), intent(inout) :: y(:,:)
integer(psb_i2pk_), target :: work(:)
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv
! locals ! locals
@ -348,7 +350,7 @@ integer(psb_i2pk_), pointer, dimension(:) :: sndbuf, rcvbuf
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm) prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm)
if ((nerv>0).and.(proc_to_comm /= me)) then if ((nerv>0).and.(proc_to_comm /= me)) then
p2ptag = psb_int2_swap_tag p2ptag = psb_double_swap_tag
call mpi_irecv(rcvbuf(rcv_pt),n*nerv,& call mpi_irecv(rcvbuf(rcv_pt),n*nerv,&
& psb_mpi_i2pk_,prcid(i),& & psb_mpi_i2pk_,prcid(i),&
& p2ptag, icomm,rvhd(i),iret) & p2ptag, icomm,rvhd(i),iret)
@ -370,7 +372,7 @@ integer(psb_i2pk_), pointer, dimension(:) :: sndbuf, rcvbuf
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
p2ptag = psb_int2_swap_tag p2ptag = psb_double_swap_tag
if ((nesd>0).and.(proc_to_comm /= me)) then if ((nesd>0).and.(proc_to_comm /= me)) then
if (usersend) then if (usersend) then
call mpi_rsend(sndbuf(snd_pt),n*nesd,& call mpi_rsend(sndbuf(snd_pt),n*nesd,&
@ -401,7 +403,7 @@ integer(psb_i2pk_), pointer, dimension(:) :: sndbuf, rcvbuf
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
p2ptag = psb_int2_swap_tag p2ptag = psb_double_swap_tag
if ((proc_to_comm /= me).and.(nerv>0)) then if ((proc_to_comm /= me).and.(nerv>0)) then
call mpi_wait(rvhd(i),p2pstat,iret) call mpi_wait(rvhd(i),p2pstat,iret)
@ -510,7 +512,7 @@ integer(psb_i2pk_), pointer, dimension(:) :: sndbuf, rcvbuf
! application environment. All the variants have the same structure ! application environment. All the variants have the same structure
! In all these subroutines X may be: I Integer ! In all these subroutines X may be: I Integer
! S real(psb_spk_) ! S real(psb_spk_)
! D real(psb_dpk_) ! D integer(psb_i2pk_)
! C complex(psb_spk_) ! C complex(psb_spk_)
! Z complex(psb_dpk_) ! Z complex(psb_dpk_)
! Basically the operation is as follows: on each process, we identify ! Basically the operation is as follows: on each process, we identify
@ -541,10 +543,10 @@ integer(psb_i2pk_), pointer, dimension(:) :: sndbuf, rcvbuf
! !
! !
! n - integer Number of columns in Y ! n - integer Number of columns in Y
! beta - integer Choose overwrite or sum. ! beta - real Choose overwrite or sum.
! y(:) - integer The data area ! y(:) - real The data area
! desc_a - type(psb_desc_type). The communication descriptor. ! desc_a - type(psb_desc_type). The communication descriptor.
! work(:) - integer Buffer space. If not sufficient, will do ! work(:) - real Buffer space. If not sufficient, will do
! our own internal allocation. ! our own internal allocation.
! info - integer. return code. ! info - integer. return code.
! data - integer which list is to be used to exchange data ! data - integer which list is to be used to exchange data
@ -566,10 +568,11 @@ integer(psb_i2pk_), pointer, dimension(:) :: sndbuf, rcvbuf
#endif #endif
integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info integer(psb_i2pk_), intent(in) :: beta
integer(psb_i2pk_) :: y(:), beta integer(psb_i2pk_), intent(inout) :: y(:)
integer(psb_i2pk_), target :: work(:)
type(psb_desc_type),target :: desc_a type(psb_desc_type),target :: desc_a
integer(psb_i2pk_), target :: work(:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional :: data integer(psb_ipk_), optional :: data
! locals ! locals
@ -648,7 +651,8 @@ integer(psb_i2pk_), pointer, dimension(:) :: sndbuf, rcvbuf
type(psb_ctxt_type), intent(in) :: ctxt type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_i2pk_) :: y(:), beta integer(psb_i2pk_), intent(in) :: beta
integer(psb_i2pk_), intent(inout) :: y(:)
integer(psb_i2pk_), target :: work(:) integer(psb_i2pk_), target :: work(:)
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv
@ -830,7 +834,7 @@ integer(psb_i2pk_), pointer, dimension(:) :: sndbuf, rcvbuf
prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm) prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm)
if ((nerv>0).and.(proc_to_comm /= me)) then if ((nerv>0).and.(proc_to_comm /= me)) then
p2ptag = psb_int2_swap_tag p2ptag = psb_double_swap_tag
call mpi_irecv(rcvbuf(rcv_pt),nerv,& call mpi_irecv(rcvbuf(rcv_pt),nerv,&
& psb_mpi_i2pk_,prcid(i),& & psb_mpi_i2pk_,prcid(i),&
& p2ptag, icomm,rvhd(i),iret) & p2ptag, icomm,rvhd(i),iret)
@ -852,7 +856,7 @@ integer(psb_i2pk_), pointer, dimension(:) :: sndbuf, rcvbuf
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
p2ptag = psb_int2_swap_tag p2ptag = psb_double_swap_tag
if ((nesd>0).and.(proc_to_comm /= me)) then if ((nesd>0).and.(proc_to_comm /= me)) then
if (usersend) then if (usersend) then
@ -882,7 +886,7 @@ integer(psb_i2pk_), pointer, dimension(:) :: sndbuf, rcvbuf
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
p2ptag = psb_int2_swap_tag p2ptag = psb_double_swap_tag
if ((proc_to_comm /= me).and.(nerv>0)) then if ((proc_to_comm /= me).and.(nerv>0)) then
call mpi_wait(rvhd(i),p2pstat,iret) call mpi_wait(rvhd(i),p2pstat,iret)

52
base/comm/internals/psi_i2swaptran_a.F90
Unescape Escape View File

@ -30,7 +30,7 @@
! !
! !
! !
! File: psi_i2swaptran.F90 ! File: psi_i2swaptran_a.F90
! !
! Subroutine: psi_i2swaptranm ! Subroutine: psi_i2swaptranm
! Implements the data exchange among processes. This is similar to Xswapdata, but ! Implements the data exchange among processes. This is similar to Xswapdata, but
@ -43,7 +43,7 @@
! application environment. All the variants have the same structure ! application environment. All the variants have the same structure
! In all these subroutines X may be: I Integer ! In all these subroutines X may be: I Integer
! S real(psb_spk_) ! S real(psb_spk_)
! D real(psb_dpk_) ! D integer(psb_i2pk_)
! C complex(psb_spk_) ! C complex(psb_spk_)
! Z complex(psb_dpk_) ! Z complex(psb_dpk_)
! Basically the operation is as follows: on each process, we identify ! Basically the operation is as follows: on each process, we identify
@ -74,10 +74,10 @@
! !
! !
! n - integer Number of columns in Y ! n - integer Number of columns in Y
! beta - integer Choose overwrite or sum. ! beta - real Choose overwrite or sum.
! y(:,:) - integer The data area ! y(:,:) - real The data area
! desc_a - type(psb_desc_type). The communication descriptor. ! desc_a - type(psb_desc_type). The communication descriptor.
! work(:) - integer Buffer space. If not sufficient, will do ! work(:) - real Buffer space. If not sufficient, will do
! our own internal allocation. ! our own internal allocation.
! info - integer. return code. ! info - integer. return code.
! data - integer which list is to be used to exchange data ! data - integer which list is to be used to exchange data
@ -101,12 +101,13 @@ contains
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info integer(psb_mpk_), intent(in) :: n
integer(psb_i2pk_) :: y(:,:), beta integer(psb_i2pk_), intent(in) :: beta
integer(psb_i2pk_), target :: work(:) integer(psb_i2pk_), intent(inout) :: y(:,:)
type(psb_desc_type),target :: desc_a type(psb_desc_type),target :: desc_a
integer(psb_i2pk_), target :: work(:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional :: data integer(psb_ipk_), optional :: data
! locals ! locals
@ -174,7 +175,8 @@ contains
integer(psb_mpk_), intent(in) :: n integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_i2pk_) :: y(:,:), beta integer(psb_i2pk_), intent(inout) :: y(:,:)
integer(psb_i2pk_), intent(in) :: beta
integer(psb_i2pk_), target :: work(:) integer(psb_i2pk_), target :: work(:)
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv
@ -360,7 +362,7 @@ contains
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm) prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm)
if ((nesd>0).and.(proc_to_comm /= me)) then if ((nesd>0).and.(proc_to_comm /= me)) then
p2ptag = psb_int2_swap_tag p2ptag = psb_double_swap_tag
call mpi_irecv(sndbuf(snd_pt),n*nesd,& call mpi_irecv(sndbuf(snd_pt),n*nesd,&
& psb_mpi_i2pk_,prcid(i),& & psb_mpi_i2pk_,prcid(i),&
& p2ptag,icomm,rvhd(i),iret) & p2ptag,icomm,rvhd(i),iret)
@ -383,7 +385,7 @@ contains
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
if ((nerv>0).and.(proc_to_comm /= me)) then if ((nerv>0).and.(proc_to_comm /= me)) then
p2ptag = psb_int2_swap_tag p2ptag = psb_double_swap_tag
if (usersend) then if (usersend) then
call mpi_rsend(rcvbuf(rcv_pt),n*nerv,& call mpi_rsend(rcvbuf(rcv_pt),n*nerv,&
& psb_mpi_i2pk_,prcid(i),& & psb_mpi_i2pk_,prcid(i),&
@ -413,7 +415,7 @@ contains
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
p2ptag = psb_int2_swap_tag p2ptag = psb_double_swap_tag
if ((proc_to_comm /= me).and.(nesd>0)) then if ((proc_to_comm /= me).and.(nesd>0)) then
call mpi_wait(rvhd(i),p2pstat,iret) call mpi_wait(rvhd(i),p2pstat,iret)
@ -525,7 +527,7 @@ contains
! application environment. All the variants have the same structure ! application environment. All the variants have the same structure
! In all these subroutines X may be: I Integer ! In all these subroutines X may be: I Integer
! S real(psb_spk_) ! S real(psb_spk_)
! D real(psb_dpk_) ! D integer(psb_i2pk_)
! C complex(psb_spk_) ! C complex(psb_spk_)
! Z complex(psb_dpk_) ! Z complex(psb_dpk_)
! Basically the operation is as follows: on each process, we identify ! Basically the operation is as follows: on each process, we identify
@ -556,10 +558,10 @@ contains
! !
! !
! n - integer Number of columns in Y ! n - integer Number of columns in Y
! beta - integer Choose overwrite or sum. ! beta - real Choose overwrite or sum.
! y(:) - integer The data area ! y(:) - real The data area
! desc_a - type(psb_desc_type). The communication descriptor. ! desc_a - type(psb_desc_type). The communication descriptor.
! work(:) - integer Buffer space. If not sufficient, will do ! work(:) - real Buffer space. If not sufficient, will do
! our own internal allocation. ! our own internal allocation.
! info - integer. return code. ! info - integer. return code.
! data - integer which list is to be used to exchange data ! data - integer which list is to be used to exchange data
@ -580,10 +582,11 @@ contains
#endif #endif
integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info integer(psb_i2pk_), intent(in) :: beta
integer(psb_i2pk_) :: y(:), beta integer(psb_i2pk_), intent(inout) :: y(:)
integer(psb_i2pk_), target :: work(:)
type(psb_desc_type),target :: desc_a type(psb_desc_type),target :: desc_a
integer(psb_i2pk_), target :: work(:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional :: data integer(psb_ipk_), optional :: data
! locals ! locals
@ -659,7 +662,8 @@ contains
type(psb_ctxt_type), intent(in) :: ctxt type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_i2pk_) :: y(:), beta integer(psb_i2pk_), intent(inout) :: y(:)
integer(psb_i2pk_), intent(in) :: beta
integer(psb_i2pk_), target :: work(:) integer(psb_i2pk_), target :: work(:)
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv
@ -845,7 +849,7 @@ contains
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm) prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm)
if ((nesd>0).and.(proc_to_comm /= me)) then if ((nesd>0).and.(proc_to_comm /= me)) then
p2ptag = psb_int2_swap_tag p2ptag = psb_double_swap_tag
call mpi_irecv(sndbuf(snd_pt),nesd,& call mpi_irecv(sndbuf(snd_pt),nesd,&
& psb_mpi_i2pk_,prcid(i),& & psb_mpi_i2pk_,prcid(i),&
& p2ptag,icomm,rvhd(i),iret) & p2ptag,icomm,rvhd(i),iret)
@ -868,7 +872,7 @@ contains
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
if ((nerv>0).and.(proc_to_comm /= me)) then if ((nerv>0).and.(proc_to_comm /= me)) then
p2ptag = psb_int2_swap_tag p2ptag = psb_double_swap_tag
if (usersend) then if (usersend) then
call mpi_rsend(rcvbuf(rcv_pt),nerv,& call mpi_rsend(rcvbuf(rcv_pt),nerv,&
& psb_mpi_i2pk_,prcid(i),& & psb_mpi_i2pk_,prcid(i),&
@ -896,7 +900,7 @@ contains
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
p2ptag = psb_int2_swap_tag p2ptag = psb_double_swap_tag
if ((proc_to_comm /= me).and.(nesd>0)) then if ((proc_to_comm /= me).and.(nesd>0)) then
call mpi_wait(rvhd(i),p2pstat,iret) call mpi_wait(rvhd(i),p2pstat,iret)

2
base/comm/internals/psi_iovrl_restr.f90
Unescape Escape View File

@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may ! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED

2
base/comm/internals/psi_iovrl_save.f90
Unescape Escape View File

@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may ! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED

2
base/comm/internals/psi_iovrl_upd.f90
Unescape Escape View File

@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may ! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED

2628
base/comm/internals/psi_iswapdata.F90
View File

File diff suppressed because it is too large Load Diff

1970
base/comm/internals/psi_iswaptran.F90
View File

File diff suppressed because it is too large Load Diff

2
base/comm/internals/psi_lovrl_restr.f90
Unescape Escape View File

@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may ! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED

2
base/comm/internals/psi_lovrl_save.f90
Unescape Escape View File

@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may ! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED

2
base/comm/internals/psi_lovrl_upd.f90
Unescape Escape View File

@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may ! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED

2560
base/comm/internals/psi_lswapdata.F90
View File

File diff suppressed because it is too large Load Diff

2017
base/comm/internals/psi_lswaptran.F90
View File

File diff suppressed because it is too large Load Diff

2
base/comm/internals/psi_movrl_restr_a.f90
Unescape Escape View File

@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may ! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED

2
base/comm/internals/psi_movrl_save_a.f90
Unescape Escape View File

@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may ! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED

2
base/comm/internals/psi_movrl_upd_a.f90
Unescape Escape View File

@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may ! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED

54
base/comm/internals/psi_mswapdata_a.F90
Unescape Escape View File

@ -39,7 +39,7 @@
! application environment. All the variants have the same structure ! application environment. All the variants have the same structure
! In all these subroutines X may be: I Integer ! In all these subroutines X may be: I Integer
! S real(psb_spk_) ! S real(psb_spk_)
! D real(psb_dpk_) ! D integer(psb_mpk_)
! C complex(psb_spk_) ! C complex(psb_spk_)
! Z complex(psb_dpk_) ! Z complex(psb_dpk_)
! Basically the operation is as follows: on each process, we identify ! Basically the operation is as follows: on each process, we identify
@ -70,10 +70,10 @@
! !
! !
! n - integer Number of columns in Y ! n - integer Number of columns in Y
! beta - integer Choose overwrite or sum. ! beta - real Choose overwrite or sum.
! y(:,:) - integer The data area ! y(:,:) - real The data area
! desc_a - type(psb_desc_type). The communication descriptor. ! desc_a - type(psb_desc_type). The communication descriptor.
! work(:) - integer Buffer space. If not sufficient, will do ! work(:) - real Buffer space. If not sufficient, will do
! our own internal allocation. ! our own internal allocation.
! info - integer. return code. ! info - integer. return code.
! data - integer which list is to be used to exchange data ! data - integer which list is to be used to exchange data
@ -97,12 +97,13 @@ contains
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info integer(psb_mpk_), intent(in) :: n
integer(psb_mpk_) :: y(:,:), beta integer(psb_mpk_), intent(in) :: beta
integer(psb_mpk_), target :: work(:) integer(psb_mpk_), intent(inout) :: y(:,:)
type(psb_desc_type),target :: desc_a type(psb_desc_type),target :: desc_a
integer(psb_mpk_), target :: work(:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional :: data integer(psb_ipk_), optional :: data
! locals ! locals
@ -165,11 +166,12 @@ integer(psb_mpk_), target :: work(:)
#endif #endif
type(psb_ctxt_type), intent(in) :: ctxt type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(in) :: flag
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_mpk_) :: y(:,:), beta integer(psb_mpk_), intent(in) :: beta
integer(psb_mpk_), target :: work(:) integer(psb_mpk_), intent(inout) :: y(:,:)
integer(psb_mpk_), target :: work(:)
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv
! locals ! locals
@ -348,7 +350,7 @@ integer(psb_mpk_), pointer, dimension(:) :: sndbuf, rcvbuf
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm) prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm)
if ((nerv>0).and.(proc_to_comm /= me)) then if ((nerv>0).and.(proc_to_comm /= me)) then
p2ptag = psb_int4_swap_tag p2ptag = psb_double_swap_tag
call mpi_irecv(rcvbuf(rcv_pt),n*nerv,& call mpi_irecv(rcvbuf(rcv_pt),n*nerv,&
& psb_mpi_mpk_,prcid(i),& & psb_mpi_mpk_,prcid(i),&
& p2ptag, icomm,rvhd(i),iret) & p2ptag, icomm,rvhd(i),iret)
@ -370,7 +372,7 @@ integer(psb_mpk_), pointer, dimension(:) :: sndbuf, rcvbuf
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
p2ptag = psb_int4_swap_tag p2ptag = psb_double_swap_tag
if ((nesd>0).and.(proc_to_comm /= me)) then if ((nesd>0).and.(proc_to_comm /= me)) then
if (usersend) then if (usersend) then
call mpi_rsend(sndbuf(snd_pt),n*nesd,& call mpi_rsend(sndbuf(snd_pt),n*nesd,&
@ -401,7 +403,7 @@ integer(psb_mpk_), pointer, dimension(:) :: sndbuf, rcvbuf
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
p2ptag = psb_int4_swap_tag p2ptag = psb_double_swap_tag
if ((proc_to_comm /= me).and.(nerv>0)) then if ((proc_to_comm /= me).and.(nerv>0)) then
call mpi_wait(rvhd(i),p2pstat,iret) call mpi_wait(rvhd(i),p2pstat,iret)
@ -510,7 +512,7 @@ integer(psb_mpk_), pointer, dimension(:) :: sndbuf, rcvbuf
! application environment. All the variants have the same structure ! application environment. All the variants have the same structure
! In all these subroutines X may be: I Integer ! In all these subroutines X may be: I Integer
! S real(psb_spk_) ! S real(psb_spk_)
! D real(psb_dpk_) ! D integer(psb_mpk_)
! C complex(psb_spk_) ! C complex(psb_spk_)
! Z complex(psb_dpk_) ! Z complex(psb_dpk_)
! Basically the operation is as follows: on each process, we identify ! Basically the operation is as follows: on each process, we identify
@ -541,10 +543,10 @@ integer(psb_mpk_), pointer, dimension(:) :: sndbuf, rcvbuf
! !
! !
! n - integer Number of columns in Y ! n - integer Number of columns in Y
! beta - integer Choose overwrite or sum. ! beta - real Choose overwrite or sum.
! y(:) - integer The data area ! y(:) - real The data area
! desc_a - type(psb_desc_type). The communication descriptor. ! desc_a - type(psb_desc_type). The communication descriptor.
! work(:) - integer Buffer space. If not sufficient, will do ! work(:) - real Buffer space. If not sufficient, will do
! our own internal allocation. ! our own internal allocation.
! info - integer. return code. ! info - integer. return code.
! data - integer which list is to be used to exchange data ! data - integer which list is to be used to exchange data
@ -566,10 +568,11 @@ integer(psb_mpk_), pointer, dimension(:) :: sndbuf, rcvbuf
#endif #endif
integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info integer(psb_mpk_), intent(in) :: beta
integer(psb_mpk_) :: y(:), beta integer(psb_mpk_), intent(inout) :: y(:)
integer(psb_mpk_), target :: work(:)
type(psb_desc_type),target :: desc_a type(psb_desc_type),target :: desc_a
integer(psb_mpk_), target :: work(:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional :: data integer(psb_ipk_), optional :: data
! locals ! locals
@ -648,7 +651,8 @@ integer(psb_mpk_), pointer, dimension(:) :: sndbuf, rcvbuf
type(psb_ctxt_type), intent(in) :: ctxt type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_mpk_) :: y(:), beta integer(psb_mpk_), intent(in) :: beta
integer(psb_mpk_), intent(inout) :: y(:)
integer(psb_mpk_), target :: work(:) integer(psb_mpk_), target :: work(:)
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv
@ -830,7 +834,7 @@ integer(psb_mpk_), pointer, dimension(:) :: sndbuf, rcvbuf
prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm) prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm)
if ((nerv>0).and.(proc_to_comm /= me)) then if ((nerv>0).and.(proc_to_comm /= me)) then
p2ptag = psb_int4_swap_tag p2ptag = psb_double_swap_tag
call mpi_irecv(rcvbuf(rcv_pt),nerv,& call mpi_irecv(rcvbuf(rcv_pt),nerv,&
& psb_mpi_mpk_,prcid(i),& & psb_mpi_mpk_,prcid(i),&
& p2ptag, icomm,rvhd(i),iret) & p2ptag, icomm,rvhd(i),iret)
@ -852,7 +856,7 @@ integer(psb_mpk_), pointer, dimension(:) :: sndbuf, rcvbuf
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
p2ptag = psb_int4_swap_tag p2ptag = psb_double_swap_tag
if ((nesd>0).and.(proc_to_comm /= me)) then if ((nesd>0).and.(proc_to_comm /= me)) then
if (usersend) then if (usersend) then
@ -882,7 +886,7 @@ integer(psb_mpk_), pointer, dimension(:) :: sndbuf, rcvbuf
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
p2ptag = psb_int4_swap_tag p2ptag = psb_double_swap_tag
if ((proc_to_comm /= me).and.(nerv>0)) then if ((proc_to_comm /= me).and.(nerv>0)) then
call mpi_wait(rvhd(i),p2pstat,iret) call mpi_wait(rvhd(i),p2pstat,iret)

52
base/comm/internals/psi_mswaptran_a.F90
Unescape Escape View File

@ -30,7 +30,7 @@
! !
! !
! !
! File: psi_mswaptran.F90 ! File: psi_mswaptran_a.F90
! !
! Subroutine: psi_mswaptranm ! Subroutine: psi_mswaptranm
! Implements the data exchange among processes. This is similar to Xswapdata, but ! Implements the data exchange among processes. This is similar to Xswapdata, but
@ -43,7 +43,7 @@
! application environment. All the variants have the same structure ! application environment. All the variants have the same structure
! In all these subroutines X may be: I Integer ! In all these subroutines X may be: I Integer
! S real(psb_spk_) ! S real(psb_spk_)
! D real(psb_dpk_) ! D integer(psb_mpk_)
! C complex(psb_spk_) ! C complex(psb_spk_)
! Z complex(psb_dpk_) ! Z complex(psb_dpk_)
! Basically the operation is as follows: on each process, we identify ! Basically the operation is as follows: on each process, we identify
@ -74,10 +74,10 @@
! !
! !
! n - integer Number of columns in Y ! n - integer Number of columns in Y
! beta - integer Choose overwrite or sum. ! beta - real Choose overwrite or sum.
! y(:,:) - integer The data area ! y(:,:) - real The data area
! desc_a - type(psb_desc_type). The communication descriptor. ! desc_a - type(psb_desc_type). The communication descriptor.
! work(:) - integer Buffer space. If not sufficient, will do ! work(:) - real Buffer space. If not sufficient, will do
! our own internal allocation. ! our own internal allocation.
! info - integer. return code. ! info - integer. return code.
! data - integer which list is to be used to exchange data ! data - integer which list is to be used to exchange data
@ -101,12 +101,13 @@ contains
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info integer(psb_mpk_), intent(in) :: n
integer(psb_mpk_) :: y(:,:), beta integer(psb_mpk_), intent(in) :: beta
integer(psb_mpk_), target :: work(:) integer(psb_mpk_), intent(inout) :: y(:,:)
type(psb_desc_type),target :: desc_a type(psb_desc_type),target :: desc_a
integer(psb_mpk_), target :: work(:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional :: data integer(psb_ipk_), optional :: data
! locals ! locals
@ -174,7 +175,8 @@ contains
integer(psb_mpk_), intent(in) :: n integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_mpk_) :: y(:,:), beta integer(psb_mpk_), intent(inout) :: y(:,:)
integer(psb_mpk_), intent(in) :: beta
integer(psb_mpk_), target :: work(:) integer(psb_mpk_), target :: work(:)
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv
@ -360,7 +362,7 @@ contains
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm) prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm)
if ((nesd>0).and.(proc_to_comm /= me)) then if ((nesd>0).and.(proc_to_comm /= me)) then
p2ptag = psb_int4_swap_tag p2ptag = psb_double_swap_tag
call mpi_irecv(sndbuf(snd_pt),n*nesd,& call mpi_irecv(sndbuf(snd_pt),n*nesd,&
& psb_mpi_mpk_,prcid(i),& & psb_mpi_mpk_,prcid(i),&
& p2ptag,icomm,rvhd(i),iret) & p2ptag,icomm,rvhd(i),iret)
@ -383,7 +385,7 @@ contains
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
if ((nerv>0).and.(proc_to_comm /= me)) then if ((nerv>0).and.(proc_to_comm /= me)) then
p2ptag = psb_int4_swap_tag p2ptag = psb_double_swap_tag
if (usersend) then if (usersend) then
call mpi_rsend(rcvbuf(rcv_pt),n*nerv,& call mpi_rsend(rcvbuf(rcv_pt),n*nerv,&
& psb_mpi_mpk_,prcid(i),& & psb_mpi_mpk_,prcid(i),&
@ -413,7 +415,7 @@ contains
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
p2ptag = psb_int4_swap_tag p2ptag = psb_double_swap_tag
if ((proc_to_comm /= me).and.(nesd>0)) then if ((proc_to_comm /= me).and.(nesd>0)) then
call mpi_wait(rvhd(i),p2pstat,iret) call mpi_wait(rvhd(i),p2pstat,iret)
@ -525,7 +527,7 @@ contains
! application environment. All the variants have the same structure ! application environment. All the variants have the same structure
! In all these subroutines X may be: I Integer ! In all these subroutines X may be: I Integer
! S real(psb_spk_) ! S real(psb_spk_)
! D real(psb_dpk_) ! D integer(psb_mpk_)
! C complex(psb_spk_) ! C complex(psb_spk_)
! Z complex(psb_dpk_) ! Z complex(psb_dpk_)
! Basically the operation is as follows: on each process, we identify ! Basically the operation is as follows: on each process, we identify
@ -556,10 +558,10 @@ contains
! !
! !
! n - integer Number of columns in Y ! n - integer Number of columns in Y
! beta - integer Choose overwrite or sum. ! beta - real Choose overwrite or sum.
! y(:) - integer The data area ! y(:) - real The data area
! desc_a - type(psb_desc_type). The communication descriptor. ! desc_a - type(psb_desc_type). The communication descriptor.
! work(:) - integer Buffer space. If not sufficient, will do ! work(:) - real Buffer space. If not sufficient, will do
! our own internal allocation. ! our own internal allocation.
! info - integer. return code. ! info - integer. return code.
! data - integer which list is to be used to exchange data ! data - integer which list is to be used to exchange data
@ -580,10 +582,11 @@ contains
#endif #endif
integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info integer(psb_mpk_), intent(in) :: beta
integer(psb_mpk_) :: y(:), beta integer(psb_mpk_), intent(inout) :: y(:)
integer(psb_mpk_), target :: work(:)
type(psb_desc_type),target :: desc_a type(psb_desc_type),target :: desc_a
integer(psb_mpk_), target :: work(:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional :: data integer(psb_ipk_), optional :: data
! locals ! locals
@ -659,7 +662,8 @@ contains
type(psb_ctxt_type), intent(in) :: ctxt type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_mpk_) :: y(:), beta integer(psb_mpk_), intent(inout) :: y(:)
integer(psb_mpk_), intent(in) :: beta
integer(psb_mpk_), target :: work(:) integer(psb_mpk_), target :: work(:)
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv
@ -845,7 +849,7 @@ contains
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm) prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm)
if ((nesd>0).and.(proc_to_comm /= me)) then if ((nesd>0).and.(proc_to_comm /= me)) then
p2ptag = psb_int4_swap_tag p2ptag = psb_double_swap_tag
call mpi_irecv(sndbuf(snd_pt),nesd,& call mpi_irecv(sndbuf(snd_pt),nesd,&
& psb_mpi_mpk_,prcid(i),& & psb_mpi_mpk_,prcid(i),&
& p2ptag,icomm,rvhd(i),iret) & p2ptag,icomm,rvhd(i),iret)
@ -868,7 +872,7 @@ contains
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
if ((nerv>0).and.(proc_to_comm /= me)) then if ((nerv>0).and.(proc_to_comm /= me)) then
p2ptag = psb_int4_swap_tag p2ptag = psb_double_swap_tag
if (usersend) then if (usersend) then
call mpi_rsend(rcvbuf(rcv_pt),nerv,& call mpi_rsend(rcvbuf(rcv_pt),nerv,&
& psb_mpi_mpk_,prcid(i),& & psb_mpi_mpk_,prcid(i),&
@ -896,7 +900,7 @@ contains
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
p2ptag = psb_int4_swap_tag p2ptag = psb_double_swap_tag
if ((proc_to_comm /= me).and.(nesd>0)) then if ((proc_to_comm /= me).and.(nesd>0)) then
call mpi_wait(rvhd(i),p2pstat,iret) call mpi_wait(rvhd(i),p2pstat,iret)

2
base/comm/internals/psi_sovrl_restr.f90
Unescape Escape View File

@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may ! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED

2
base/comm/internals/psi_sovrl_restr_a.f90
Unescape Escape View File

@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may ! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED

2
base/comm/internals/psi_sovrl_save.f90
Unescape Escape View File

@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may ! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED

2
base/comm/internals/psi_sovrl_save_a.f90
Unescape Escape View File

@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may ! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED

2
base/comm/internals/psi_sovrl_upd.f90
Unescape Escape View File

@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may ! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED

2
base/comm/internals/psi_sovrl_upd_a.f90
Unescape Escape View File

@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may ! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED

2698
base/comm/internals/psi_sswapdata.F90
View File

File diff suppressed because it is too large Load Diff

42
base/comm/internals/psi_sswapdata_a.F90
Unescape Escape View File

@ -39,7 +39,7 @@
! application environment. All the variants have the same structure ! application environment. All the variants have the same structure
! In all these subroutines X may be: I Integer ! In all these subroutines X may be: I Integer
! S real(psb_spk_) ! S real(psb_spk_)
! D real(psb_dpk_) ! D real(psb_spk_)
! C complex(psb_spk_) ! C complex(psb_spk_)
! Z complex(psb_dpk_) ! Z complex(psb_dpk_)
! Basically the operation is as follows: on each process, we identify ! Basically the operation is as follows: on each process, we identify
@ -97,12 +97,13 @@ contains
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info integer(psb_mpk_), intent(in) :: n
real(psb_spk_) :: y(:,:), beta real(psb_spk_), intent(in) :: beta
real(psb_spk_), target :: work(:) real(psb_spk_), intent(inout) :: y(:,:)
type(psb_desc_type),target :: desc_a type(psb_desc_type),target :: desc_a
real(psb_spk_), target :: work(:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional :: data integer(psb_ipk_), optional :: data
! locals ! locals
@ -165,11 +166,12 @@ real(psb_spk_), target :: work(:)
#endif #endif
type(psb_ctxt_type), intent(in) :: ctxt type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(in) :: flag
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
real(psb_spk_) :: y(:,:), beta real(psb_spk_), intent(in) :: beta
real(psb_spk_), target :: work(:) real(psb_spk_), intent(inout) :: y(:,:)
real(psb_spk_), target :: work(:)
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv
! locals ! locals
@ -348,7 +350,7 @@ real(psb_spk_), pointer, dimension(:) :: sndbuf, rcvbuf
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm) prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm)
if ((nerv>0).and.(proc_to_comm /= me)) then if ((nerv>0).and.(proc_to_comm /= me)) then
p2ptag = psb_real_swap_tag p2ptag = psb_double_swap_tag
call mpi_irecv(rcvbuf(rcv_pt),n*nerv,& call mpi_irecv(rcvbuf(rcv_pt),n*nerv,&
& psb_mpi_r_spk_,prcid(i),& & psb_mpi_r_spk_,prcid(i),&
& p2ptag, icomm,rvhd(i),iret) & p2ptag, icomm,rvhd(i),iret)
@ -370,7 +372,7 @@ real(psb_spk_), pointer, dimension(:) :: sndbuf, rcvbuf
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
p2ptag = psb_real_swap_tag p2ptag = psb_double_swap_tag
if ((nesd>0).and.(proc_to_comm /= me)) then if ((nesd>0).and.(proc_to_comm /= me)) then
if (usersend) then if (usersend) then
call mpi_rsend(sndbuf(snd_pt),n*nesd,& call mpi_rsend(sndbuf(snd_pt),n*nesd,&
@ -401,7 +403,7 @@ real(psb_spk_), pointer, dimension(:) :: sndbuf, rcvbuf
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
p2ptag = psb_real_swap_tag p2ptag = psb_double_swap_tag
if ((proc_to_comm /= me).and.(nerv>0)) then if ((proc_to_comm /= me).and.(nerv>0)) then
call mpi_wait(rvhd(i),p2pstat,iret) call mpi_wait(rvhd(i),p2pstat,iret)
@ -510,7 +512,7 @@ real(psb_spk_), pointer, dimension(:) :: sndbuf, rcvbuf
! application environment. All the variants have the same structure ! application environment. All the variants have the same structure
! In all these subroutines X may be: I Integer ! In all these subroutines X may be: I Integer
! S real(psb_spk_) ! S real(psb_spk_)
! D real(psb_dpk_) ! D real(psb_spk_)
! C complex(psb_spk_) ! C complex(psb_spk_)
! Z complex(psb_dpk_) ! Z complex(psb_dpk_)
! Basically the operation is as follows: on each process, we identify ! Basically the operation is as follows: on each process, we identify
@ -566,10 +568,11 @@ real(psb_spk_), pointer, dimension(:) :: sndbuf, rcvbuf
#endif #endif
integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info real(psb_spk_), intent(in) :: beta
real(psb_spk_) :: y(:), beta real(psb_spk_), intent(inout) :: y(:)
real(psb_spk_), target :: work(:)
type(psb_desc_type),target :: desc_a type(psb_desc_type),target :: desc_a
real(psb_spk_), target :: work(:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional :: data integer(psb_ipk_), optional :: data
! locals ! locals
@ -648,7 +651,8 @@ real(psb_spk_), pointer, dimension(:) :: sndbuf, rcvbuf
type(psb_ctxt_type), intent(in) :: ctxt type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
real(psb_spk_) :: y(:), beta real(psb_spk_), intent(in) :: beta
real(psb_spk_), intent(inout) :: y(:)
real(psb_spk_), target :: work(:) real(psb_spk_), target :: work(:)
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv
@ -830,7 +834,7 @@ real(psb_spk_), pointer, dimension(:) :: sndbuf, rcvbuf
prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm) prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm)
if ((nerv>0).and.(proc_to_comm /= me)) then if ((nerv>0).and.(proc_to_comm /= me)) then
p2ptag = psb_real_swap_tag p2ptag = psb_double_swap_tag
call mpi_irecv(rcvbuf(rcv_pt),nerv,& call mpi_irecv(rcvbuf(rcv_pt),nerv,&
& psb_mpi_r_spk_,prcid(i),& & psb_mpi_r_spk_,prcid(i),&
& p2ptag, icomm,rvhd(i),iret) & p2ptag, icomm,rvhd(i),iret)
@ -852,7 +856,7 @@ real(psb_spk_), pointer, dimension(:) :: sndbuf, rcvbuf
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
p2ptag = psb_real_swap_tag p2ptag = psb_double_swap_tag
if ((nesd>0).and.(proc_to_comm /= me)) then if ((nesd>0).and.(proc_to_comm /= me)) then
if (usersend) then if (usersend) then
@ -882,7 +886,7 @@ real(psb_spk_), pointer, dimension(:) :: sndbuf, rcvbuf
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
p2ptag = psb_real_swap_tag p2ptag = psb_double_swap_tag
if ((proc_to_comm /= me).and.(nerv>0)) then if ((proc_to_comm /= me).and.(nerv>0)) then
call mpi_wait(rvhd(i),p2pstat,iret) call mpi_wait(rvhd(i),p2pstat,iret)

1928
base/comm/internals/psi_sswaptran.F90
View File

File diff suppressed because it is too large Load Diff

38
base/comm/internals/psi_sswaptran_a.F90
Unescape Escape View File

@ -43,7 +43,7 @@
! application environment. All the variants have the same structure ! application environment. All the variants have the same structure
! In all these subroutines X may be: I Integer ! In all these subroutines X may be: I Integer
! S real(psb_spk_) ! S real(psb_spk_)
! D real(psb_dpk_) ! D real(psb_spk_)
! C complex(psb_spk_) ! C complex(psb_spk_)
! Z complex(psb_dpk_) ! Z complex(psb_dpk_)
! Basically the operation is as follows: on each process, we identify ! Basically the operation is as follows: on each process, we identify
@ -101,12 +101,13 @@ contains
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info integer(psb_mpk_), intent(in) :: n
real(psb_spk_) :: y(:,:), beta real(psb_spk_), intent(in) :: beta
real(psb_spk_), target :: work(:) real(psb_spk_), intent(inout) :: y(:,:)
type(psb_desc_type),target :: desc_a type(psb_desc_type),target :: desc_a
real(psb_spk_), target :: work(:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional :: data integer(psb_ipk_), optional :: data
! locals ! locals
@ -174,7 +175,8 @@ contains
integer(psb_mpk_), intent(in) :: n integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
real(psb_spk_) :: y(:,:), beta real(psb_spk_), intent(inout) :: y(:,:)
real(psb_spk_), intent(in) :: beta
real(psb_spk_), target :: work(:) real(psb_spk_), target :: work(:)
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv
@ -360,7 +362,7 @@ contains
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm) prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm)
if ((nesd>0).and.(proc_to_comm /= me)) then if ((nesd>0).and.(proc_to_comm /= me)) then
p2ptag = psb_real_swap_tag p2ptag = psb_double_swap_tag
call mpi_irecv(sndbuf(snd_pt),n*nesd,& call mpi_irecv(sndbuf(snd_pt),n*nesd,&
& psb_mpi_r_spk_,prcid(i),& & psb_mpi_r_spk_,prcid(i),&
& p2ptag,icomm,rvhd(i),iret) & p2ptag,icomm,rvhd(i),iret)
@ -383,7 +385,7 @@ contains
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
if ((nerv>0).and.(proc_to_comm /= me)) then if ((nerv>0).and.(proc_to_comm /= me)) then
p2ptag = psb_real_swap_tag p2ptag = psb_double_swap_tag
if (usersend) then if (usersend) then
call mpi_rsend(rcvbuf(rcv_pt),n*nerv,& call mpi_rsend(rcvbuf(rcv_pt),n*nerv,&
& psb_mpi_r_spk_,prcid(i),& & psb_mpi_r_spk_,prcid(i),&
@ -413,7 +415,7 @@ contains
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
p2ptag = psb_real_swap_tag p2ptag = psb_double_swap_tag
if ((proc_to_comm /= me).and.(nesd>0)) then if ((proc_to_comm /= me).and.(nesd>0)) then
call mpi_wait(rvhd(i),p2pstat,iret) call mpi_wait(rvhd(i),p2pstat,iret)
@ -525,7 +527,7 @@ contains
! application environment. All the variants have the same structure ! application environment. All the variants have the same structure
! In all these subroutines X may be: I Integer ! In all these subroutines X may be: I Integer
! S real(psb_spk_) ! S real(psb_spk_)
! D real(psb_dpk_) ! D real(psb_spk_)
! C complex(psb_spk_) ! C complex(psb_spk_)
! Z complex(psb_dpk_) ! Z complex(psb_dpk_)
! Basically the operation is as follows: on each process, we identify ! Basically the operation is as follows: on each process, we identify
@ -580,10 +582,11 @@ contains
#endif #endif
integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info real(psb_spk_), intent(in) :: beta
real(psb_spk_) :: y(:), beta real(psb_spk_), intent(inout) :: y(:)
real(psb_spk_), target :: work(:)
type(psb_desc_type),target :: desc_a type(psb_desc_type),target :: desc_a
real(psb_spk_), target :: work(:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional :: data integer(psb_ipk_), optional :: data
! locals ! locals
@ -659,7 +662,8 @@ contains
type(psb_ctxt_type), intent(in) :: ctxt type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
real(psb_spk_) :: y(:), beta real(psb_spk_), intent(inout) :: y(:)
real(psb_spk_), intent(in) :: beta
real(psb_spk_), target :: work(:) real(psb_spk_), target :: work(:)
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv
@ -845,7 +849,7 @@ contains
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm) prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm)
if ((nesd>0).and.(proc_to_comm /= me)) then if ((nesd>0).and.(proc_to_comm /= me)) then
p2ptag = psb_real_swap_tag p2ptag = psb_double_swap_tag
call mpi_irecv(sndbuf(snd_pt),nesd,& call mpi_irecv(sndbuf(snd_pt),nesd,&
& psb_mpi_r_spk_,prcid(i),& & psb_mpi_r_spk_,prcid(i),&
& p2ptag,icomm,rvhd(i),iret) & p2ptag,icomm,rvhd(i),iret)
@ -868,7 +872,7 @@ contains
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
if ((nerv>0).and.(proc_to_comm /= me)) then if ((nerv>0).and.(proc_to_comm /= me)) then
p2ptag = psb_real_swap_tag p2ptag = psb_double_swap_tag
if (usersend) then if (usersend) then
call mpi_rsend(rcvbuf(rcv_pt),nerv,& call mpi_rsend(rcvbuf(rcv_pt),nerv,&
& psb_mpi_r_spk_,prcid(i),& & psb_mpi_r_spk_,prcid(i),&
@ -896,7 +900,7 @@ contains
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
p2ptag = psb_real_swap_tag p2ptag = psb_double_swap_tag
if ((proc_to_comm /= me).and.(nesd>0)) then if ((proc_to_comm /= me).and.(nesd>0)) then
call mpi_wait(rvhd(i),p2pstat,iret) call mpi_wait(rvhd(i),p2pstat,iret)

2
base/comm/internals/psi_zovrl_restr.f90
Unescape Escape View File

@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may ! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED

2
base/comm/internals/psi_zovrl_restr_a.f90
Unescape Escape View File

@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may ! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED

2
base/comm/internals/psi_zovrl_save.f90
Unescape Escape View File

@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may ! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED

2
base/comm/internals/psi_zovrl_save_a.f90
Unescape Escape View File

@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may ! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED

2
base/comm/internals/psi_zovrl_upd.f90
Unescape Escape View File

@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may ! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED

2
base/comm/internals/psi_zovrl_upd_a.f90
Unescape Escape View File

@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may ! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED

2865
base/comm/internals/psi_zswapdata.F90
View File

File diff suppressed because it is too large Load Diff

74
base/comm/internals/psi_zswapdata_a.F90
Unescape Escape View File

@ -39,7 +39,7 @@
! application environment. All the variants have the same structure ! application environment. All the variants have the same structure
! In all these subroutines X may be: I Integer ! In all these subroutines X may be: I Integer
! S real(psb_spk_) ! S real(psb_spk_)
! D real(psb_dpk_) ! D complex(psb_dpk_)
! C complex(psb_spk_) ! C complex(psb_spk_)
! Z complex(psb_dpk_) ! Z complex(psb_dpk_)
! Basically the operation is as follows: on each process, we identify ! Basically the operation is as follows: on each process, we identify
@ -70,10 +70,10 @@
! !
! !
! n - integer Number of columns in Y ! n - integer Number of columns in Y
! beta - complex Choose overwrite or sum. ! beta - real Choose overwrite or sum.
! y(:,:) - complex The data area ! y(:,:) - real The data area
! desc_a - type(psb_desc_type). The communication descriptor. ! desc_a - type(psb_desc_type). The communication descriptor.
! work(:) - complex Buffer space. If not sufficient, will do ! work(:) - real Buffer space. If not sufficient, will do
! our own internal allocation. ! our own internal allocation.
! info - integer. return code. ! info - integer. return code.
! data - integer which list is to be used to exchange data ! data - integer which list is to be used to exchange data
@ -97,12 +97,13 @@ contains
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info integer(psb_mpk_), intent(in) :: n
complex(psb_dpk_) :: y(:,:), beta complex(psb_dpk_), intent(in) :: beta
complex(psb_dpk_), target :: work(:) complex(psb_dpk_), intent(inout) :: y(:,:)
type(psb_desc_type),target :: desc_a type(psb_desc_type),target :: desc_a
complex(psb_dpk_), target :: work(:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional :: data integer(psb_ipk_), optional :: data
! locals ! locals
@ -165,11 +166,12 @@ complex(psb_dpk_), target :: work(:)
#endif #endif
type(psb_ctxt_type), intent(in) :: ctxt type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(in) :: flag
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
complex(psb_dpk_) :: y(:,:), beta complex(psb_dpk_), intent(in) :: beta
complex(psb_dpk_), target :: work(:) complex(psb_dpk_), intent(inout) :: y(:,:)
complex(psb_dpk_), target :: work(:)
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv
! locals ! locals
@ -293,8 +295,8 @@ complex(psb_dpk_), pointer, dimension(:) :: sndbuf, rcvbuf
! swap elements using mpi_alltoallv ! swap elements using mpi_alltoallv
call mpi_alltoallv(sndbuf,sdsz,bsdidx,& call mpi_alltoallv(sndbuf,sdsz,bsdidx,&
& psb_mpi_c_dpk_,rcvbuf,rvsz,& & psb_mpi_r_dpk_,rcvbuf,rvsz,&
& brvidx,psb_mpi_c_dpk_,icomm,iret) & brvidx,psb_mpi_r_dpk_,icomm,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,m_err=(/iret/)) call psb_errpush(info,name,m_err=(/iret/))
@ -348,9 +350,9 @@ complex(psb_dpk_), pointer, dimension(:) :: sndbuf, rcvbuf
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm) prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm)
if ((nerv>0).and.(proc_to_comm /= me)) then if ((nerv>0).and.(proc_to_comm /= me)) then
p2ptag = psb_dcomplex_swap_tag p2ptag = psb_double_swap_tag
call mpi_irecv(rcvbuf(rcv_pt),n*nerv,& call mpi_irecv(rcvbuf(rcv_pt),n*nerv,&
& psb_mpi_c_dpk_,prcid(i),& & psb_mpi_r_dpk_,prcid(i),&
& p2ptag, icomm,rvhd(i),iret) & p2ptag, icomm,rvhd(i),iret)
end if end if
rcv_pt = rcv_pt + n*nerv rcv_pt = rcv_pt + n*nerv
@ -370,15 +372,15 @@ complex(psb_dpk_), pointer, dimension(:) :: sndbuf, rcvbuf
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
p2ptag = psb_dcomplex_swap_tag p2ptag = psb_double_swap_tag
if ((nesd>0).and.(proc_to_comm /= me)) then if ((nesd>0).and.(proc_to_comm /= me)) then
if (usersend) then if (usersend) then
call mpi_rsend(sndbuf(snd_pt),n*nesd,& call mpi_rsend(sndbuf(snd_pt),n*nesd,&
& psb_mpi_c_dpk_,prcid(i),& & psb_mpi_r_dpk_,prcid(i),&
& p2ptag,icomm,iret) & p2ptag,icomm,iret)
else else
call mpi_send(sndbuf(snd_pt),n*nesd,& call mpi_send(sndbuf(snd_pt),n*nesd,&
& psb_mpi_c_dpk_,prcid(i),& & psb_mpi_r_dpk_,prcid(i),&
& p2ptag,icomm,iret) & p2ptag,icomm,iret)
end if end if
@ -401,7 +403,7 @@ complex(psb_dpk_), pointer, dimension(:) :: sndbuf, rcvbuf
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
p2ptag = psb_dcomplex_swap_tag p2ptag = psb_double_swap_tag
if ((proc_to_comm /= me).and.(nerv>0)) then if ((proc_to_comm /= me).and.(nerv>0)) then
call mpi_wait(rvhd(i),p2pstat,iret) call mpi_wait(rvhd(i),p2pstat,iret)
@ -510,7 +512,7 @@ complex(psb_dpk_), pointer, dimension(:) :: sndbuf, rcvbuf
! application environment. All the variants have the same structure ! application environment. All the variants have the same structure
! In all these subroutines X may be: I Integer ! In all these subroutines X may be: I Integer
! S real(psb_spk_) ! S real(psb_spk_)
! D real(psb_dpk_) ! D complex(psb_dpk_)
! C complex(psb_spk_) ! C complex(psb_spk_)
! Z complex(psb_dpk_) ! Z complex(psb_dpk_)
! Basically the operation is as follows: on each process, we identify ! Basically the operation is as follows: on each process, we identify
@ -541,10 +543,10 @@ complex(psb_dpk_), pointer, dimension(:) :: sndbuf, rcvbuf
! !
! !
! n - integer Number of columns in Y ! n - integer Number of columns in Y
! beta - complex Choose overwrite or sum. ! beta - real Choose overwrite or sum.
! y(:) - complex The data area ! y(:) - real The data area
! desc_a - type(psb_desc_type). The communication descriptor. ! desc_a - type(psb_desc_type). The communication descriptor.
! work(:) - complex Buffer space. If not sufficient, will do ! work(:) - real Buffer space. If not sufficient, will do
! our own internal allocation. ! our own internal allocation.
! info - integer. return code. ! info - integer. return code.
! data - integer which list is to be used to exchange data ! data - integer which list is to be used to exchange data
@ -566,10 +568,11 @@ complex(psb_dpk_), pointer, dimension(:) :: sndbuf, rcvbuf
#endif #endif
integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info complex(psb_dpk_), intent(in) :: beta
complex(psb_dpk_) :: y(:), beta complex(psb_dpk_), intent(inout) :: y(:)
complex(psb_dpk_), target :: work(:)
type(psb_desc_type),target :: desc_a type(psb_desc_type),target :: desc_a
complex(psb_dpk_), target :: work(:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional :: data integer(psb_ipk_), optional :: data
! locals ! locals
@ -648,7 +651,8 @@ complex(psb_dpk_), pointer, dimension(:) :: sndbuf, rcvbuf
type(psb_ctxt_type), intent(in) :: ctxt type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
complex(psb_dpk_) :: y(:), beta complex(psb_dpk_), intent(in) :: beta
complex(psb_dpk_), intent(inout) :: y(:)
complex(psb_dpk_), target :: work(:) complex(psb_dpk_), target :: work(:)
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv
@ -775,8 +779,8 @@ complex(psb_dpk_), pointer, dimension(:) :: sndbuf, rcvbuf
! swap elements using mpi_alltoallv ! swap elements using mpi_alltoallv
call mpi_alltoallv(sndbuf,sdsz,bsdidx,& call mpi_alltoallv(sndbuf,sdsz,bsdidx,&
& psb_mpi_c_dpk_,rcvbuf,rvsz,& & psb_mpi_r_dpk_,rcvbuf,rvsz,&
& brvidx,psb_mpi_c_dpk_,icomm,iret) & brvidx,psb_mpi_r_dpk_,icomm,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,m_err=(/iret/)) call psb_errpush(info,name,m_err=(/iret/))
@ -830,9 +834,9 @@ complex(psb_dpk_), pointer, dimension(:) :: sndbuf, rcvbuf
prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm) prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm)
if ((nerv>0).and.(proc_to_comm /= me)) then if ((nerv>0).and.(proc_to_comm /= me)) then
p2ptag = psb_dcomplex_swap_tag p2ptag = psb_double_swap_tag
call mpi_irecv(rcvbuf(rcv_pt),nerv,& call mpi_irecv(rcvbuf(rcv_pt),nerv,&
& psb_mpi_c_dpk_,prcid(i),& & psb_mpi_r_dpk_,prcid(i),&
& p2ptag, icomm,rvhd(i),iret) & p2ptag, icomm,rvhd(i),iret)
end if end if
rcv_pt = rcv_pt + nerv rcv_pt = rcv_pt + nerv
@ -852,16 +856,16 @@ complex(psb_dpk_), pointer, dimension(:) :: sndbuf, rcvbuf
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
p2ptag = psb_dcomplex_swap_tag p2ptag = psb_double_swap_tag
if ((nesd>0).and.(proc_to_comm /= me)) then if ((nesd>0).and.(proc_to_comm /= me)) then
if (usersend) then if (usersend) then
call mpi_rsend(sndbuf(snd_pt),nesd,& call mpi_rsend(sndbuf(snd_pt),nesd,&
& psb_mpi_c_dpk_,prcid(i),& & psb_mpi_r_dpk_,prcid(i),&
& p2ptag,icomm,iret) & p2ptag,icomm,iret)
else else
call mpi_send(sndbuf(snd_pt),nesd,& call mpi_send(sndbuf(snd_pt),nesd,&
& psb_mpi_c_dpk_,prcid(i),& & psb_mpi_r_dpk_,prcid(i),&
& p2ptag,icomm,iret) & p2ptag,icomm,iret)
end if end if
@ -882,7 +886,7 @@ complex(psb_dpk_), pointer, dimension(:) :: sndbuf, rcvbuf
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
p2ptag = psb_dcomplex_swap_tag p2ptag = psb_double_swap_tag
if ((proc_to_comm /= me).and.(nerv>0)) then if ((proc_to_comm /= me).and.(nerv>0)) then
call mpi_wait(rvhd(i),p2pstat,iret) call mpi_wait(rvhd(i),p2pstat,iret)

1954
base/comm/internals/psi_zswaptran.F90
View File

File diff suppressed because it is too large Load Diff

72
base/comm/internals/psi_zswaptran_a.F90
Unescape Escape View File

@ -30,7 +30,7 @@
! !
! !
! !
! File: psi_zswaptran.F90 ! File: psi_zswaptran_a.F90
! !
! Subroutine: psi_zswaptranm ! Subroutine: psi_zswaptranm
! Implements the data exchange among processes. This is similar to Xswapdata, but ! Implements the data exchange among processes. This is similar to Xswapdata, but
@ -43,7 +43,7 @@
! application environment. All the variants have the same structure ! application environment. All the variants have the same structure
! In all these subroutines X may be: I Integer ! In all these subroutines X may be: I Integer
! S real(psb_spk_) ! S real(psb_spk_)
! D real(psb_dpk_) ! D complex(psb_dpk_)
! C complex(psb_spk_) ! C complex(psb_spk_)
! Z complex(psb_dpk_) ! Z complex(psb_dpk_)
! Basically the operation is as follows: on each process, we identify ! Basically the operation is as follows: on each process, we identify
@ -74,10 +74,10 @@
! !
! !
! n - integer Number of columns in Y ! n - integer Number of columns in Y
! beta - complex Choose overwrite or sum. ! beta - real Choose overwrite or sum.
! y(:,:) - complex The data area ! y(:,:) - real The data area
! desc_a - type(psb_desc_type). The communication descriptor. ! desc_a - type(psb_desc_type). The communication descriptor.
! work(:) - complex Buffer space. If not sufficient, will do ! work(:) - real Buffer space. If not sufficient, will do
! our own internal allocation. ! our own internal allocation.
! info - integer. return code. ! info - integer. return code.
! data - integer which list is to be used to exchange data ! data - integer which list is to be used to exchange data
@ -101,12 +101,13 @@ contains
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info integer(psb_mpk_), intent(in) :: n
complex(psb_dpk_) :: y(:,:), beta complex(psb_dpk_), intent(in) :: beta
complex(psb_dpk_), target :: work(:) complex(psb_dpk_), intent(inout) :: y(:,:)
type(psb_desc_type),target :: desc_a type(psb_desc_type),target :: desc_a
complex(psb_dpk_), target :: work(:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional :: data integer(psb_ipk_), optional :: data
! locals ! locals
@ -174,7 +175,8 @@ contains
integer(psb_mpk_), intent(in) :: n integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
complex(psb_dpk_) :: y(:,:), beta complex(psb_dpk_), intent(inout) :: y(:,:)
complex(psb_dpk_), intent(in) :: beta
complex(psb_dpk_), target :: work(:) complex(psb_dpk_), target :: work(:)
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv
@ -305,8 +307,8 @@ contains
! swap elements using mpi_alltoallv ! swap elements using mpi_alltoallv
call mpi_alltoallv(rcvbuf,rvsz,brvidx,& call mpi_alltoallv(rcvbuf,rvsz,brvidx,&
& psb_mpi_c_dpk_,& & psb_mpi_r_dpk_,&
& sndbuf,sdsz,bsdidx,psb_mpi_c_dpk_,icomm,iret) & sndbuf,sdsz,bsdidx,psb_mpi_r_dpk_,icomm,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,m_err=(/iret/)) call psb_errpush(info,name,m_err=(/iret/))
@ -360,9 +362,9 @@ contains
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm) prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm)
if ((nesd>0).and.(proc_to_comm /= me)) then if ((nesd>0).and.(proc_to_comm /= me)) then
p2ptag = psb_dcomplex_swap_tag p2ptag = psb_double_swap_tag
call mpi_irecv(sndbuf(snd_pt),n*nesd,& call mpi_irecv(sndbuf(snd_pt),n*nesd,&
& psb_mpi_c_dpk_,prcid(i),& & psb_mpi_r_dpk_,prcid(i),&
& p2ptag,icomm,rvhd(i),iret) & p2ptag,icomm,rvhd(i),iret)
end if end if
rcv_pt = rcv_pt + n*nerv rcv_pt = rcv_pt + n*nerv
@ -383,14 +385,14 @@ contains
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
if ((nerv>0).and.(proc_to_comm /= me)) then if ((nerv>0).and.(proc_to_comm /= me)) then
p2ptag = psb_dcomplex_swap_tag p2ptag = psb_double_swap_tag
if (usersend) then if (usersend) then
call mpi_rsend(rcvbuf(rcv_pt),n*nerv,& call mpi_rsend(rcvbuf(rcv_pt),n*nerv,&
& psb_mpi_c_dpk_,prcid(i),& & psb_mpi_r_dpk_,prcid(i),&
& p2ptag,icomm,iret) & p2ptag,icomm,iret)
else else
call mpi_send(rcvbuf(rcv_pt),n*nerv,& call mpi_send(rcvbuf(rcv_pt),n*nerv,&
& psb_mpi_c_dpk_,prcid(i),& & psb_mpi_r_dpk_,prcid(i),&
& p2ptag,icomm,iret) & p2ptag,icomm,iret)
end if end if
@ -413,7 +415,7 @@ contains
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
p2ptag = psb_dcomplex_swap_tag p2ptag = psb_double_swap_tag
if ((proc_to_comm /= me).and.(nesd>0)) then if ((proc_to_comm /= me).and.(nesd>0)) then
call mpi_wait(rvhd(i),p2pstat,iret) call mpi_wait(rvhd(i),p2pstat,iret)
@ -525,7 +527,7 @@ contains
! application environment. All the variants have the same structure ! application environment. All the variants have the same structure
! In all these subroutines X may be: I Integer ! In all these subroutines X may be: I Integer
! S real(psb_spk_) ! S real(psb_spk_)
! D real(psb_dpk_) ! D complex(psb_dpk_)
! C complex(psb_spk_) ! C complex(psb_spk_)
! Z complex(psb_dpk_) ! Z complex(psb_dpk_)
! Basically the operation is as follows: on each process, we identify ! Basically the operation is as follows: on each process, we identify
@ -556,10 +558,10 @@ contains
! !
! !
! n - integer Number of columns in Y ! n - integer Number of columns in Y
! beta - complex Choose overwrite or sum. ! beta - real Choose overwrite or sum.
! y(:) - complex The data area ! y(:) - real The data area
! desc_a - type(psb_desc_type). The communication descriptor. ! desc_a - type(psb_desc_type). The communication descriptor.
! work(:) - complex Buffer space. If not sufficient, will do ! work(:) - real Buffer space. If not sufficient, will do
! our own internal allocation. ! our own internal allocation.
! info - integer. return code. ! info - integer. return code.
! data - integer which list is to be used to exchange data ! data - integer which list is to be used to exchange data
@ -580,10 +582,11 @@ contains
#endif #endif
integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info complex(psb_dpk_), intent(in) :: beta
complex(psb_dpk_) :: y(:), beta complex(psb_dpk_), intent(inout) :: y(:)
complex(psb_dpk_), target :: work(:)
type(psb_desc_type),target :: desc_a type(psb_desc_type),target :: desc_a
complex(psb_dpk_), target :: work(:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional :: data integer(psb_ipk_), optional :: data
! locals ! locals
@ -659,7 +662,8 @@ contains
type(psb_ctxt_type), intent(in) :: ctxt type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
complex(psb_dpk_) :: y(:), beta complex(psb_dpk_), intent(inout) :: y(:)
complex(psb_dpk_), intent(in) :: beta
complex(psb_dpk_), target :: work(:) complex(psb_dpk_), target :: work(:)
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv
@ -791,8 +795,8 @@ contains
! swap elements using mpi_alltoallv ! swap elements using mpi_alltoallv
call mpi_alltoallv(rcvbuf,rvsz,brvidx,& call mpi_alltoallv(rcvbuf,rvsz,brvidx,&
& psb_mpi_c_dpk_,& & psb_mpi_r_dpk_,&
& sndbuf,sdsz,bsdidx,psb_mpi_c_dpk_,icomm,iret) & sndbuf,sdsz,bsdidx,psb_mpi_r_dpk_,icomm,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,m_err=(/iret/)) call psb_errpush(info,name,m_err=(/iret/))
@ -845,9 +849,9 @@ contains
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm) prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm)
if ((nesd>0).and.(proc_to_comm /= me)) then if ((nesd>0).and.(proc_to_comm /= me)) then
p2ptag = psb_dcomplex_swap_tag p2ptag = psb_double_swap_tag
call mpi_irecv(sndbuf(snd_pt),nesd,& call mpi_irecv(sndbuf(snd_pt),nesd,&
& psb_mpi_c_dpk_,prcid(i),& & psb_mpi_r_dpk_,prcid(i),&
& p2ptag,icomm,rvhd(i),iret) & p2ptag,icomm,rvhd(i),iret)
end if end if
rcv_pt = rcv_pt + nerv rcv_pt = rcv_pt + nerv
@ -868,14 +872,14 @@ contains
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
if ((nerv>0).and.(proc_to_comm /= me)) then if ((nerv>0).and.(proc_to_comm /= me)) then
p2ptag = psb_dcomplex_swap_tag p2ptag = psb_double_swap_tag
if (usersend) then if (usersend) then
call mpi_rsend(rcvbuf(rcv_pt),nerv,& call mpi_rsend(rcvbuf(rcv_pt),nerv,&
& psb_mpi_c_dpk_,prcid(i),& & psb_mpi_r_dpk_,prcid(i),&
& p2ptag, icomm,iret) & p2ptag, icomm,iret)
else else
call mpi_send(rcvbuf(rcv_pt),nerv,& call mpi_send(rcvbuf(rcv_pt),nerv,&
& psb_mpi_c_dpk_,prcid(i),& & psb_mpi_r_dpk_,prcid(i),&
& p2ptag, icomm,iret) & p2ptag, icomm,iret)
end if end if
@ -896,7 +900,7 @@ contains
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
p2ptag = psb_dcomplex_swap_tag p2ptag = psb_double_swap_tag
if ((proc_to_comm /= me).and.(nesd>0)) then if ((proc_to_comm /= me).and.(nesd>0)) then
call mpi_wait(rvhd(i),p2pstat,iret) call mpi_wait(rvhd(i),p2pstat,iret)

2
base/comm/psb_cgather.f90
Unescape Escape View File

@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may ! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED

4
base/comm/psb_cgather_a.f90
Unescape Escape View File

@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may ! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@ -189,7 +189,7 @@ end subroutine psb_cgatherm
!!$ documentation and/or other materials provided with the distribution. !!$ documentation and/or other materials provided with the distribution.
!!$ 3. The name of the PSBLAS group or the names of its contributors may !!$ 3. The name of the PSBLAS group or the names of its contributors may
!!$ not be used to endorse or promote products derived from this !!$ not be used to endorse or promote products derived from this
!!$ software without specific written permission. !!$ software without specific prior written permission.
!!$ !!$
!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS !!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED !!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED

19
base/comm/psb_chalo.f90
Unescape Escape View File

@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may ! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@ -65,13 +65,13 @@ subroutine psb_chalo_vect(x,desc_a,info,tran,mode,data)
! locals ! locals
type(psb_ctxt_type) :: ctxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, iix, jjx, & integer(psb_ipk_) :: np, me, err_act, iix, jjx, &
& nrow, ncol, lldx, imode, data_ & nrow, ncol, lldx, imode,data_
integer(psb_lpk_) :: m, n, ix, ijx integer(psb_lpk_) :: m, n, ix, ijx
character :: tran_ character :: tran_
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
logical :: aliw logical :: aliw
name = 'psb_chalo_vect' name = 'psb_chalov'
info = psb_success_ info = psb_success_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
@ -79,7 +79,7 @@ subroutine psb_chalo_vect(x,desc_a,info,tran,mode,data)
goto 9999 goto 9999
end if end if
ctxt=desc_a%get_context() ctxt = desc_a%get_context()
! check on blacs grid ! check on blacs grid
call psb_info(ctxt, me, np) call psb_info(ctxt, me, np)
@ -116,7 +116,7 @@ subroutine psb_chalo_vect(x,desc_a,info,tran,mode,data)
if (present(mode)) then if (present(mode)) then
imode = mode imode = mode
else else
imode = IOR(psb_swap_send_,psb_swap_recv_) imode = psb_comm_status_sync_
endif endif
if ((info == 0).and.(lldx<ncol)) call x%reall(ncol,info) if ((info == 0).and.(lldx<ncol)) call x%reall(ncol,info)
@ -193,11 +193,12 @@ subroutine psb_chalo_multivect(x,desc_a,info,tran,mode,data)
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
logical :: aliw logical :: aliw
name = 'psb_chalo_multivect' name = 'psb_chalov'
info = psb_success_ info = psb_success_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_
goto 9999
end if end if
ctxt = desc_a%get_context() ctxt = desc_a%get_context()
@ -238,7 +239,7 @@ subroutine psb_chalo_multivect(x,desc_a,info,tran,mode,data)
if (present(mode)) then if (present(mode)) then
imode = mode imode = mode
else else
imode = IOR(psb_swap_send_,psb_swap_recv_) imode = psb_comm_status_sync_
endif endif
if (lldx < ncol) call x%reall(ncol,x%get_ncols(),info) if (lldx < ncol) call x%reall(ncol,x%get_ncols(),info)
@ -261,7 +262,7 @@ subroutine psb_chalo_multivect(x,desc_a,info,tran,mode,data)
end if end if
if (info /= psb_success_) then if (info /= psb_success_) then
ch_err = 'PSI_swapdata' ch_err='PSI_swapdata'
call psb_errpush(psb_err_from_subroutine_,name,a_err=ch_err) call psb_errpush(psb_err_from_subroutine_,name,a_err=ch_err)
goto 9999 goto 9999
end if end if

6
base/comm/psb_chalo_a.f90
Unescape Escape View File

@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may ! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@ -29,7 +29,7 @@
! POSSIBILITY OF SUCH DAMAGE. ! POSSIBILITY OF SUCH DAMAGE.
! !
! !
! File: psb_chalo_a.f90 ! File: psb_chalo.f90
! !
! Subroutine: psb_chalom ! Subroutine: psb_chalom
! This subroutine performs the exchange of the halo elements in a ! This subroutine performs the exchange of the halo elements in a
@ -217,7 +217,7 @@ end subroutine psb_chalom
!!$ documentation and/or other materials provided with the distribution. !!$ documentation and/or other materials provided with the distribution.
!!$ 3. The name of the PSBLAS group or the names of its contributors may !!$ 3. The name of the PSBLAS group or the names of its contributors may
!!$ not be used to endorse or promote products derived from this !!$ not be used to endorse or promote products derived from this
!!$ software without specific written permission. !!$ software without specific prior written permission.
!!$ !!$
!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS !!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED !!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED

21
base/comm/psb_covrl.f90
Unescape Escape View File

@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may ! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@ -81,14 +81,14 @@ subroutine psb_covrl_vect(x,desc_a,info,update,mode)
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
logical :: aliw logical :: aliw
name = 'psb_covrl_vect' name = 'psb_covrlv'
info = psb_success_ info = psb_success_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ctxt = desc_a%get_context() ctxt=desc_a%get_context()
! check on blacs grid ! check on blacs grid
call psb_info(ctxt, me, np) call psb_info(ctxt, me, np)
@ -136,7 +136,8 @@ subroutine psb_covrl_vect(x,desc_a,info,update,mode)
! exchange overlap elements ! exchange overlap elements
if (do_swap) then if (do_swap) then
call psi_swapdata(mode_,cone,x%v,desc_a,info,data=psb_comm_ovr_) call psi_swapdata(mode_,cone,x%v,&
& desc_a,info,data=psb_comm_ovr_)
end if end if
if (info == psb_success_) call psi_ovrl_upd(x%v,desc_a,update_,info) if (info == psb_success_) call psi_ovrl_upd(x%v,desc_a,update_,info)
if (info /= psb_success_) then if (info /= psb_success_) then
@ -202,14 +203,14 @@ subroutine psb_covrl_multivect(x,desc_a,info,update,mode)
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
logical :: aliw logical :: aliw
name = 'psb_covrl_multivect' name = 'psb_covrlv'
info = psb_success_ info = psb_success_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ctxt=desc_a%get_context() ctxt = desc_a%get_context()
! check on blacs grid ! check on blacs grid
call psb_info(ctxt, me, np) call psb_info(ctxt, me, np)
@ -244,7 +245,7 @@ subroutine psb_covrl_multivect(x,desc_a,info,update,mode)
if (present(mode)) then if (present(mode)) then
mode_ = mode mode_ = mode
else else
mode_ = IOR(psb_swap_send_,psb_swap_recv_) mode_ = psb_comm_status_sync_
endif endif
do_swap = (mode_ /= 0) do_swap = (mode_ /= 0)
@ -252,14 +253,16 @@ subroutine psb_covrl_multivect(x,desc_a,info,update,mode)
if (ldx < ncol) call x%reall(ncol,x%get_ncols(),info) if (ldx < ncol) call x%reall(ncol,x%get_ncols(),info)
if(info /= psb_success_) then if(info /= psb_success_) then
info=psb_err_from_subroutine_ ; ch_err='psb_reall' info=psb_err_from_subroutine_
ch_err='psb_reall'
call psb_errpush(info,name,a_err=ch_err) call psb_errpush(info,name,a_err=ch_err)
goto 9999 goto 9999
end if end if
! exchange overlap elements ! exchange overlap elements
if (do_swap) then if (do_swap) then
call psi_swapdata(mode_,cone,x%v, desc_a,info,data=psb_comm_ovr_) call psi_swapdata(mode_,cone,x%v,&
& desc_a,info,data=psb_comm_ovr_)
end if end if
if (info == psb_success_) call psi_ovrl_upd(x%v,desc_a,update_,info) if (info == psb_success_) call psi_ovrl_upd(x%v,desc_a,update_,info)
if (info /= psb_success_) then if (info /= psb_success_) then

6
base/comm/psb_covrl_a.f90
Unescape Escape View File

@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may ! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@ -30,7 +30,7 @@
! !
! !
! !
! File: psb_covrl_a.f90 ! File: psb_covrl.f90
! !
! Subroutine: psb_covrlm ! Subroutine: psb_covrlm
! This subroutine performs the exchange of the overlap elements in a ! This subroutine performs the exchange of the overlap elements in a
@ -208,7 +208,7 @@ end subroutine psb_covrlm
!!$ documentation and/or other materials provided with the distribution. !!$ documentation and/or other materials provided with the distribution.
!!$ 3. The name of the PSBLAS group or the names of its contributors may !!$ 3. The name of the PSBLAS group or the names of its contributors may
!!$ not be used to endorse or promote products derived from this !!$ not be used to endorse or promote products derived from this
!!$ software without specific written permission. !!$ software without specific prior written permission.
!!$ !!$
!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS !!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED !!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED

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

@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may ! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED

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

@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may ! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@ -262,7 +262,7 @@ end subroutine psb_cscatterm
!!$ documentation and/or other materials provided with the distribution. !!$ documentation and/or other materials provided with the distribution.
!!$ 3. The name of the PSBLAS group or the names of its contributors may !!$ 3. The name of the PSBLAS group or the names of its contributors may
!!$ not be used to endorse or promote products derived from this !!$ not be used to endorse or promote products derived from this
!!$ software without specific written permission. !!$ software without specific prior written permission.
!!$ !!$
!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS !!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED !!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED

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

@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may ! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED

2
base/comm/psb_dgather.f90
Unescape Escape View File

@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may ! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED

4
base/comm/psb_dgather_a.f90
Unescape Escape View File

@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may ! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@ -189,7 +189,7 @@ end subroutine psb_dgatherm
!!$ documentation and/or other materials provided with the distribution. !!$ documentation and/or other materials provided with the distribution.
!!$ 3. The name of the PSBLAS group or the names of its contributors may !!$ 3. The name of the PSBLAS group or the names of its contributors may
!!$ not be used to endorse or promote products derived from this !!$ not be used to endorse or promote products derived from this
!!$ software without specific written permission. !!$ software without specific prior written permission.
!!$ !!$
!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS !!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED !!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED

25
base/comm/psb_dhalo.f90
Unescape Escape View File

@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may ! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@ -54,15 +54,13 @@
subroutine psb_dhalo_vect(x,desc_a,info,tran,mode,data) subroutine psb_dhalo_vect(x,desc_a,info,tran,mode,data)
use psb_base_mod, psb_protect_name => psb_dhalo_vect use psb_base_mod, psb_protect_name => psb_dhalo_vect
use psi_mod use psi_mod
use psb_comm_factory_mod
implicit none implicit none
type(psb_d_vect_type), intent(inout) :: x type(psb_d_vect_type), intent(inout) :: x
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: tran
integer(psb_ipk_), intent(in), optional :: mode,data integer(psb_ipk_), intent(in), optional :: mode,data
character, intent(in), optional :: tran
! locals ! locals
type(psb_ctxt_type) :: ctxt type(psb_ctxt_type) :: ctxt
@ -73,14 +71,15 @@ subroutine psb_dhalo_vect(x,desc_a,info,tran,mode,data)
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
logical :: aliw logical :: aliw
name = 'psb_dhalo_vect' name = 'psb_dhalov'
info = psb_success_ info = psb_success_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_
goto 9999
end if end if
ctxt=desc_a%get_context() ctxt = desc_a%get_context()
! check on blacs grid ! check on blacs grid
call psb_info(ctxt, me, np) call psb_info(ctxt, me, np)
@ -128,7 +127,6 @@ subroutine psb_dhalo_vect(x,desc_a,info,tran,mode,data)
goto 9999 goto 9999
end if end if
! exchange halo elements ! exchange halo elements
if(tran_ == 'N') then if(tran_ == 'N') then
call psi_swapdata(imode,dzero,x%v,desc_a,info,data=data_) call psi_swapdata(imode,dzero,x%v,desc_a,info,data=data_)
@ -141,7 +139,7 @@ subroutine psb_dhalo_vect(x,desc_a,info,tran,mode,data)
end if end if
if (info /= psb_success_) then if (info /= psb_success_) then
ch_err = 'PSI_swapdata' ch_err='PSI_swapdata'
call psb_errpush(psb_err_from_subroutine_,name,a_err=ch_err) call psb_errpush(psb_err_from_subroutine_,name,a_err=ch_err)
goto 9999 goto 9999
end if end if
@ -183,8 +181,8 @@ subroutine psb_dhalo_multivect(x,desc_a,info,tran,mode,data)
type(psb_d_multivect_type), intent(inout) :: x type(psb_d_multivect_type), intent(inout) :: x
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: tran
integer(psb_ipk_), intent(in), optional :: mode,data integer(psb_ipk_), intent(in), optional :: mode,data
character, intent(in), optional :: tran
! locals ! locals
type(psb_ctxt_type) :: ctxt type(psb_ctxt_type) :: ctxt
@ -195,11 +193,12 @@ subroutine psb_dhalo_multivect(x,desc_a,info,tran,mode,data)
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
logical :: aliw logical :: aliw
name = 'psb_dhalo_multivect' name = 'psb_dhalov'
info = psb_success_ info = psb_success_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_
goto 9999
end if end if
ctxt = desc_a%get_context() ctxt = desc_a%get_context()
@ -240,7 +239,7 @@ subroutine psb_dhalo_multivect(x,desc_a,info,tran,mode,data)
if (present(mode)) then if (present(mode)) then
imode = mode imode = mode
else else
imode = psb_comm_mov_ imode = psb_comm_status_sync_
endif endif
if (lldx < ncol) call x%reall(ncol,x%get_ncols(),info) if (lldx < ncol) call x%reall(ncol,x%get_ncols(),info)

4
base/comm/psb_dhalo_a.f90
Unescape Escape View File

@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may ! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@ -217,7 +217,7 @@ end subroutine psb_dhalom
!!$ documentation and/or other materials provided with the distribution. !!$ documentation and/or other materials provided with the distribution.
!!$ 3. The name of the PSBLAS group or the names of its contributors may !!$ 3. The name of the PSBLAS group or the names of its contributors may
!!$ not be used to endorse or promote products derived from this !!$ not be used to endorse or promote products derived from this
!!$ software without specific written permission. !!$ software without specific prior written permission.
!!$ !!$
!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS !!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED !!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED

24
base/comm/psb_dovrl.f90
Unescape Escape View File

@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may ! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@ -65,7 +65,6 @@
subroutine psb_dovrl_vect(x,desc_a,info,update,mode) subroutine psb_dovrl_vect(x,desc_a,info,update,mode)
use psb_base_mod, psb_protect_name => psb_dovrl_vect use psb_base_mod, psb_protect_name => psb_dovrl_vect
use psi_mod use psi_mod
use psb_comm_factory_mod
implicit none implicit none
type(psb_d_vect_type), intent(inout) :: x type(psb_d_vect_type), intent(inout) :: x
@ -82,14 +81,14 @@ subroutine psb_dovrl_vect(x,desc_a,info,update,mode)
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
logical :: aliw logical :: aliw
name = 'psb_dovrl_vect' name = 'psb_dovrlv'
info = psb_success_ info = psb_success_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ctxt = desc_a%get_context() ctxt=desc_a%get_context()
! check on blacs grid ! check on blacs grid
call psb_info(ctxt, me, np) call psb_info(ctxt, me, np)
@ -122,7 +121,7 @@ subroutine psb_dovrl_vect(x,desc_a,info,update,mode)
if (present(mode)) then if (present(mode)) then
mode_ = mode mode_ = mode
else else
mode_ = psb_comm_status_sync_ mode_ = IOR(psb_swap_send_,psb_swap_recv_)
endif endif
do_swap = (mode_ /= 0) do_swap = (mode_ /= 0)
@ -137,7 +136,8 @@ subroutine psb_dovrl_vect(x,desc_a,info,update,mode)
! exchange overlap elements ! exchange overlap elements
if (do_swap) then if (do_swap) then
call psi_swapdata(mode_, done, x%v, desc_a, info, data=psb_comm_ovr_) call psi_swapdata(mode_,done,x%v,&
& desc_a,info,data=psb_comm_ovr_)
end if end if
if (info == psb_success_) call psi_ovrl_upd(x%v,desc_a,update_,info) if (info == psb_success_) call psi_ovrl_upd(x%v,desc_a,update_,info)
if (info /= psb_success_) then if (info /= psb_success_) then
@ -203,14 +203,14 @@ subroutine psb_dovrl_multivect(x,desc_a,info,update,mode)
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
logical :: aliw logical :: aliw
name = 'psb_dovrl_multivect' name = 'psb_dovrlv'
info = psb_success_ info = psb_success_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ctxt=desc_a%get_context() ctxt = desc_a%get_context()
! check on blacs grid ! check on blacs grid
call psb_info(ctxt, me, np) call psb_info(ctxt, me, np)
@ -245,7 +245,7 @@ subroutine psb_dovrl_multivect(x,desc_a,info,update,mode)
if (present(mode)) then if (present(mode)) then
mode_ = mode mode_ = mode
else else
mode_ = IOR(psb_swap_send_,psb_swap_recv_) mode_ = psb_comm_status_sync_
endif endif
do_swap = (mode_ /= 0) do_swap = (mode_ /= 0)
@ -253,14 +253,16 @@ subroutine psb_dovrl_multivect(x,desc_a,info,update,mode)
if (ldx < ncol) call x%reall(ncol,x%get_ncols(),info) if (ldx < ncol) call x%reall(ncol,x%get_ncols(),info)
if(info /= psb_success_) then if(info /= psb_success_) then
info=psb_err_from_subroutine_ ; ch_err='psb_reall' info=psb_err_from_subroutine_
ch_err='psb_reall'
call psb_errpush(info,name,a_err=ch_err) call psb_errpush(info,name,a_err=ch_err)
goto 9999 goto 9999
end if end if
! exchange overlap elements ! exchange overlap elements
if (do_swap) then if (do_swap) then
call psi_swapdata(mode_, done, x%v, desc_a, info, data=psb_comm_ovr_) call psi_swapdata(mode_,done,x%v,&
& desc_a,info,data=psb_comm_ovr_)
end if end if
if (info == psb_success_) call psi_ovrl_upd(x%v,desc_a,update_,info) if (info == psb_success_) call psi_ovrl_upd(x%v,desc_a,update_,info)
if (info /= psb_success_) then if (info /= psb_success_) then

4
base/comm/psb_dovrl_a.f90
Unescape Escape View File

@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may ! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@ -208,7 +208,7 @@ end subroutine psb_dovrlm
!!$ documentation and/or other materials provided with the distribution. !!$ documentation and/or other materials provided with the distribution.
!!$ 3. The name of the PSBLAS group or the names of its contributors may !!$ 3. The name of the PSBLAS group or the names of its contributors may
!!$ not be used to endorse or promote products derived from this !!$ not be used to endorse or promote products derived from this
!!$ software without specific written permission. !!$ software without specific prior written permission.
!!$ !!$
!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS !!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED !!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED

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

@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may ! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED

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

@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may ! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@ -262,7 +262,7 @@ end subroutine psb_dscatterm
!!$ documentation and/or other materials provided with the distribution. !!$ documentation and/or other materials provided with the distribution.
!!$ 3. The name of the PSBLAS group or the names of its contributors may !!$ 3. The name of the PSBLAS group or the names of its contributors may
!!$ not be used to endorse or promote products derived from this !!$ not be used to endorse or promote products derived from this
!!$ software without specific written permission. !!$ software without specific prior written permission.
!!$ !!$
!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS !!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED !!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED

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

@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may ! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED

4
base/comm/psb_egather_a.f90
Unescape Escape View File

@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may ! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@ -189,7 +189,7 @@ end subroutine psb_egatherm
!!$ documentation and/or other materials provided with the distribution. !!$ documentation and/or other materials provided with the distribution.
!!$ 3. The name of the PSBLAS group or the names of its contributors may !!$ 3. The name of the PSBLAS group or the names of its contributors may
!!$ not be used to endorse or promote products derived from this !!$ not be used to endorse or promote products derived from this
!!$ software without specific written permission. !!$ software without specific prior written permission.
!!$ !!$
!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS !!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED !!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED

6
base/comm/psb_ehalo_a.f90
Unescape Escape View File

@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may ! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@ -174,7 +174,7 @@ subroutine psb_ehalom(x,desc_a,info,jx,ik,work,tran,mode,data)
& desc_a,iwork,info,data=data_) & desc_a,iwork,info,data=data_)
else if((tran_ == 'T').or.(tran_ == 'C')) then else if((tran_ == 'T').or.(tran_ == 'C')) then
call psi_swaptran(imode,k,eone,xp,& call psi_swaptran(imode,k,eone,xp,&
& desc_a,iwork,info) &desc_a,iwork,info)
else else
info = psb_err_internal_error_ info = psb_err_internal_error_
call psb_errpush(info,name,a_err='invalid tran') call psb_errpush(info,name,a_err='invalid tran')
@ -217,7 +217,7 @@ end subroutine psb_ehalom
!!$ documentation and/or other materials provided with the distribution. !!$ documentation and/or other materials provided with the distribution.
!!$ 3. The name of the PSBLAS group or the names of its contributors may !!$ 3. The name of the PSBLAS group or the names of its contributors may
!!$ not be used to endorse or promote products derived from this !!$ not be used to endorse or promote products derived from this
!!$ software without specific written permission. !!$ software without specific prior written permission.
!!$ !!$
!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS !!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED !!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED

4
base/comm/psb_eovrl_a.f90
Unescape Escape View File

@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may ! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@ -208,7 +208,7 @@ end subroutine psb_eovrlm
!!$ documentation and/or other materials provided with the distribution. !!$ documentation and/or other materials provided with the distribution.
!!$ 3. The name of the PSBLAS group or the names of its contributors may !!$ 3. The name of the PSBLAS group or the names of its contributors may
!!$ not be used to endorse or promote products derived from this !!$ not be used to endorse or promote products derived from this
!!$ software without specific written permission. !!$ software without specific prior written permission.
!!$ !!$
!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS !!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED !!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED

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

@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may ! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@ -262,7 +262,7 @@ end subroutine psb_escatterm
!!$ documentation and/or other materials provided with the distribution. !!$ documentation and/or other materials provided with the distribution.
!!$ 3. The name of the PSBLAS group or the names of its contributors may !!$ 3. The name of the PSBLAS group or the names of its contributors may
!!$ not be used to endorse or promote products derived from this !!$ not be used to endorse or promote products derived from this
!!$ software without specific written permission. !!$ software without specific prior written permission.
!!$ !!$
!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS !!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED !!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED

4
base/comm/psb_i2gather_a.f90
Unescape Escape View File

@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may ! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@ -189,7 +189,7 @@ end subroutine psb_i2gatherm
!!$ documentation and/or other materials provided with the distribution. !!$ documentation and/or other materials provided with the distribution.
!!$ 3. The name of the PSBLAS group or the names of its contributors may !!$ 3. The name of the PSBLAS group or the names of its contributors may
!!$ not be used to endorse or promote products derived from this !!$ not be used to endorse or promote products derived from this
!!$ software without specific written permission. !!$ software without specific prior written permission.
!!$ !!$
!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS !!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED !!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED

4
base/comm/psb_i2halo_a.f90
Unescape Escape View File

@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may ! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@ -217,7 +217,7 @@ end subroutine psb_i2halom
!!$ documentation and/or other materials provided with the distribution. !!$ documentation and/or other materials provided with the distribution.
!!$ 3. The name of the PSBLAS group or the names of its contributors may !!$ 3. The name of the PSBLAS group or the names of its contributors may
!!$ not be used to endorse or promote products derived from this !!$ not be used to endorse or promote products derived from this
!!$ software without specific written permission. !!$ software without specific prior written permission.
!!$ !!$
!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS !!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED !!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED

4
base/comm/psb_i2ovrl_a.f90
Unescape Escape View File

@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may ! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@ -208,7 +208,7 @@ end subroutine psb_i2ovrlm
!!$ documentation and/or other materials provided with the distribution. !!$ documentation and/or other materials provided with the distribution.
!!$ 3. The name of the PSBLAS group or the names of its contributors may !!$ 3. The name of the PSBLAS group or the names of its contributors may
!!$ not be used to endorse or promote products derived from this !!$ not be used to endorse or promote products derived from this
!!$ software without specific written permission. !!$ software without specific prior written permission.
!!$ !!$
!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS !!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED !!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED

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

@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may ! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@ -262,7 +262,7 @@ end subroutine psb_i2scatterm
!!$ documentation and/or other materials provided with the distribution. !!$ documentation and/or other materials provided with the distribution.
!!$ 3. The name of the PSBLAS group or the names of its contributors may !!$ 3. The name of the PSBLAS group or the names of its contributors may
!!$ not be used to endorse or promote products derived from this !!$ not be used to endorse or promote products derived from this
!!$ software without specific written permission. !!$ software without specific prior written permission.
!!$ !!$
!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS !!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED !!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED

2
base/comm/psb_igather.f90
Unescape Escape View File

@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may ! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED

16
base/comm/psb_ihalo.f90
Unescape Escape View File

@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may ! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@ -71,11 +71,12 @@ subroutine psb_ihalo_vect(x,desc_a,info,tran,mode,data)
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
logical :: aliw logical :: aliw
name = 'psb_ihalo_vect' name = 'psb_ihalov'
info = psb_success_ info = psb_success_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_
goto 9999
end if end if
ctxt = desc_a%get_context() ctxt = desc_a%get_context()
@ -115,7 +116,7 @@ subroutine psb_ihalo_vect(x,desc_a,info,tran,mode,data)
if (present(mode)) then if (present(mode)) then
imode = mode imode = mode
else else
imode = IOR(psb_swap_send_,psb_swap_recv_) imode = psb_comm_status_sync_
endif endif
if ((info == 0).and.(lldx<ncol)) call x%reall(ncol,info) if ((info == 0).and.(lldx<ncol)) call x%reall(ncol,info)
@ -192,11 +193,12 @@ subroutine psb_ihalo_multivect(x,desc_a,info,tran,mode,data)
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
logical :: aliw logical :: aliw
name = 'psb_ihalo_multivect' name = 'psb_ihalov'
info = psb_success_ info = psb_success_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_
goto 9999
end if end if
ctxt = desc_a%get_context() ctxt = desc_a%get_context()
@ -237,7 +239,7 @@ subroutine psb_ihalo_multivect(x,desc_a,info,tran,mode,data)
if (present(mode)) then if (present(mode)) then
imode = mode imode = mode
else else
imode = IOR(psb_swap_send_,psb_swap_recv_) imode = psb_comm_status_sync_
endif endif
if (lldx < ncol) call x%reall(ncol,x%get_ncols(),info) if (lldx < ncol) call x%reall(ncol,x%get_ncols(),info)

22
base/comm/psb_iovrl.f90
Unescape Escape View File

@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may ! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@ -81,14 +81,14 @@ subroutine psb_iovrl_vect(x,desc_a,info,update,mode)
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
logical :: aliw logical :: aliw
name = 'psb_iovrl_vect' name = 'psb_iovrlv'
info = psb_success_ info = psb_success_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ctxt = desc_a%get_context() ctxt=desc_a%get_context()
! check on blacs grid ! check on blacs grid
call psb_info(ctxt, me, np) call psb_info(ctxt, me, np)
@ -136,7 +136,8 @@ subroutine psb_iovrl_vect(x,desc_a,info,update,mode)
! exchange overlap elements ! exchange overlap elements
if (do_swap) then if (do_swap) then
call psi_swapdata(mode_,ione,x%v,desc_a,info,data=psb_comm_ovr_) call psi_swapdata(mode_,ione,x%v,&
& desc_a,info,data=psb_comm_ovr_)
end if end if
if (info == psb_success_) call psi_ovrl_upd(x%v,desc_a,update_,info) if (info == psb_success_) call psi_ovrl_upd(x%v,desc_a,update_,info)
if (info /= psb_success_) then if (info /= psb_success_) then
@ -202,12 +203,11 @@ subroutine psb_iovrl_multivect(x,desc_a,info,update,mode)
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
logical :: aliw logical :: aliw
name = 'psb_iovrl_multivect' name = 'psb_iovrlv'
info = psb_success_ info = psb_success_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ info = psb_err_internal_error_ ; goto 9999
goto 9999
end if end if
ctxt = desc_a%get_context() ctxt = desc_a%get_context()
@ -245,7 +245,7 @@ subroutine psb_iovrl_multivect(x,desc_a,info,update,mode)
if (present(mode)) then if (present(mode)) then
mode_ = mode mode_ = mode
else else
mode_ = IOR(psb_swap_send_,psb_swap_recv_) mode_ = psb_comm_status_sync_
endif endif
do_swap = (mode_ /= 0) do_swap = (mode_ /= 0)
@ -253,14 +253,16 @@ subroutine psb_iovrl_multivect(x,desc_a,info,update,mode)
if (ldx < ncol) call x%reall(ncol,x%get_ncols(),info) if (ldx < ncol) call x%reall(ncol,x%get_ncols(),info)
if(info /= psb_success_) then if(info /= psb_success_) then
info=psb_err_from_subroutine_ ; ch_err='psb_reall' info=psb_err_from_subroutine_
ch_err='psb_reall'
call psb_errpush(info,name,a_err=ch_err) call psb_errpush(info,name,a_err=ch_err)
goto 9999 goto 9999
end if end if
! exchange overlap elements ! exchange overlap elements
if (do_swap) then if (do_swap) then
call psi_swapdata(mode_,ione,x%v,desc_a,info,data=psb_comm_ovr_) call psi_swapdata(mode_,ione,x%v,&
& desc_a,info,data=psb_comm_ovr_)
end if end if
if (info == psb_success_) call psi_ovrl_upd(x%v,desc_a,update_,info) if (info == psb_success_) call psi_ovrl_upd(x%v,desc_a,update_,info)
if (info /= psb_success_) then if (info /= psb_success_) then

2
base/comm/psb_iscatter.F90
Unescape Escape View File

@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may ! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED

2
base/comm/psb_ispgather.F90
Unescape Escape View File

@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may ! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED

2
base/comm/psb_lgather.f90
Unescape Escape View File

@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may ! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED

15
base/comm/psb_lhalo.f90
Unescape Escape View File

@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may ! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@ -65,13 +65,13 @@ subroutine psb_lhalo_vect(x,desc_a,info,tran,mode,data)
! locals ! locals
type(psb_ctxt_type) :: ctxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, iix, jjx, & integer(psb_ipk_) :: np, me, err_act, iix, jjx, &
& nrow, ncol, lldx, imode, data_ & nrow, ncol, lldx, imode,data_
integer(psb_lpk_) :: m, n, ix, ijx integer(psb_lpk_) :: m, n, ix, ijx
character :: tran_ character :: tran_
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
logical :: aliw logical :: aliw
name = 'psb_lhalo_vect' name = 'psb_lhalov'
info = psb_success_ info = psb_success_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
@ -116,14 +116,13 @@ subroutine psb_lhalo_vect(x,desc_a,info,tran,mode,data)
if (present(mode)) then if (present(mode)) then
imode = mode imode = mode
else else
imode = IOR(psb_swap_send_,psb_swap_recv_) imode = psb_comm_status_sync_
endif endif
if ((info == 0).and.(lldx<ncol)) call x%reall(ncol,info) if ((info == 0).and.(lldx<ncol)) call x%reall(ncol,info)
if(info /= psb_success_) then if(info /= psb_success_) then
info = psb_err_from_subroutine_ info=psb_err_from_subroutine_ ; ch_err='reall'
ch_err = 'reall'
call psb_errpush(info,name,a_err=ch_err) call psb_errpush(info,name,a_err=ch_err)
goto 9999 goto 9999
end if end if
@ -194,7 +193,7 @@ subroutine psb_lhalo_multivect(x,desc_a,info,tran,mode,data)
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
logical :: aliw logical :: aliw
name = 'psb_lhalo_multivect' name = 'psb_lhalov'
info = psb_success_ info = psb_success_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
@ -240,7 +239,7 @@ subroutine psb_lhalo_multivect(x,desc_a,info,tran,mode,data)
if (present(mode)) then if (present(mode)) then
imode = mode imode = mode
else else
imode = IOR(psb_swap_send_,psb_swap_recv_) imode = psb_comm_status_sync_
endif endif
if (lldx < ncol) call x%reall(ncol,x%get_ncols(),info) if (lldx < ncol) call x%reall(ncol,x%get_ncols(),info)

21
base/comm/psb_lovrl.f90
Unescape Escape View File

@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may ! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@ -81,14 +81,14 @@ subroutine psb_lovrl_vect(x,desc_a,info,update,mode)
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
logical :: aliw logical :: aliw
name = 'psb_lovrl_vect' name = 'psb_lovrlv'
info = psb_success_ info = psb_success_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ctxt = desc_a%get_context() ctxt=desc_a%get_context()
! check on blacs grid ! check on blacs grid
call psb_info(ctxt, me, np) call psb_info(ctxt, me, np)
@ -136,7 +136,8 @@ subroutine psb_lovrl_vect(x,desc_a,info,update,mode)
! exchange overlap elements ! exchange overlap elements
if (do_swap) then if (do_swap) then
call psi_swapdata(mode_,lone,x%v,desc_a,info,data=psb_comm_ovr_) call psi_swapdata(mode_,lone,x%v,&
& desc_a,info,data=psb_comm_ovr_)
end if end if
if (info == psb_success_) call psi_ovrl_upd(x%v,desc_a,update_,info) if (info == psb_success_) call psi_ovrl_upd(x%v,desc_a,update_,info)
if (info /= psb_success_) then if (info /= psb_success_) then
@ -202,14 +203,14 @@ subroutine psb_lovrl_multivect(x,desc_a,info,update,mode)
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
logical :: aliw logical :: aliw
name = 'psb_lovrl_multivect' name = 'psb_lovrlv'
info = psb_success_ info = psb_success_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ctxt=desc_a%get_context() ctxt = desc_a%get_context()
! check on blacs grid ! check on blacs grid
call psb_info(ctxt, me, np) call psb_info(ctxt, me, np)
@ -244,7 +245,7 @@ subroutine psb_lovrl_multivect(x,desc_a,info,update,mode)
if (present(mode)) then if (present(mode)) then
mode_ = mode mode_ = mode
else else
mode_ = IOR(psb_swap_send_,psb_swap_recv_) mode_ = psb_comm_status_sync_
endif endif
do_swap = (mode_ /= 0) do_swap = (mode_ /= 0)
@ -252,14 +253,16 @@ subroutine psb_lovrl_multivect(x,desc_a,info,update,mode)
if (ldx < ncol) call x%reall(ncol,x%get_ncols(),info) if (ldx < ncol) call x%reall(ncol,x%get_ncols(),info)
if(info /= psb_success_) then if(info /= psb_success_) then
info=psb_err_from_subroutine_ ; ch_err='psb_reall' info=psb_err_from_subroutine_
ch_err='psb_reall'
call psb_errpush(info,name,a_err=ch_err) call psb_errpush(info,name,a_err=ch_err)
goto 9999 goto 9999
end if end if
! exchange overlap elements ! exchange overlap elements
if (do_swap) then if (do_swap) then
call psi_swapdata(mode_,lone,x%v,desc_a,info,data=psb_comm_ovr_) call psi_swapdata(mode_,lone,x%v,&
& desc_a,info,data=psb_comm_ovr_)
end if end if
if (info == psb_success_) call psi_ovrl_upd(x%v,desc_a,update_,info) if (info == psb_success_) call psi_ovrl_upd(x%v,desc_a,update_,info)
if (info /= psb_success_) then if (info /= psb_success_) then

2
base/comm/psb_lscatter.F90
Unescape Escape View File

@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may ! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED

2
base/comm/psb_lspgather.F90
Unescape Escape View File

@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may ! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED

4
base/comm/psb_mgather_a.f90
Unescape Escape View File

@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may ! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@ -189,7 +189,7 @@ end subroutine psb_mgatherm
!!$ documentation and/or other materials provided with the distribution. !!$ documentation and/or other materials provided with the distribution.
!!$ 3. The name of the PSBLAS group or the names of its contributors may !!$ 3. The name of the PSBLAS group or the names of its contributors may
!!$ not be used to endorse or promote products derived from this !!$ not be used to endorse or promote products derived from this
!!$ software without specific written permission. !!$ software without specific prior written permission.
!!$ !!$
!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS !!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED !!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED

Some files were not shown because too many files have changed in this diff Show More

Write Preview
Loading…
Cancel
Save