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

[UPDATE] Refactor after template update for RMA routines

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

Write Preview
Loading…
Cancel
Save