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 1 month 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.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``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.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``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.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``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.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``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.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``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.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED

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

File diff suppressed because it is too large Load Diff

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

@ -39,7 +39,7 @@
! application environment. All the variants have the same structure
! In all these subroutines X may be: I Integer
! S real(psb_spk_)
! D real(psb_dpk_)
! D complex(psb_spk_)
! C complex(psb_spk_)
! Z complex(psb_dpk_)
! Basically the operation is as follows: on each process, we identify
@ -70,10 +70,10 @@
!
!
! n - integer Number of columns in Y
! beta - complex Choose overwrite or sum.
! y(:,:) - complex The data area
! beta - real Choose overwrite or sum.
! y(:,:) - real The data area
! 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.
! info - integer. return code.
! data - integer which list is to be used to exchange data
@ -97,13 +97,14 @@ contains
include 'mpif.h'
#endif
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
complex(psb_spk_) :: y(:,:), beta
complex(psb_spk_), target :: work(:)
type(psb_desc_type),target :: desc_a
integer(psb_ipk_), optional :: data
integer(psb_ipk_), intent(in) :: flag
integer(psb_mpk_), intent(in) :: n
complex(psb_spk_), intent(in) :: beta
complex(psb_spk_), intent(inout) :: y(:,:)
type(psb_desc_type),target :: desc_a
complex(psb_spk_), target :: work(:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional :: data
! locals
type(psb_ctxt_type) :: ctxt
@ -165,12 +166,13 @@ complex(psb_spk_), target :: work(:)
#endif
type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(out) :: info
complex(psb_spk_) :: y(:,:), beta
complex(psb_spk_), target :: work(:)
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv
complex(psb_spk_), intent(in) :: beta
complex(psb_spk_), intent(inout) :: y(:,:)
complex(psb_spk_), target :: work(:)
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv
! locals
@ -293,8 +295,8 @@ complex(psb_spk_), pointer, dimension(:) :: sndbuf, rcvbuf
! swap elements using mpi_alltoallv
call mpi_alltoallv(sndbuf,sdsz,bsdidx,&
& psb_mpi_c_spk_,rcvbuf,rvsz,&
& brvidx,psb_mpi_c_spk_,icomm,iret)
& psb_mpi_r_spk_,rcvbuf,rvsz,&
& brvidx,psb_mpi_r_spk_,icomm,iret)
if(iret /= mpi_success) then
info=psb_err_mpi_error_
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_)
prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm)
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,&
& psb_mpi_c_spk_,prcid(i),&
& psb_mpi_r_spk_,prcid(i),&
& p2ptag, icomm,rvhd(i),iret)
end if
rcv_pt = rcv_pt + n*nerv
@ -370,15 +372,15 @@ complex(psb_spk_), pointer, dimension(:) :: sndbuf, rcvbuf
nerv = idx(pnti+psb_n_elem_recv_)
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 (usersend) then
call mpi_rsend(sndbuf(snd_pt),n*nesd,&
& psb_mpi_c_spk_,prcid(i),&
& psb_mpi_r_spk_,prcid(i),&
& p2ptag,icomm,iret)
else
call mpi_send(sndbuf(snd_pt),n*nesd,&
& psb_mpi_c_spk_,prcid(i),&
& psb_mpi_r_spk_,prcid(i),&
& p2ptag,icomm,iret)
end if
@ -401,7 +403,7 @@ complex(psb_spk_), pointer, dimension(:) :: sndbuf, rcvbuf
nerv = idx(pnti+psb_n_elem_recv_)
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
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
! In all these subroutines X may be: I Integer
! S real(psb_spk_)
! D real(psb_dpk_)
! D complex(psb_spk_)
! C complex(psb_spk_)
! Z complex(psb_dpk_)
! 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
! beta - complex Choose overwrite or sum.
! y(:) - complex The data area
! beta - real Choose overwrite or sum.
! y(:) - real The data area
! 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.
! info - integer. return code.
! data - integer which list is to be used to exchange data
@ -565,12 +567,13 @@ complex(psb_spk_), pointer, dimension(:) :: sndbuf, rcvbuf
include 'mpif.h'
#endif
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
complex(psb_spk_) :: y(:), beta
complex(psb_spk_), target :: work(:)
type(psb_desc_type),target :: desc_a
integer(psb_ipk_), optional :: data
integer(psb_ipk_), intent(in) :: flag
complex(psb_spk_), intent(in) :: beta
complex(psb_spk_), intent(inout) :: y(:)
type(psb_desc_type),target :: desc_a
complex(psb_spk_), target :: work(:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional :: data
! locals
type(psb_ctxt_type) :: ctxt
@ -648,7 +651,8 @@ complex(psb_spk_), pointer, dimension(:) :: sndbuf, rcvbuf
type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_ipk_), intent(in) :: flag
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(:)
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
call mpi_alltoallv(sndbuf,sdsz,bsdidx,&
& psb_mpi_c_spk_,rcvbuf,rvsz,&
& brvidx,psb_mpi_c_spk_,icomm,iret)
& psb_mpi_r_spk_,rcvbuf,rvsz,&
& brvidx,psb_mpi_r_spk_,icomm,iret)
if(iret /= mpi_success) then
info=psb_err_mpi_error_
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)
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,&
& psb_mpi_c_spk_,prcid(i),&
& psb_mpi_r_spk_,prcid(i),&
& p2ptag, icomm,rvhd(i),iret)
end if
rcv_pt = rcv_pt + nerv
@ -852,16 +856,16 @@ complex(psb_spk_), pointer, dimension(:) :: sndbuf, rcvbuf
nerv = idx(pnti+psb_n_elem_recv_)
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 (usersend) then
call mpi_rsend(sndbuf(snd_pt),nesd,&
& psb_mpi_c_spk_,prcid(i),&
& psb_mpi_r_spk_,prcid(i),&
& p2ptag,icomm,iret)
else
call mpi_send(sndbuf(snd_pt),nesd,&
& psb_mpi_c_spk_,prcid(i),&
& psb_mpi_r_spk_,prcid(i),&
& p2ptag,icomm,iret)
end if
@ -882,7 +886,7 @@ complex(psb_spk_), pointer, dimension(:) :: sndbuf, rcvbuf
proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_)
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
call mpi_wait(rvhd(i),p2pstat,iret)

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

File diff suppressed because it is too large Load Diff

86
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
! 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
! In all these subroutines X may be: I Integer
! S real(psb_spk_)
! D real(psb_dpk_)
! D complex(psb_spk_)
! C complex(psb_spk_)
! Z complex(psb_dpk_)
! Basically the operation is as follows: on each process, we identify
@ -74,10 +74,10 @@
!
!
! n - integer Number of columns in Y
! beta - complex Choose overwrite or sum.
! y(:,:) - complex The data area
! beta - real Choose overwrite or sum.
! y(:,:) - real The data area
! 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.
! info - integer. return code.
! data - integer which list is to be used to exchange data
@ -101,13 +101,14 @@ contains
include 'mpif.h'
#endif
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
complex(psb_spk_) :: y(:,:), beta
complex(psb_spk_), target :: work(:)
type(psb_desc_type),target :: desc_a
integer(psb_ipk_), optional :: data
integer(psb_ipk_), intent(in) :: flag
integer(psb_mpk_), intent(in) :: n
complex(psb_spk_), intent(in) :: beta
complex(psb_spk_), intent(inout) :: y(:,:)
type(psb_desc_type),target :: desc_a
complex(psb_spk_), target :: work(:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional :: data
! locals
type(psb_ctxt_type) :: ctxt
@ -149,7 +150,7 @@ contains
goto 9999
end if
call psi_swaptran(ctxt,flag,n,beta,y,d_idx,totxch,idxs,idxr,work,info)
call psi_swaptran(ctxt,flag,n,beta,y,d_idx,totxch,idxs,idxr,work,info)
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)
@ -174,7 +175,8 @@ contains
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag
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(:)
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv
@ -305,8 +307,8 @@ contains
! swap elements using mpi_alltoallv
call mpi_alltoallv(rcvbuf,rvsz,brvidx,&
& psb_mpi_c_spk_,&
& sndbuf,sdsz,bsdidx,psb_mpi_c_spk_,icomm,iret)
& psb_mpi_r_spk_,&
& sndbuf,sdsz,bsdidx,psb_mpi_r_spk_,icomm,iret)
if(iret /= mpi_success) then
info=psb_err_mpi_error_
call psb_errpush(info,name,m_err=(/iret/))
@ -360,9 +362,9 @@ contains
nesd = idx(pnti+nerv+psb_n_elem_send_)
prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm)
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,&
& psb_mpi_c_spk_,prcid(i),&
& psb_mpi_r_spk_,prcid(i),&
& p2ptag,icomm,rvhd(i),iret)
end if
rcv_pt = rcv_pt + n*nerv
@ -383,14 +385,14 @@ contains
nesd = idx(pnti+nerv+psb_n_elem_send_)
if ((nerv>0).and.(proc_to_comm /= me)) then
p2ptag = psb_complex_swap_tag
p2ptag = psb_double_swap_tag
if (usersend) then
call mpi_rsend(rcvbuf(rcv_pt),n*nerv,&
& psb_mpi_c_spk_,prcid(i),&
& psb_mpi_r_spk_,prcid(i),&
& p2ptag,icomm,iret)
else
call mpi_send(rcvbuf(rcv_pt),n*nerv,&
& psb_mpi_c_spk_,prcid(i),&
& psb_mpi_r_spk_,prcid(i),&
& p2ptag,icomm,iret)
end if
@ -413,7 +415,7 @@ contains
nerv = idx(pnti+psb_n_elem_recv_)
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
call mpi_wait(rvhd(i),p2pstat,iret)
@ -525,7 +527,7 @@ contains
! application environment. All the variants have the same structure
! In all these subroutines X may be: I Integer
! S real(psb_spk_)
! D real(psb_dpk_)
! D complex(psb_spk_)
! C complex(psb_spk_)
! Z complex(psb_dpk_)
! Basically the operation is as follows: on each process, we identify
@ -556,10 +558,10 @@ contains
!
!
! n - integer Number of columns in Y
! beta - complex Choose overwrite or sum.
! y(:) - complex The data area
! beta - real Choose overwrite or sum.
! y(:) - real The data area
! 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.
! info - integer. return code.
! data - integer which list is to be used to exchange data
@ -579,12 +581,13 @@ contains
include 'mpif.h'
#endif
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
complex(psb_spk_) :: y(:), beta
complex(psb_spk_), target :: work(:)
type(psb_desc_type),target :: desc_a
integer(psb_ipk_), optional :: data
integer(psb_ipk_), intent(in) :: flag
complex(psb_spk_), intent(in) :: beta
complex(psb_spk_), intent(inout) :: y(:)
type(psb_desc_type),target :: desc_a
complex(psb_spk_), target :: work(:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional :: data
! locals
type(psb_ctxt_type) :: ctxt
@ -659,7 +662,8 @@ contains
type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_ipk_), intent(in) :: flag
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(:)
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv
@ -791,8 +795,8 @@ contains
! swap elements using mpi_alltoallv
call mpi_alltoallv(rcvbuf,rvsz,brvidx,&
& psb_mpi_c_spk_,&
& sndbuf,sdsz,bsdidx,psb_mpi_c_spk_,icomm,iret)
& psb_mpi_r_spk_,&
& sndbuf,sdsz,bsdidx,psb_mpi_r_spk_,icomm,iret)
if(iret /= mpi_success) then
info=psb_err_mpi_error_
call psb_errpush(info,name,m_err=(/iret/))
@ -845,9 +849,9 @@ contains
nesd = idx(pnti+nerv+psb_n_elem_send_)
prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm)
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,&
& psb_mpi_c_spk_,prcid(i),&
& psb_mpi_r_spk_,prcid(i),&
& p2ptag,icomm,rvhd(i),iret)
end if
rcv_pt = rcv_pt + nerv
@ -868,14 +872,14 @@ contains
nesd = idx(pnti+nerv+psb_n_elem_send_)
if ((nerv>0).and.(proc_to_comm /= me)) then
p2ptag = psb_complex_swap_tag
p2ptag = psb_double_swap_tag
if (usersend) then
call mpi_rsend(rcvbuf(rcv_pt),nerv,&
& psb_mpi_c_spk_,prcid(i),&
& psb_mpi_r_spk_,prcid(i),&
& p2ptag, icomm,iret)
else
call mpi_send(rcvbuf(rcv_pt),nerv,&
& psb_mpi_c_spk_,prcid(i),&
& psb_mpi_r_spk_,prcid(i),&
& p2ptag, icomm,iret)
end if
@ -896,7 +900,7 @@ contains
proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_)
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
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.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``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.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``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.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``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.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``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.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``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.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED

815
base/comm/internals/psi_dswapdata.F90
View File

File diff suppressed because it is too large Load Diff

1459
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.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``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.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``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.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED

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

@ -39,7 +39,7 @@
! application environment. All the variants have the same structure
! In all these subroutines X may be: I Integer
! S real(psb_spk_)
! D real(psb_dpk_)
! D integer(psb_epk_)
! C complex(psb_spk_)
! Z complex(psb_dpk_)
! Basically the operation is as follows: on each process, we identify
@ -70,10 +70,10 @@
!
!
! n - integer Number of columns in Y
! beta - integer Choose overwrite or sum.
! y(:,:) - integer The data area
! beta - real Choose overwrite or sum.
! y(:,:) - real The data area
! 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.
! info - integer. return code.
! data - integer which list is to be used to exchange data
@ -97,13 +97,14 @@ contains
include 'mpif.h'
#endif
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
integer(psb_epk_) :: y(:,:), beta
integer(psb_epk_), target :: work(:)
type(psb_desc_type),target :: desc_a
integer(psb_ipk_), optional :: data
integer(psb_ipk_), intent(in) :: flag
integer(psb_mpk_), intent(in) :: n
integer(psb_epk_), intent(in) :: beta
integer(psb_epk_), intent(inout) :: y(:,:)
type(psb_desc_type),target :: desc_a
integer(psb_epk_), target :: work(:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional :: data
! locals
type(psb_ctxt_type) :: ctxt
@ -165,12 +166,13 @@ integer(psb_epk_), target :: work(:)
#endif
type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(out) :: info
integer(psb_epk_) :: y(:,:), beta
integer(psb_epk_), target :: work(:)
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv
integer(psb_epk_), intent(in) :: beta
integer(psb_epk_), intent(inout) :: y(:,:)
integer(psb_epk_), target :: work(:)
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv
! locals
@ -348,7 +350,7 @@ integer(psb_epk_), pointer, dimension(:) :: sndbuf, rcvbuf
nesd = idx(pnti+nerv+psb_n_elem_send_)
prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm)
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,&
& psb_mpi_epk_,prcid(i),&
& p2ptag, icomm,rvhd(i),iret)
@ -370,7 +372,7 @@ integer(psb_epk_), pointer, dimension(:) :: sndbuf, rcvbuf
nerv = idx(pnti+psb_n_elem_recv_)
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 (usersend) then
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_)
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
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
! In all these subroutines X may be: I Integer
! S real(psb_spk_)
! D real(psb_dpk_)
! D integer(psb_epk_)
! C complex(psb_spk_)
! Z complex(psb_dpk_)
! 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
! beta - integer Choose overwrite or sum.
! y(:) - integer The data area
! beta - real Choose overwrite or sum.
! y(:) - real The data area
! 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.
! info - integer. return code.
! data - integer which list is to be used to exchange data
@ -565,12 +567,13 @@ integer(psb_epk_), pointer, dimension(:) :: sndbuf, rcvbuf
include 'mpif.h'
#endif
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
integer(psb_epk_) :: y(:), beta
integer(psb_epk_), target :: work(:)
type(psb_desc_type),target :: desc_a
integer(psb_ipk_), optional :: data
integer(psb_ipk_), intent(in) :: flag
integer(psb_epk_), intent(in) :: beta
integer(psb_epk_), intent(inout) :: y(:)
type(psb_desc_type),target :: desc_a
integer(psb_epk_), target :: work(:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional :: data
! locals
type(psb_ctxt_type) :: ctxt
@ -648,7 +651,8 @@ integer(psb_epk_), pointer, dimension(:) :: sndbuf, rcvbuf
type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_ipk_), intent(in) :: flag
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_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)
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,&
& psb_mpi_epk_,prcid(i),&
& p2ptag, icomm,rvhd(i),iret)
@ -852,7 +856,7 @@ integer(psb_epk_), pointer, dimension(:) :: sndbuf, rcvbuf
nerv = idx(pnti+psb_n_elem_recv_)
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 (usersend) then
@ -882,7 +886,7 @@ integer(psb_epk_), pointer, dimension(:) :: sndbuf, rcvbuf
proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_)
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
call mpi_wait(rvhd(i),p2pstat,iret)

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

@ -43,7 +43,7 @@
! application environment. All the variants have the same structure
! In all these subroutines X may be: I Integer
! S real(psb_spk_)
! D real(psb_dpk_)
! D integer(psb_epk_)
! C complex(psb_spk_)
! Z complex(psb_dpk_)
! Basically the operation is as follows: on each process, we identify
@ -74,10 +74,10 @@
!
!
! n - integer Number of columns in Y
! beta - integer Choose overwrite or sum.
! y(:,:) - integer The data area
! beta - real Choose overwrite or sum.
! y(:,:) - real The data area
! 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.
! info - integer. return code.
! data - integer which list is to be used to exchange data
@ -101,13 +101,14 @@ contains
include 'mpif.h'
#endif
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
integer(psb_epk_) :: y(:,:), beta
integer(psb_epk_), target :: work(:)
type(psb_desc_type),target :: desc_a
integer(psb_ipk_), optional :: data
integer(psb_ipk_), intent(in) :: flag
integer(psb_mpk_), intent(in) :: n
integer(psb_epk_), intent(in) :: beta
integer(psb_epk_), intent(inout) :: y(:,:)
type(psb_desc_type),target :: desc_a
integer(psb_epk_), target :: work(:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional :: data
! locals
type(psb_ctxt_type) :: ctxt
@ -149,7 +150,7 @@ contains
goto 9999
end if
call psi_swaptran(ctxt,flag,n,beta,y,d_idx,totxch,idxs,idxr,work,info)
call psi_swaptran(ctxt,flag,n,beta,y,d_idx,totxch,idxs,idxr,work,info)
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)
@ -174,7 +175,8 @@ contains
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag
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_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv
@ -360,7 +362,7 @@ contains
nesd = idx(pnti+nerv+psb_n_elem_send_)
prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm)
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,&
& psb_mpi_epk_,prcid(i),&
& p2ptag,icomm,rvhd(i),iret)
@ -383,7 +385,7 @@ contains
nesd = idx(pnti+nerv+psb_n_elem_send_)
if ((nerv>0).and.(proc_to_comm /= me)) then
p2ptag = psb_int8_swap_tag
p2ptag = psb_double_swap_tag
if (usersend) then
call mpi_rsend(rcvbuf(rcv_pt),n*nerv,&
& psb_mpi_epk_,prcid(i),&
@ -413,7 +415,7 @@ contains
nerv = idx(pnti+psb_n_elem_recv_)
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
call mpi_wait(rvhd(i),p2pstat,iret)
@ -525,7 +527,7 @@ contains
! application environment. All the variants have the same structure
! In all these subroutines X may be: I Integer
! S real(psb_spk_)
! D real(psb_dpk_)
! D integer(psb_epk_)
! C complex(psb_spk_)
! Z complex(psb_dpk_)
! Basically the operation is as follows: on each process, we identify
@ -556,10 +558,10 @@ contains
!
!
! n - integer Number of columns in Y
! beta - integer Choose overwrite or sum.
! y(:) - integer The data area
! beta - real Choose overwrite or sum.
! y(:) - real The data area
! 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.
! info - integer. return code.
! data - integer which list is to be used to exchange data
@ -579,12 +581,13 @@ contains
include 'mpif.h'
#endif
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
integer(psb_epk_) :: y(:), beta
integer(psb_epk_), target :: work(:)
type(psb_desc_type),target :: desc_a
integer(psb_ipk_), optional :: data
integer(psb_ipk_), intent(in) :: flag
integer(psb_epk_), intent(in) :: beta
integer(psb_epk_), intent(inout) :: y(:)
type(psb_desc_type),target :: desc_a
integer(psb_epk_), target :: work(:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional :: data
! locals
type(psb_ctxt_type) :: ctxt
@ -659,7 +662,8 @@ contains
type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_ipk_), intent(in) :: flag
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_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv
@ -845,7 +849,7 @@ contains
nesd = idx(pnti+nerv+psb_n_elem_send_)
prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm)
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,&
& psb_mpi_epk_,prcid(i),&
& p2ptag,icomm,rvhd(i),iret)
@ -868,7 +872,7 @@ contains
nesd = idx(pnti+nerv+psb_n_elem_send_)
if ((nerv>0).and.(proc_to_comm /= me)) then
p2ptag = psb_int8_swap_tag
p2ptag = psb_double_swap_tag
if (usersend) then
call mpi_rsend(rcvbuf(rcv_pt),nerv,&
& psb_mpi_epk_,prcid(i),&
@ -896,7 +900,7 @@ contains
proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_)
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
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.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``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.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``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.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED

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

@ -39,7 +39,7 @@
! application environment. All the variants have the same structure
! In all these subroutines X may be: I Integer
! S real(psb_spk_)
! D real(psb_dpk_)
! D integer(psb_i2pk_)
! C complex(psb_spk_)
! Z complex(psb_dpk_)
! Basically the operation is as follows: on each process, we identify
@ -70,10 +70,10 @@
!
!
! n - integer Number of columns in Y
! beta - integer Choose overwrite or sum.
! y(:,:) - integer The data area
! beta - real Choose overwrite or sum.
! y(:,:) - real The data area
! 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.
! info - integer. return code.
! data - integer which list is to be used to exchange data
@ -97,13 +97,14 @@ contains
include 'mpif.h'
#endif
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
integer(psb_i2pk_) :: y(:,:), beta
integer(psb_i2pk_), target :: work(:)
type(psb_desc_type),target :: desc_a
integer(psb_ipk_), optional :: data
integer(psb_ipk_), intent(in) :: flag
integer(psb_mpk_), intent(in) :: n
integer(psb_i2pk_), intent(in) :: beta
integer(psb_i2pk_), intent(inout) :: y(:,:)
type(psb_desc_type),target :: desc_a
integer(psb_i2pk_), target :: work(:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional :: data
! locals
type(psb_ctxt_type) :: ctxt
@ -165,12 +166,13 @@ integer(psb_i2pk_), target :: work(:)
#endif
type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(out) :: info
integer(psb_i2pk_) :: y(:,:), beta
integer(psb_i2pk_), target :: work(:)
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv
integer(psb_i2pk_), intent(in) :: beta
integer(psb_i2pk_), intent(inout) :: y(:,:)
integer(psb_i2pk_), target :: work(:)
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv
! locals
@ -348,7 +350,7 @@ integer(psb_i2pk_), pointer, dimension(:) :: sndbuf, rcvbuf
nesd = idx(pnti+nerv+psb_n_elem_send_)
prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm)
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,&
& psb_mpi_i2pk_,prcid(i),&
& p2ptag, icomm,rvhd(i),iret)
@ -370,7 +372,7 @@ integer(psb_i2pk_), pointer, dimension(:) :: sndbuf, rcvbuf
nerv = idx(pnti+psb_n_elem_recv_)
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 (usersend) then
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_)
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
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
! In all these subroutines X may be: I Integer
! S real(psb_spk_)
! D real(psb_dpk_)
! D integer(psb_i2pk_)
! C complex(psb_spk_)
! Z complex(psb_dpk_)
! 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
! beta - integer Choose overwrite or sum.
! y(:) - integer The data area
! beta - real Choose overwrite or sum.
! y(:) - real The data area
! 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.
! info - integer. return code.
! data - integer which list is to be used to exchange data
@ -565,12 +567,13 @@ integer(psb_i2pk_), pointer, dimension(:) :: sndbuf, rcvbuf
include 'mpif.h'
#endif
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
integer(psb_i2pk_) :: y(:), beta
integer(psb_i2pk_), target :: work(:)
type(psb_desc_type),target :: desc_a
integer(psb_ipk_), optional :: data
integer(psb_ipk_), intent(in) :: flag
integer(psb_i2pk_), intent(in) :: beta
integer(psb_i2pk_), intent(inout) :: y(:)
type(psb_desc_type),target :: desc_a
integer(psb_i2pk_), target :: work(:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional :: data
! locals
type(psb_ctxt_type) :: ctxt
@ -648,7 +651,8 @@ integer(psb_i2pk_), pointer, dimension(:) :: sndbuf, rcvbuf
type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_ipk_), intent(in) :: flag
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_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)
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,&
& psb_mpi_i2pk_,prcid(i),&
& p2ptag, icomm,rvhd(i),iret)
@ -852,7 +856,7 @@ integer(psb_i2pk_), pointer, dimension(:) :: sndbuf, rcvbuf
nerv = idx(pnti+psb_n_elem_recv_)
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 (usersend) then
@ -882,7 +886,7 @@ integer(psb_i2pk_), pointer, dimension(:) :: sndbuf, rcvbuf
proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_)
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
call mpi_wait(rvhd(i),p2pstat,iret)

66
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
! 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
! In all these subroutines X may be: I Integer
! S real(psb_spk_)
! D real(psb_dpk_)
! D integer(psb_i2pk_)
! C complex(psb_spk_)
! Z complex(psb_dpk_)
! Basically the operation is as follows: on each process, we identify
@ -74,10 +74,10 @@
!
!
! n - integer Number of columns in Y
! beta - integer Choose overwrite or sum.
! y(:,:) - integer The data area
! beta - real Choose overwrite or sum.
! y(:,:) - real The data area
! 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.
! info - integer. return code.
! data - integer which list is to be used to exchange data
@ -101,13 +101,14 @@ contains
include 'mpif.h'
#endif
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
integer(psb_i2pk_) :: y(:,:), beta
integer(psb_i2pk_), target :: work(:)
type(psb_desc_type),target :: desc_a
integer(psb_ipk_), optional :: data
integer(psb_ipk_), intent(in) :: flag
integer(psb_mpk_), intent(in) :: n
integer(psb_i2pk_), intent(in) :: beta
integer(psb_i2pk_), intent(inout) :: y(:,:)
type(psb_desc_type),target :: desc_a
integer(psb_i2pk_), target :: work(:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional :: data
! locals
type(psb_ctxt_type) :: ctxt
@ -149,7 +150,7 @@ contains
goto 9999
end if
call psi_swaptran(ctxt,flag,n,beta,y,d_idx,totxch,idxs,idxr,work,info)
call psi_swaptran(ctxt,flag,n,beta,y,d_idx,totxch,idxs,idxr,work,info)
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)
@ -174,7 +175,8 @@ contains
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag
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_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv
@ -360,7 +362,7 @@ contains
nesd = idx(pnti+nerv+psb_n_elem_send_)
prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm)
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,&
& psb_mpi_i2pk_,prcid(i),&
& p2ptag,icomm,rvhd(i),iret)
@ -383,7 +385,7 @@ contains
nesd = idx(pnti+nerv+psb_n_elem_send_)
if ((nerv>0).and.(proc_to_comm /= me)) then
p2ptag = psb_int2_swap_tag
p2ptag = psb_double_swap_tag
if (usersend) then
call mpi_rsend(rcvbuf(rcv_pt),n*nerv,&
& psb_mpi_i2pk_,prcid(i),&
@ -413,7 +415,7 @@ contains
nerv = idx(pnti+psb_n_elem_recv_)
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
call mpi_wait(rvhd(i),p2pstat,iret)
@ -525,7 +527,7 @@ contains
! application environment. All the variants have the same structure
! In all these subroutines X may be: I Integer
! S real(psb_spk_)
! D real(psb_dpk_)
! D integer(psb_i2pk_)
! C complex(psb_spk_)
! Z complex(psb_dpk_)
! Basically the operation is as follows: on each process, we identify
@ -556,10 +558,10 @@ contains
!
!
! n - integer Number of columns in Y
! beta - integer Choose overwrite or sum.
! y(:) - integer The data area
! beta - real Choose overwrite or sum.
! y(:) - real The data area
! 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.
! info - integer. return code.
! data - integer which list is to be used to exchange data
@ -579,12 +581,13 @@ contains
include 'mpif.h'
#endif
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
integer(psb_i2pk_) :: y(:), beta
integer(psb_i2pk_), target :: work(:)
type(psb_desc_type),target :: desc_a
integer(psb_ipk_), optional :: data
integer(psb_ipk_), intent(in) :: flag
integer(psb_i2pk_), intent(in) :: beta
integer(psb_i2pk_), intent(inout) :: y(:)
type(psb_desc_type),target :: desc_a
integer(psb_i2pk_), target :: work(:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional :: data
! locals
type(psb_ctxt_type) :: ctxt
@ -659,7 +662,8 @@ contains
type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_ipk_), intent(in) :: flag
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_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv
@ -845,7 +849,7 @@ contains
nesd = idx(pnti+nerv+psb_n_elem_send_)
prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm)
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,&
& psb_mpi_i2pk_,prcid(i),&
& p2ptag,icomm,rvhd(i),iret)
@ -868,7 +872,7 @@ contains
nesd = idx(pnti+nerv+psb_n_elem_send_)
if ((nerv>0).and.(proc_to_comm /= me)) then
p2ptag = psb_int2_swap_tag
p2ptag = psb_double_swap_tag
if (usersend) then
call mpi_rsend(rcvbuf(rcv_pt),nerv,&
& psb_mpi_i2pk_,prcid(i),&
@ -896,7 +900,7 @@ contains
proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_)
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
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.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``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.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``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.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED

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

File diff suppressed because it is too large Load Diff

2052
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.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``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.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``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.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED

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

File diff suppressed because it is too large Load Diff

2141
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.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``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.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``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.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED

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

@ -39,7 +39,7 @@
! application environment. All the variants have the same structure
! In all these subroutines X may be: I Integer
! S real(psb_spk_)
! D real(psb_dpk_)
! D integer(psb_mpk_)
! C complex(psb_spk_)
! Z complex(psb_dpk_)
! Basically the operation is as follows: on each process, we identify
@ -70,10 +70,10 @@
!
!
! n - integer Number of columns in Y
! beta - integer Choose overwrite or sum.
! y(:,:) - integer The data area
! beta - real Choose overwrite or sum.
! y(:,:) - real The data area
! 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.
! info - integer. return code.
! data - integer which list is to be used to exchange data
@ -97,13 +97,14 @@ contains
include 'mpif.h'
#endif
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
integer(psb_mpk_) :: y(:,:), beta
integer(psb_mpk_), target :: work(:)
type(psb_desc_type),target :: desc_a
integer(psb_ipk_), optional :: data
integer(psb_ipk_), intent(in) :: flag
integer(psb_mpk_), intent(in) :: n
integer(psb_mpk_), intent(in) :: beta
integer(psb_mpk_), intent(inout) :: y(:,:)
type(psb_desc_type),target :: desc_a
integer(psb_mpk_), target :: work(:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional :: data
! locals
type(psb_ctxt_type) :: ctxt
@ -165,12 +166,13 @@ integer(psb_mpk_), target :: work(:)
#endif
type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(out) :: info
integer(psb_mpk_) :: y(:,:), beta
integer(psb_mpk_), target :: work(:)
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv
integer(psb_mpk_), intent(in) :: beta
integer(psb_mpk_), intent(inout) :: y(:,:)
integer(psb_mpk_), target :: work(:)
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv
! locals
@ -348,7 +350,7 @@ integer(psb_mpk_), pointer, dimension(:) :: sndbuf, rcvbuf
nesd = idx(pnti+nerv+psb_n_elem_send_)
prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm)
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,&
& psb_mpi_mpk_,prcid(i),&
& p2ptag, icomm,rvhd(i),iret)
@ -370,7 +372,7 @@ integer(psb_mpk_), pointer, dimension(:) :: sndbuf, rcvbuf
nerv = idx(pnti+psb_n_elem_recv_)
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 (usersend) then
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_)
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
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
! In all these subroutines X may be: I Integer
! S real(psb_spk_)
! D real(psb_dpk_)
! D integer(psb_mpk_)
! C complex(psb_spk_)
! Z complex(psb_dpk_)
! 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
! beta - integer Choose overwrite or sum.
! y(:) - integer The data area
! beta - real Choose overwrite or sum.
! y(:) - real The data area
! 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.
! info - integer. return code.
! data - integer which list is to be used to exchange data
@ -565,12 +567,13 @@ integer(psb_mpk_), pointer, dimension(:) :: sndbuf, rcvbuf
include 'mpif.h'
#endif
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
integer(psb_mpk_) :: y(:), beta
integer(psb_mpk_), target :: work(:)
type(psb_desc_type),target :: desc_a
integer(psb_ipk_), optional :: data
integer(psb_ipk_), intent(in) :: flag
integer(psb_mpk_), intent(in) :: beta
integer(psb_mpk_), intent(inout) :: y(:)
type(psb_desc_type),target :: desc_a
integer(psb_mpk_), target :: work(:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional :: data
! locals
type(psb_ctxt_type) :: ctxt
@ -648,7 +651,8 @@ integer(psb_mpk_), pointer, dimension(:) :: sndbuf, rcvbuf
type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_ipk_), intent(in) :: flag
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_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)
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,&
& psb_mpi_mpk_,prcid(i),&
& p2ptag, icomm,rvhd(i),iret)
@ -852,7 +856,7 @@ integer(psb_mpk_), pointer, dimension(:) :: sndbuf, rcvbuf
nerv = idx(pnti+psb_n_elem_recv_)
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 (usersend) then
@ -882,7 +886,7 @@ integer(psb_mpk_), pointer, dimension(:) :: sndbuf, rcvbuf
proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_)
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
call mpi_wait(rvhd(i),p2pstat,iret)

66
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
! 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
! In all these subroutines X may be: I Integer
! S real(psb_spk_)
! D real(psb_dpk_)
! D integer(psb_mpk_)
! C complex(psb_spk_)
! Z complex(psb_dpk_)
! Basically the operation is as follows: on each process, we identify
@ -74,10 +74,10 @@
!
!
! n - integer Number of columns in Y
! beta - integer Choose overwrite or sum.
! y(:,:) - integer The data area
! beta - real Choose overwrite or sum.
! y(:,:) - real The data area
! 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.
! info - integer. return code.
! data - integer which list is to be used to exchange data
@ -101,13 +101,14 @@ contains
include 'mpif.h'
#endif
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
integer(psb_mpk_) :: y(:,:), beta
integer(psb_mpk_), target :: work(:)
type(psb_desc_type),target :: desc_a
integer(psb_ipk_), optional :: data
integer(psb_ipk_), intent(in) :: flag
integer(psb_mpk_), intent(in) :: n
integer(psb_mpk_), intent(in) :: beta
integer(psb_mpk_), intent(inout) :: y(:,:)
type(psb_desc_type),target :: desc_a
integer(psb_mpk_), target :: work(:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional :: data
! locals
type(psb_ctxt_type) :: ctxt
@ -149,7 +150,7 @@ contains
goto 9999
end if
call psi_swaptran(ctxt,flag,n,beta,y,d_idx,totxch,idxs,idxr,work,info)
call psi_swaptran(ctxt,flag,n,beta,y,d_idx,totxch,idxs,idxr,work,info)
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)
@ -174,7 +175,8 @@ contains
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag
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_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv
@ -360,7 +362,7 @@ contains
nesd = idx(pnti+nerv+psb_n_elem_send_)
prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm)
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,&
& psb_mpi_mpk_,prcid(i),&
& p2ptag,icomm,rvhd(i),iret)
@ -383,7 +385,7 @@ contains
nesd = idx(pnti+nerv+psb_n_elem_send_)
if ((nerv>0).and.(proc_to_comm /= me)) then
p2ptag = psb_int4_swap_tag
p2ptag = psb_double_swap_tag
if (usersend) then
call mpi_rsend(rcvbuf(rcv_pt),n*nerv,&
& psb_mpi_mpk_,prcid(i),&
@ -413,7 +415,7 @@ contains
nerv = idx(pnti+psb_n_elem_recv_)
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
call mpi_wait(rvhd(i),p2pstat,iret)
@ -525,7 +527,7 @@ contains
! application environment. All the variants have the same structure
! In all these subroutines X may be: I Integer
! S real(psb_spk_)
! D real(psb_dpk_)
! D integer(psb_mpk_)
! C complex(psb_spk_)
! Z complex(psb_dpk_)
! Basically the operation is as follows: on each process, we identify
@ -556,10 +558,10 @@ contains
!
!
! n - integer Number of columns in Y
! beta - integer Choose overwrite or sum.
! y(:) - integer The data area
! beta - real Choose overwrite or sum.
! y(:) - real The data area
! 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.
! info - integer. return code.
! data - integer which list is to be used to exchange data
@ -579,12 +581,13 @@ contains
include 'mpif.h'
#endif
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
integer(psb_mpk_) :: y(:), beta
integer(psb_mpk_), target :: work(:)
type(psb_desc_type),target :: desc_a
integer(psb_ipk_), optional :: data
integer(psb_ipk_), intent(in) :: flag
integer(psb_mpk_), intent(in) :: beta
integer(psb_mpk_), intent(inout) :: y(:)
type(psb_desc_type),target :: desc_a
integer(psb_mpk_), target :: work(:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional :: data
! locals
type(psb_ctxt_type) :: ctxt
@ -659,7 +662,8 @@ contains
type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_ipk_), intent(in) :: flag
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_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv
@ -845,7 +849,7 @@ contains
nesd = idx(pnti+nerv+psb_n_elem_send_)
prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm)
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,&
& psb_mpi_mpk_,prcid(i),&
& p2ptag,icomm,rvhd(i),iret)
@ -868,7 +872,7 @@ contains
nesd = idx(pnti+nerv+psb_n_elem_send_)
if ((nerv>0).and.(proc_to_comm /= me)) then
p2ptag = psb_int4_swap_tag
p2ptag = psb_double_swap_tag
if (usersend) then
call mpi_rsend(rcvbuf(rcv_pt),nerv,&
& psb_mpi_mpk_,prcid(i),&
@ -896,7 +900,7 @@ contains
proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_)
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
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.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``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.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``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.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``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.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``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.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``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.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED

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

File diff suppressed because it is too large Load Diff

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

@ -39,7 +39,7 @@
! application environment. All the variants have the same structure
! In all these subroutines X may be: I Integer
! S real(psb_spk_)
! D real(psb_dpk_)
! D real(psb_spk_)
! C complex(psb_spk_)
! Z complex(psb_dpk_)
! Basically the operation is as follows: on each process, we identify
@ -97,13 +97,14 @@ contains
include 'mpif.h'
#endif
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
real(psb_spk_) :: y(:,:), beta
real(psb_spk_), target :: work(:)
type(psb_desc_type),target :: desc_a
integer(psb_ipk_), optional :: data
integer(psb_ipk_), intent(in) :: flag
integer(psb_mpk_), intent(in) :: n
real(psb_spk_), intent(in) :: beta
real(psb_spk_), intent(inout) :: y(:,:)
type(psb_desc_type),target :: desc_a
real(psb_spk_), target :: work(:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional :: data
! locals
type(psb_ctxt_type) :: ctxt
@ -165,12 +166,13 @@ real(psb_spk_), target :: work(:)
#endif
type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(out) :: info
real(psb_spk_) :: y(:,:), beta
real(psb_spk_), target :: work(:)
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv
real(psb_spk_), intent(in) :: beta
real(psb_spk_), intent(inout) :: y(:,:)
real(psb_spk_), target :: work(:)
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv
! locals
@ -348,7 +350,7 @@ real(psb_spk_), pointer, dimension(:) :: sndbuf, rcvbuf
nesd = idx(pnti+nerv+psb_n_elem_send_)
prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm)
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,&
& psb_mpi_r_spk_,prcid(i),&
& p2ptag, icomm,rvhd(i),iret)
@ -370,7 +372,7 @@ real(psb_spk_), pointer, dimension(:) :: sndbuf, rcvbuf
nerv = idx(pnti+psb_n_elem_recv_)
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 (usersend) then
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_)
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
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
! In all these subroutines X may be: I Integer
! S real(psb_spk_)
! D real(psb_dpk_)
! D real(psb_spk_)
! C complex(psb_spk_)
! Z complex(psb_dpk_)
! Basically the operation is as follows: on each process, we identify
@ -565,12 +567,13 @@ real(psb_spk_), pointer, dimension(:) :: sndbuf, rcvbuf
include 'mpif.h'
#endif
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
real(psb_spk_) :: y(:), beta
real(psb_spk_), target :: work(:)
type(psb_desc_type),target :: desc_a
integer(psb_ipk_), optional :: data
integer(psb_ipk_), intent(in) :: flag
real(psb_spk_), intent(in) :: beta
real(psb_spk_), intent(inout) :: y(:)
type(psb_desc_type),target :: desc_a
real(psb_spk_), target :: work(:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional :: data
! locals
type(psb_ctxt_type) :: ctxt
@ -648,7 +651,8 @@ real(psb_spk_), pointer, dimension(:) :: sndbuf, rcvbuf
type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_ipk_), intent(in) :: flag
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(:)
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)
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,&
& psb_mpi_r_spk_,prcid(i),&
& p2ptag, icomm,rvhd(i),iret)
@ -852,7 +856,7 @@ real(psb_spk_), pointer, dimension(:) :: sndbuf, rcvbuf
nerv = idx(pnti+psb_n_elem_recv_)
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 (usersend) then
@ -882,7 +886,7 @@ real(psb_spk_), pointer, dimension(:) :: sndbuf, rcvbuf
proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_)
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
call mpi_wait(rvhd(i),p2pstat,iret)

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

File diff suppressed because it is too large Load Diff

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

@ -43,7 +43,7 @@
! application environment. All the variants have the same structure
! In all these subroutines X may be: I Integer
! S real(psb_spk_)
! D real(psb_dpk_)
! D real(psb_spk_)
! C complex(psb_spk_)
! Z complex(psb_dpk_)
! Basically the operation is as follows: on each process, we identify
@ -101,13 +101,14 @@ contains
include 'mpif.h'
#endif
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
real(psb_spk_) :: y(:,:), beta
real(psb_spk_), target :: work(:)
type(psb_desc_type),target :: desc_a
integer(psb_ipk_), optional :: data
integer(psb_ipk_), intent(in) :: flag
integer(psb_mpk_), intent(in) :: n
real(psb_spk_), intent(in) :: beta
real(psb_spk_), intent(inout) :: y(:,:)
type(psb_desc_type),target :: desc_a
real(psb_spk_), target :: work(:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional :: data
! locals
type(psb_ctxt_type) :: ctxt
@ -149,7 +150,7 @@ contains
goto 9999
end if
call psi_swaptran(ctxt,flag,n,beta,y,d_idx,totxch,idxs,idxr,work,info)
call psi_swaptran(ctxt,flag,n,beta,y,d_idx,totxch,idxs,idxr,work,info)
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)
@ -174,7 +175,8 @@ contains
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag
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(:)
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv
@ -360,7 +362,7 @@ contains
nesd = idx(pnti+nerv+psb_n_elem_send_)
prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm)
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,&
& psb_mpi_r_spk_,prcid(i),&
& p2ptag,icomm,rvhd(i),iret)
@ -383,7 +385,7 @@ contains
nesd = idx(pnti+nerv+psb_n_elem_send_)
if ((nerv>0).and.(proc_to_comm /= me)) then
p2ptag = psb_real_swap_tag
p2ptag = psb_double_swap_tag
if (usersend) then
call mpi_rsend(rcvbuf(rcv_pt),n*nerv,&
& psb_mpi_r_spk_,prcid(i),&
@ -413,7 +415,7 @@ contains
nerv = idx(pnti+psb_n_elem_recv_)
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
call mpi_wait(rvhd(i),p2pstat,iret)
@ -525,7 +527,7 @@ contains
! application environment. All the variants have the same structure
! In all these subroutines X may be: I Integer
! S real(psb_spk_)
! D real(psb_dpk_)
! D real(psb_spk_)
! C complex(psb_spk_)
! Z complex(psb_dpk_)
! Basically the operation is as follows: on each process, we identify
@ -579,12 +581,13 @@ contains
include 'mpif.h'
#endif
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
real(psb_spk_) :: y(:), beta
real(psb_spk_), target :: work(:)
type(psb_desc_type),target :: desc_a
integer(psb_ipk_), optional :: data
integer(psb_ipk_), intent(in) :: flag
real(psb_spk_), intent(in) :: beta
real(psb_spk_), intent(inout) :: y(:)
type(psb_desc_type),target :: desc_a
real(psb_spk_), target :: work(:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional :: data
! locals
type(psb_ctxt_type) :: ctxt
@ -659,7 +662,8 @@ contains
type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_ipk_), intent(in) :: flag
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(:)
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv
@ -845,7 +849,7 @@ contains
nesd = idx(pnti+nerv+psb_n_elem_send_)
prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm)
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,&
& psb_mpi_r_spk_,prcid(i),&
& p2ptag,icomm,rvhd(i),iret)
@ -868,7 +872,7 @@ contains
nesd = idx(pnti+nerv+psb_n_elem_send_)
if ((nerv>0).and.(proc_to_comm /= me)) then
p2ptag = psb_real_swap_tag
p2ptag = psb_double_swap_tag
if (usersend) then
call mpi_rsend(rcvbuf(rcv_pt),nerv,&
& psb_mpi_r_spk_,prcid(i),&
@ -896,7 +900,7 @@ contains
proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_)
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
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.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``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.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``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.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``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.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``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.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``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.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED

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

File diff suppressed because it is too large Load Diff

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

@ -39,7 +39,7 @@
! application environment. All the variants have the same structure
! In all these subroutines X may be: I Integer
! S real(psb_spk_)
! D real(psb_dpk_)
! D complex(psb_dpk_)
! C complex(psb_spk_)
! Z complex(psb_dpk_)
! Basically the operation is as follows: on each process, we identify
@ -70,10 +70,10 @@
!
!
! n - integer Number of columns in Y
! beta - complex Choose overwrite or sum.
! y(:,:) - complex The data area
! beta - real Choose overwrite or sum.
! y(:,:) - real The data area
! 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.
! info - integer. return code.
! data - integer which list is to be used to exchange data
@ -97,13 +97,14 @@ contains
include 'mpif.h'
#endif
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
complex(psb_dpk_) :: y(:,:), beta
complex(psb_dpk_), target :: work(:)
type(psb_desc_type),target :: desc_a
integer(psb_ipk_), optional :: data
integer(psb_ipk_), intent(in) :: flag
integer(psb_mpk_), intent(in) :: n
complex(psb_dpk_), intent(in) :: beta
complex(psb_dpk_), intent(inout) :: y(:,:)
type(psb_desc_type),target :: desc_a
complex(psb_dpk_), target :: work(:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional :: data
! locals
type(psb_ctxt_type) :: ctxt
@ -165,12 +166,13 @@ complex(psb_dpk_), target :: work(:)
#endif
type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(out) :: info
complex(psb_dpk_) :: y(:,:), beta
complex(psb_dpk_), target :: work(:)
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv
complex(psb_dpk_), intent(in) :: beta
complex(psb_dpk_), intent(inout) :: y(:,:)
complex(psb_dpk_), target :: work(:)
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv
! locals
@ -293,8 +295,8 @@ complex(psb_dpk_), pointer, dimension(:) :: sndbuf, rcvbuf
! swap elements using mpi_alltoallv
call mpi_alltoallv(sndbuf,sdsz,bsdidx,&
& psb_mpi_c_dpk_,rcvbuf,rvsz,&
& brvidx,psb_mpi_c_dpk_,icomm,iret)
& psb_mpi_r_dpk_,rcvbuf,rvsz,&
& brvidx,psb_mpi_r_dpk_,icomm,iret)
if(iret /= mpi_success) then
info=psb_err_mpi_error_
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_)
prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm)
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,&
& psb_mpi_c_dpk_,prcid(i),&
& psb_mpi_r_dpk_,prcid(i),&
& p2ptag, icomm,rvhd(i),iret)
end if
rcv_pt = rcv_pt + n*nerv
@ -370,15 +372,15 @@ complex(psb_dpk_), pointer, dimension(:) :: sndbuf, rcvbuf
nerv = idx(pnti+psb_n_elem_recv_)
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 (usersend) then
call mpi_rsend(sndbuf(snd_pt),n*nesd,&
& psb_mpi_c_dpk_,prcid(i),&
& psb_mpi_r_dpk_,prcid(i),&
& p2ptag,icomm,iret)
else
call mpi_send(sndbuf(snd_pt),n*nesd,&
& psb_mpi_c_dpk_,prcid(i),&
& psb_mpi_r_dpk_,prcid(i),&
& p2ptag,icomm,iret)
end if
@ -401,7 +403,7 @@ complex(psb_dpk_), pointer, dimension(:) :: sndbuf, rcvbuf
nerv = idx(pnti+psb_n_elem_recv_)
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
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
! In all these subroutines X may be: I Integer
! S real(psb_spk_)
! D real(psb_dpk_)
! D complex(psb_dpk_)
! C complex(psb_spk_)
! Z complex(psb_dpk_)
! 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
! beta - complex Choose overwrite or sum.
! y(:) - complex The data area
! beta - real Choose overwrite or sum.
! y(:) - real The data area
! 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.
! info - integer. return code.
! data - integer which list is to be used to exchange data
@ -565,12 +567,13 @@ complex(psb_dpk_), pointer, dimension(:) :: sndbuf, rcvbuf
include 'mpif.h'
#endif
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
complex(psb_dpk_) :: y(:), beta
complex(psb_dpk_), target :: work(:)
type(psb_desc_type),target :: desc_a
integer(psb_ipk_), optional :: data
integer(psb_ipk_), intent(in) :: flag
complex(psb_dpk_), intent(in) :: beta
complex(psb_dpk_), intent(inout) :: y(:)
type(psb_desc_type),target :: desc_a
complex(psb_dpk_), target :: work(:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional :: data
! locals
type(psb_ctxt_type) :: ctxt
@ -648,7 +651,8 @@ complex(psb_dpk_), pointer, dimension(:) :: sndbuf, rcvbuf
type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_ipk_), intent(in) :: flag
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(:)
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
call mpi_alltoallv(sndbuf,sdsz,bsdidx,&
& psb_mpi_c_dpk_,rcvbuf,rvsz,&
& brvidx,psb_mpi_c_dpk_,icomm,iret)
& psb_mpi_r_dpk_,rcvbuf,rvsz,&
& brvidx,psb_mpi_r_dpk_,icomm,iret)
if(iret /= mpi_success) then
info=psb_err_mpi_error_
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)
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,&
& psb_mpi_c_dpk_,prcid(i),&
& psb_mpi_r_dpk_,prcid(i),&
& p2ptag, icomm,rvhd(i),iret)
end if
rcv_pt = rcv_pt + nerv
@ -852,16 +856,16 @@ complex(psb_dpk_), pointer, dimension(:) :: sndbuf, rcvbuf
nerv = idx(pnti+psb_n_elem_recv_)
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 (usersend) then
call mpi_rsend(sndbuf(snd_pt),nesd,&
& psb_mpi_c_dpk_,prcid(i),&
& psb_mpi_r_dpk_,prcid(i),&
& p2ptag,icomm,iret)
else
call mpi_send(sndbuf(snd_pt),nesd,&
& psb_mpi_c_dpk_,prcid(i),&
& psb_mpi_r_dpk_,prcid(i),&
& p2ptag,icomm,iret)
end if
@ -882,7 +886,7 @@ complex(psb_dpk_), pointer, dimension(:) :: sndbuf, rcvbuf
proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_)
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
call mpi_wait(rvhd(i),p2pstat,iret)

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

File diff suppressed because it is too large Load Diff

86
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
! 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
! In all these subroutines X may be: I Integer
! S real(psb_spk_)
! D real(psb_dpk_)
! D complex(psb_dpk_)
! C complex(psb_spk_)
! Z complex(psb_dpk_)
! Basically the operation is as follows: on each process, we identify
@ -74,10 +74,10 @@
!
!
! n - integer Number of columns in Y
! beta - complex Choose overwrite or sum.
! y(:,:) - complex The data area
! beta - real Choose overwrite or sum.
! y(:,:) - real The data area
! 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.
! info - integer. return code.
! data - integer which list is to be used to exchange data
@ -101,13 +101,14 @@ contains
include 'mpif.h'
#endif
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
complex(psb_dpk_) :: y(:,:), beta
complex(psb_dpk_), target :: work(:)
type(psb_desc_type),target :: desc_a
integer(psb_ipk_), optional :: data
integer(psb_ipk_), intent(in) :: flag
integer(psb_mpk_), intent(in) :: n
complex(psb_dpk_), intent(in) :: beta
complex(psb_dpk_), intent(inout) :: y(:,:)
type(psb_desc_type),target :: desc_a
complex(psb_dpk_), target :: work(:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional :: data
! locals
type(psb_ctxt_type) :: ctxt
@ -149,7 +150,7 @@ contains
goto 9999
end if
call psi_swaptran(ctxt,flag,n,beta,y,d_idx,totxch,idxs,idxr,work,info)
call psi_swaptran(ctxt,flag,n,beta,y,d_idx,totxch,idxs,idxr,work,info)
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)
@ -174,7 +175,8 @@ contains
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag
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(:)
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv
@ -305,8 +307,8 @@ contains
! swap elements using mpi_alltoallv
call mpi_alltoallv(rcvbuf,rvsz,brvidx,&
& psb_mpi_c_dpk_,&
& sndbuf,sdsz,bsdidx,psb_mpi_c_dpk_,icomm,iret)
& psb_mpi_r_dpk_,&
& sndbuf,sdsz,bsdidx,psb_mpi_r_dpk_,icomm,iret)
if(iret /= mpi_success) then
info=psb_err_mpi_error_
call psb_errpush(info,name,m_err=(/iret/))
@ -360,9 +362,9 @@ contains
nesd = idx(pnti+nerv+psb_n_elem_send_)
prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm)
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,&
& psb_mpi_c_dpk_,prcid(i),&
& psb_mpi_r_dpk_,prcid(i),&
& p2ptag,icomm,rvhd(i),iret)
end if
rcv_pt = rcv_pt + n*nerv
@ -383,14 +385,14 @@ contains
nesd = idx(pnti+nerv+psb_n_elem_send_)
if ((nerv>0).and.(proc_to_comm /= me)) then
p2ptag = psb_dcomplex_swap_tag
p2ptag = psb_double_swap_tag
if (usersend) then
call mpi_rsend(rcvbuf(rcv_pt),n*nerv,&
& psb_mpi_c_dpk_,prcid(i),&
& psb_mpi_r_dpk_,prcid(i),&
& p2ptag,icomm,iret)
else
call mpi_send(rcvbuf(rcv_pt),n*nerv,&
& psb_mpi_c_dpk_,prcid(i),&
& psb_mpi_r_dpk_,prcid(i),&
& p2ptag,icomm,iret)
end if
@ -413,7 +415,7 @@ contains
nerv = idx(pnti+psb_n_elem_recv_)
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
call mpi_wait(rvhd(i),p2pstat,iret)
@ -525,7 +527,7 @@ contains
! application environment. All the variants have the same structure
! In all these subroutines X may be: I Integer
! S real(psb_spk_)
! D real(psb_dpk_)
! D complex(psb_dpk_)
! C complex(psb_spk_)
! Z complex(psb_dpk_)
! Basically the operation is as follows: on each process, we identify
@ -556,10 +558,10 @@ contains
!
!
! n - integer Number of columns in Y
! beta - complex Choose overwrite or sum.
! y(:) - complex The data area
! beta - real Choose overwrite or sum.
! y(:) - real The data area
! 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.
! info - integer. return code.
! data - integer which list is to be used to exchange data
@ -579,12 +581,13 @@ contains
include 'mpif.h'
#endif
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
complex(psb_dpk_) :: y(:), beta
complex(psb_dpk_), target :: work(:)
type(psb_desc_type),target :: desc_a
integer(psb_ipk_), optional :: data
integer(psb_ipk_), intent(in) :: flag
complex(psb_dpk_), intent(in) :: beta
complex(psb_dpk_), intent(inout) :: y(:)
type(psb_desc_type),target :: desc_a
complex(psb_dpk_), target :: work(:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional :: data
! locals
type(psb_ctxt_type) :: ctxt
@ -659,7 +662,8 @@ contains
type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_ipk_), intent(in) :: flag
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(:)
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv
@ -791,8 +795,8 @@ contains
! swap elements using mpi_alltoallv
call mpi_alltoallv(rcvbuf,rvsz,brvidx,&
& psb_mpi_c_dpk_,&
& sndbuf,sdsz,bsdidx,psb_mpi_c_dpk_,icomm,iret)
& psb_mpi_r_dpk_,&
& sndbuf,sdsz,bsdidx,psb_mpi_r_dpk_,icomm,iret)
if(iret /= mpi_success) then
info=psb_err_mpi_error_
call psb_errpush(info,name,m_err=(/iret/))
@ -845,9 +849,9 @@ contains
nesd = idx(pnti+nerv+psb_n_elem_send_)
prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm)
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,&
& psb_mpi_c_dpk_,prcid(i),&
& psb_mpi_r_dpk_,prcid(i),&
& p2ptag,icomm,rvhd(i),iret)
end if
rcv_pt = rcv_pt + nerv
@ -868,14 +872,14 @@ contains
nesd = idx(pnti+nerv+psb_n_elem_send_)
if ((nerv>0).and.(proc_to_comm /= me)) then
p2ptag = psb_dcomplex_swap_tag
p2ptag = psb_double_swap_tag
if (usersend) then
call mpi_rsend(rcvbuf(rcv_pt),nerv,&
& psb_mpi_c_dpk_,prcid(i),&
& psb_mpi_r_dpk_,prcid(i),&
& p2ptag, icomm,iret)
else
call mpi_send(rcvbuf(rcv_pt),nerv,&
& psb_mpi_c_dpk_,prcid(i),&
& psb_mpi_r_dpk_,prcid(i),&
& p2ptag, icomm,iret)
end if
@ -896,7 +900,7 @@ contains
proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_)
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
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.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``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.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``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.
!!$ 3. The name of the PSBLAS group or the names of its contributors may
!!$ not be used to endorse or promote products derived from this
!!$ software without specific written permission.
!!$ software without specific prior written permission.
!!$
!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED

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

@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@ -51,35 +51,35 @@
! psb_comm_mov_ use ovr_mst_idx
!
!
subroutine psb_chalo_vect(x,desc_a,info,tran,mode,data)
subroutine psb_chalo_vect(x,desc_a,info,tran,mode,data)
use psb_base_mod, psb_protect_name => psb_chalo_vect
use psi_mod
implicit none
type(psb_c_vect_type), intent(inout) :: x
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: mode,data
character, intent(in), optional :: tran
type(psb_c_vect_type), intent(inout) :: x
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: mode,data
character, intent(in), optional :: tran
! locals
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, iix, jjx, &
& nrow, ncol, lldx, imode, data_
integer(psb_lpk_) :: m, n, ix, ijx
character :: tran_
character(len=20) :: name, ch_err
logical :: aliw
name = 'psb_chalo_vect'
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, iix, jjx, &
& nrow, ncol, lldx, imode,data_
integer(psb_lpk_) :: m, n, ix, ijx
character :: tran_
character(len=20) :: name, ch_err
logical :: aliw
name = 'psb_chalov'
info = psb_success_
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_
info = psb_err_internal_error_
goto 9999
end if
ctxt=desc_a%get_context()
ctxt = desc_a%get_context()
! check on blacs grid
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
imode = mode
else
imode = IOR(psb_swap_send_,psb_swap_recv_)
imode = psb_comm_status_sync_
endif
if ((info == 0).and.(lldx<ncol)) call x%reall(ncol,info)
@ -173,31 +173,32 @@ end subroutine psb_chalo_vect
! psb_comm_mov_ use ovr_mst_idx
!
!
subroutine psb_chalo_multivect(x,desc_a,info,tran,mode,data)
subroutine psb_chalo_multivect(x,desc_a,info,tran,mode,data)
use psb_base_mod, psb_protect_name => psb_chalo_multivect
use psi_mod
implicit none
type(psb_c_multivect_type), intent(inout) :: x
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: mode,data
character, intent(in), optional :: tran
type(psb_c_multivect_type), intent(inout) :: x
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: mode,data
character, intent(in), optional :: tran
! locals
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_
integer(psb_lpk_) :: m, n, ix, ijx
character :: tran_
character(len=20) :: name, ch_err
logical :: aliw
integer(psb_lpk_) :: m, n, ix, ijx
character :: tran_
character(len=20) :: name, ch_err
logical :: aliw
name = 'psb_chalo_multivect'
name = 'psb_chalov'
info = psb_success_
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999
info = psb_err_internal_error_
goto 9999
end if
ctxt = desc_a%get_context()
@ -238,7 +239,7 @@ subroutine psb_chalo_multivect(x,desc_a,info,tran,mode,data)
if (present(mode)) then
imode = mode
else
imode = IOR(psb_swap_send_,psb_swap_recv_)
imode = psb_comm_status_sync_
endif
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
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)
goto 9999
end if

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

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

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

@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@ -67,28 +67,28 @@ subroutine psb_covrl_vect(x,desc_a,info,update,mode)
use psi_mod
implicit none
type(psb_c_vect_type), intent(inout) :: x
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: update,mode
type(psb_c_vect_type), intent(inout) :: x
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: update,mode
! locals
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, k, iix, jjx, &
integer(psb_ipk_) :: np, me, err_act, k, iix, jjx, &
& nrow, ncol, ldx, data_, update_, mode_
integer(psb_lpk_) :: m, n, ix, ijx
logical :: do_swap
character(len=20) :: name, ch_err
logical :: aliw
integer(psb_lpk_) :: m, n, ix, ijx
logical :: do_swap
character(len=20) :: name, ch_err
logical :: aliw
name = 'psb_covrl_vect'
name = 'psb_covrlv'
info = psb_success_
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999
end if
ctxt = desc_a%get_context()
ctxt=desc_a%get_context()
! check on blacs grid
call psb_info(ctxt, me, np)
@ -136,7 +136,8 @@ subroutine psb_covrl_vect(x,desc_a,info,update,mode)
! exchange overlap elements
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
if (info == psb_success_) call psi_ovrl_upd(x%v,desc_a,update_,info)
if (info /= psb_success_) then
@ -183,33 +184,33 @@ end subroutine psb_covrl_vect
! - if (swap_recv): use psb_rcv (completing a
! previous call with swap_send)
!
subroutine psb_covrl_multivect(x,desc_a,info,update,mode)
subroutine psb_covrl_multivect(x,desc_a,info,update,mode)
use psb_base_mod, psb_protect_name => psb_covrl_multivect
use psi_mod
implicit none
type(psb_c_multivect_type), intent(inout) :: x
type(psb_c_multivect_type), intent(inout) :: x
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: update,mode
! locals
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, k, iix, jjx, &
integer(psb_ipk_) :: np, me, err_act, k, iix, jjx, &
& nrow, ncol, ldx, data_, update_, mode_
integer(psb_lpk_) :: m, n, ix, ijx
logical :: do_swap
character(len=20) :: name, ch_err
logical :: aliw
integer(psb_lpk_) :: m, n, ix, ijx
logical :: do_swap
character(len=20) :: name, ch_err
logical :: aliw
name = 'psb_covrl_multivect'
name = 'psb_covrlv'
info = psb_success_
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999
end if
ctxt=desc_a%get_context()
ctxt = desc_a%get_context()
! check on blacs grid
call psb_info(ctxt, me, np)
@ -244,7 +245,7 @@ subroutine psb_covrl_multivect(x,desc_a,info,update,mode)
if (present(mode)) then
mode_ = mode
else
mode_ = IOR(psb_swap_send_,psb_swap_recv_)
mode_ = psb_comm_status_sync_
endif
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(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)
goto 9999
end if
! exchange overlap elements
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
if (info == psb_success_) call psi_ovrl_upd(x%v,desc_a,update_,info)
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.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``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
! 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.
!!$ 3. The name of the PSBLAS group or the names of its contributors may
!!$ not be used to endorse or promote products derived from this
!!$ software without specific written permission.
!!$ software without specific prior written permission.
!!$
!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
!!$ ``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.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``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.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``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.
!!$ 3. The name of the PSBLAS group or the names of its contributors may
!!$ not be used to endorse or promote products derived from this
!!$ software without specific written permission.
!!$ software without specific prior written permission.
!!$
!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
!!$ ``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.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``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.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``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.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``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.
!!$ 3. The name of the PSBLAS group or the names of its contributors may
!!$ not be used to endorse or promote products derived from this
!!$ software without specific written permission.
!!$ software without specific prior written permission.
!!$
!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED

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

@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@ -51,36 +51,35 @@
! psb_comm_mov_ use ovr_mst_idx
!
!
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 psi_mod
use psb_comm_factory_mod
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
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: tran
integer(psb_ipk_), intent(in), optional :: mode,data
character, intent(in), optional :: tran
! locals
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, iix, jjx, &
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, iix, jjx, &
& nrow, ncol, lldx, imode,data_
integer(psb_lpk_) :: m, n, ix, ijx
character :: tran_
character(len=20) :: name, ch_err
logical :: aliw
integer(psb_lpk_) :: m, n, ix, ijx
character :: tran_
character(len=20) :: name, ch_err
logical :: aliw
name = 'psb_dhalo_vect'
name = 'psb_dhalov'
info = psb_success_
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999
info = psb_err_internal_error_
goto 9999
end if
ctxt=desc_a%get_context()
ctxt = desc_a%get_context()
! check on blacs grid
call psb_info(ctxt, me, np)
@ -128,7 +127,6 @@ subroutine psb_dhalo_vect(x,desc_a,info,tran,mode,data)
goto 9999
end if
! exchange halo elements
if(tran_ == 'N') then
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
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)
goto 9999
end if
@ -180,26 +178,27 @@ subroutine psb_dhalo_multivect(x,desc_a,info,tran,mode,data)
use psi_mod
implicit none
type(psb_d_multivect_type), intent(inout) :: x
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: tran
integer(psb_ipk_), intent(in), optional :: mode,data
type(psb_d_multivect_type), intent(inout) :: x
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: mode,data
character, intent(in), optional :: tran
! locals
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_
integer(psb_lpk_) :: m, n, ix, ijx
character :: tran_
character(len=20) :: name, ch_err
logical :: aliw
integer(psb_lpk_) :: m, n, ix, ijx
character :: tran_
character(len=20) :: name, ch_err
logical :: aliw
name = 'psb_dhalo_multivect'
name = 'psb_dhalov'
info = psb_success_
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999
info = psb_err_internal_error_
goto 9999
end if
ctxt = desc_a%get_context()
@ -240,7 +239,7 @@ subroutine psb_dhalo_multivect(x,desc_a,info,tran,mode,data)
if (present(mode)) then
imode = mode
else
imode = psb_comm_mov_
imode = psb_comm_status_sync_
endif
if (lldx < ncol) call x%reall(ncol,x%get_ncols(),info)

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

@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@ -52,7 +52,7 @@
! psb_comm_mov_ use ovr_mst_idx
!
!
subroutine psb_dhalom(x,desc_a,info,jx,ik,work,tran,mode,data)
subroutine psb_dhalom(x,desc_a,info,jx,ik,work,tran,mode,data)
use psb_base_mod, psb_protect_name => psb_dhalom
use psi_mod
implicit none
@ -217,7 +217,7 @@ end subroutine psb_dhalom
!!$ documentation and/or other materials provided with the distribution.
!!$ 3. The name of the PSBLAS group or the names of its contributors may
!!$ not be used to endorse or promote products derived from this
!!$ software without specific written permission.
!!$ software without specific prior written permission.
!!$
!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED

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

@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@ -65,31 +65,30 @@
subroutine psb_dovrl_vect(x,desc_a,info,update,mode)
use psb_base_mod, psb_protect_name => psb_dovrl_vect
use psi_mod
use psb_comm_factory_mod
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
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: update,mode
! locals
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, k, iix, jjx, &
integer(psb_ipk_) :: np, me, err_act, k, iix, jjx, &
& nrow, ncol, ldx, data_, update_, mode_
integer(psb_lpk_) :: m, n, ix, ijx
logical :: do_swap
character(len=20) :: name, ch_err
logical :: aliw
integer(psb_lpk_) :: m, n, ix, ijx
logical :: do_swap
character(len=20) :: name, ch_err
logical :: aliw
name = 'psb_dovrl_vect'
name = 'psb_dovrlv'
info = psb_success_
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999
end if
ctxt = desc_a%get_context()
ctxt=desc_a%get_context()
! check on blacs grid
call psb_info(ctxt, me, np)
@ -122,7 +121,7 @@ subroutine psb_dovrl_vect(x,desc_a,info,update,mode)
if (present(mode)) then
mode_ = mode
else
mode_ = psb_comm_status_sync_
mode_ = IOR(psb_swap_send_,psb_swap_recv_)
endif
do_swap = (mode_ /= 0)
@ -137,7 +136,8 @@ subroutine psb_dovrl_vect(x,desc_a,info,update,mode)
! exchange overlap elements
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
if (info == psb_success_) call psi_ovrl_upd(x%v,desc_a,update_,info)
if (info /= psb_success_) then
@ -184,33 +184,33 @@ end subroutine psb_dovrl_vect
! - if (swap_recv): use psb_rcv (completing a
! previous call with swap_send)
!
subroutine psb_dovrl_multivect(x,desc_a,info,update,mode)
subroutine psb_dovrl_multivect(x,desc_a,info,update,mode)
use psb_base_mod, psb_protect_name => psb_dovrl_multivect
use psi_mod
implicit none
type(psb_d_multivect_type), intent(inout) :: x
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: update,mode
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: update,mode
! locals
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, k, iix, jjx, &
integer(psb_ipk_) :: np, me, err_act, k, iix, jjx, &
& nrow, ncol, ldx, data_, update_, mode_
integer(psb_lpk_) :: m, n, ix, ijx
logical :: do_swap
character(len=20) :: name, ch_err
logical :: aliw
integer(psb_lpk_) :: m, n, ix, ijx
logical :: do_swap
character(len=20) :: name, ch_err
logical :: aliw
name = 'psb_dovrl_multivect'
name = 'psb_dovrlv'
info = psb_success_
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999
end if
ctxt=desc_a%get_context()
ctxt = desc_a%get_context()
! check on blacs grid
call psb_info(ctxt, me, np)
@ -245,7 +245,7 @@ subroutine psb_dovrl_multivect(x,desc_a,info,update,mode)
if (present(mode)) then
mode_ = mode
else
mode_ = IOR(psb_swap_send_,psb_swap_recv_)
mode_ = psb_comm_status_sync_
endif
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(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)
goto 9999
end if
! exchange overlap elements
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
if (info == psb_success_) call psi_ovrl_upd(x%v,desc_a,update_,info)
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.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``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.
!!$ 3. The name of the PSBLAS group or the names of its contributors may
!!$ not be used to endorse or promote products derived from this
!!$ software without specific written permission.
!!$ software without specific prior written permission.
!!$
!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
!!$ ``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.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``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.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``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.
!!$ 3. The name of the PSBLAS group or the names of its contributors may
!!$ not be used to endorse or promote products derived from this
!!$ software without specific written permission.
!!$ software without specific prior written permission.
!!$
!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
!!$ ``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.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``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.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``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.
!!$ 3. The name of the PSBLAS group or the names of its contributors may
!!$ not be used to endorse or promote products derived from this
!!$ software without specific written permission.
!!$ software without specific prior written permission.
!!$
!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED

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

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

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

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

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

@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@ -51,31 +51,32 @@
! psb_comm_mov_ use ovr_mst_idx
!
!
subroutine psb_ihalo_vect(x,desc_a,info,tran,mode,data)
subroutine psb_ihalo_vect(x,desc_a,info,tran,mode,data)
use psb_base_mod, psb_protect_name => psb_ihalo_vect
use psi_mod
implicit none
type(psb_i_vect_type), intent(inout) :: x
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: mode,data
character, intent(in), optional :: tran
type(psb_i_vect_type), intent(inout) :: x
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: mode,data
character, intent(in), optional :: tran
! locals
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, iix, jjx, &
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, iix, jjx, &
& nrow, ncol, lldx, imode,data_
integer(psb_lpk_) :: m, n, ix, ijx
character :: tran_
character(len=20) :: name, ch_err
logical :: aliw
integer(psb_lpk_) :: m, n, ix, ijx
character :: tran_
character(len=20) :: name, ch_err
logical :: aliw
name = 'psb_ihalo_vect'
name = 'psb_ihalov'
info = psb_success_
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999
info = psb_err_internal_error_
goto 9999
end if
ctxt = desc_a%get_context()
@ -115,7 +116,7 @@ subroutine psb_ihalo_vect(x,desc_a,info,tran,mode,data)
if (present(mode)) then
imode = mode
else
imode = IOR(psb_swap_send_,psb_swap_recv_)
imode = psb_comm_status_sync_
endif
if ((info == 0).and.(lldx<ncol)) call x%reall(ncol,info)
@ -178,25 +179,26 @@ subroutine psb_ihalo_multivect(x,desc_a,info,tran,mode,data)
implicit none
type(psb_i_multivect_type), intent(inout) :: x
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: mode,data
character, intent(in), optional :: tran
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: mode,data
character, intent(in), optional :: tran
! locals
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_
integer(psb_lpk_) :: m, n, ix, ijx
character :: tran_
character(len=20) :: name, ch_err
logical :: aliw
integer(psb_lpk_) :: m, n, ix, ijx
character :: tran_
character(len=20) :: name, ch_err
logical :: aliw
name = 'psb_ihalo_multivect'
name = 'psb_ihalov'
info = psb_success_
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999
info = psb_err_internal_error_
goto 9999
end if
ctxt = desc_a%get_context()
@ -237,7 +239,7 @@ subroutine psb_ihalo_multivect(x,desc_a,info,tran,mode,data)
if (present(mode)) then
imode = mode
else
imode = IOR(psb_swap_send_,psb_swap_recv_)
imode = psb_comm_status_sync_
endif
if (lldx < ncol) call x%reall(ncol,x%get_ncols(),info)

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

@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@ -67,28 +67,28 @@ subroutine psb_iovrl_vect(x,desc_a,info,update,mode)
use psi_mod
implicit none
type(psb_i_vect_type), intent(inout) :: x
type(psb_i_vect_type), intent(inout) :: x
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: update,mode
! locals
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, k, iix, jjx, &
integer(psb_ipk_) :: np, me, err_act, k, iix, jjx, &
& nrow, ncol, ldx, data_, update_, mode_
integer(psb_lpk_) :: m, n, ix, ijx
logical :: do_swap
character(len=20) :: name, ch_err
logical :: aliw
integer(psb_lpk_) :: m, n, ix, ijx
logical :: do_swap
character(len=20) :: name, ch_err
logical :: aliw
name = 'psb_iovrl_vect'
name = 'psb_iovrlv'
info = psb_success_
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999
end if
ctxt = desc_a%get_context()
ctxt=desc_a%get_context()
! check on blacs grid
call psb_info(ctxt, me, np)
@ -136,7 +136,8 @@ subroutine psb_iovrl_vect(x,desc_a,info,update,mode)
! exchange overlap elements
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
if (info == psb_success_) call psi_ovrl_upd(x%v,desc_a,update_,info)
if (info /= psb_success_) then
@ -183,31 +184,30 @@ end subroutine psb_iovrl_vect
! - if (swap_recv): use psb_rcv (completing a
! previous call with swap_send)
!
subroutine psb_iovrl_multivect(x,desc_a,info,update,mode)
subroutine psb_iovrl_multivect(x,desc_a,info,update,mode)
use psb_base_mod, psb_protect_name => psb_iovrl_multivect
use psi_mod
implicit none
type(psb_i_multivect_type), intent(inout) :: x
type(psb_i_multivect_type), intent(inout) :: x
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: update,mode
! locals
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, k, iix, jjx, &
integer(psb_ipk_) :: np, me, err_act, k, iix, jjx, &
& nrow, ncol, ldx, data_, update_, mode_
integer(psb_lpk_) :: m, n, ix, ijx
logical :: do_swap
character(len=20) :: name, ch_err
logical :: aliw
integer(psb_lpk_) :: m, n, ix, ijx
logical :: do_swap
character(len=20) :: name, ch_err
logical :: aliw
name = 'psb_iovrl_multivect'
name = 'psb_iovrlv'
info = psb_success_
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_
goto 9999
info = psb_err_internal_error_ ; goto 9999
end if
ctxt = desc_a%get_context()
@ -245,7 +245,7 @@ subroutine psb_iovrl_multivect(x,desc_a,info,update,mode)
if (present(mode)) then
mode_ = mode
else
mode_ = IOR(psb_swap_send_,psb_swap_recv_)
mode_ = psb_comm_status_sync_
endif
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(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)
goto 9999
end if
! exchange overlap elements
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
if (info == psb_success_) call psi_ovrl_upd(x%v,desc_a,update_,info)
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.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``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.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``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.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED

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

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

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

@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@ -67,28 +67,28 @@ subroutine psb_lovrl_vect(x,desc_a,info,update,mode)
use psi_mod
implicit none
type(psb_l_vect_type), intent(inout) :: x
type(psb_l_vect_type), intent(inout) :: x
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: update,mode
! locals
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, k, iix, jjx, &
integer(psb_ipk_) :: np, me, err_act, k, iix, jjx, &
& nrow, ncol, ldx, data_, update_, mode_
integer(psb_lpk_) :: m, n, ix, ijx
logical :: do_swap
character(len=20) :: name, ch_err
logical :: aliw
integer(psb_lpk_) :: m, n, ix, ijx
logical :: do_swap
character(len=20) :: name, ch_err
logical :: aliw
name = 'psb_lovrl_vect'
name = 'psb_lovrlv'
info = psb_success_
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999
end if
ctxt = desc_a%get_context()
ctxt=desc_a%get_context()
! check on blacs grid
call psb_info(ctxt, me, np)
@ -136,7 +136,8 @@ subroutine psb_lovrl_vect(x,desc_a,info,update,mode)
! exchange overlap elements
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
if (info == psb_success_) call psi_ovrl_upd(x%v,desc_a,update_,info)
if (info /= psb_success_) then
@ -183,33 +184,33 @@ end subroutine psb_lovrl_vect
! - if (swap_recv): use psb_rcv (completing a
! previous call with swap_send)
!
subroutine psb_lovrl_multivect(x,desc_a,info,update,mode)
subroutine psb_lovrl_multivect(x,desc_a,info,update,mode)
use psb_base_mod, psb_protect_name => psb_lovrl_multivect
use psi_mod
implicit none
type(psb_l_multivect_type), intent(inout) :: x
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: update,mode
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: update,mode
! locals
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, k, iix, jjx, &
integer(psb_ipk_) :: np, me, err_act, k, iix, jjx, &
& nrow, ncol, ldx, data_, update_, mode_
integer(psb_lpk_) :: m, n, ix, ijx
logical :: do_swap
character(len=20) :: name, ch_err
logical :: aliw
integer(psb_lpk_) :: m, n, ix, ijx
logical :: do_swap
character(len=20) :: name, ch_err
logical :: aliw
name = 'psb_lovrl_multivect'
name = 'psb_lovrlv'
info = psb_success_
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999
end if
ctxt=desc_a%get_context()
ctxt = desc_a%get_context()
! check on blacs grid
call psb_info(ctxt, me, np)
@ -244,7 +245,7 @@ subroutine psb_lovrl_multivect(x,desc_a,info,update,mode)
if (present(mode)) then
mode_ = mode
else
mode_ = IOR(psb_swap_send_,psb_swap_recv_)
mode_ = psb_comm_status_sync_
endif
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(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)
goto 9999
end if
! exchange overlap elements
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
if (info == psb_success_) call psi_ovrl_upd(x%v,desc_a,update_,info)
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.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``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.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``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.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``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.
!!$ 3. The name of the PSBLAS group or the names of its contributors may
!!$ not be used to endorse or promote products derived from this
!!$ software without specific written permission.
!!$ software without specific prior written permission.
!!$
!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
!!$ ``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