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

Added send/receive and other BLACS-like routines.

Browse Source
psblas3-type-indexed
Salvatore Filippone 19 years ago
parent ba0f8442ec
commit 40d180dd5a
6 changed files with 9237 additions and 7376 deletions
Show Stats Download Patch File Download Diff File

3
Changelog
Unescape Escape View File

@ -1,7 +1,8 @@
Changelog. A lot less detailed than usual, at least for past
history.
2006/05/29: Added BLACS-like routines for broadcast and reduction.
2006/05/29: Added BLACS-like routines for data communication,
broadcasts, reductions, send/receive.
2006/05/25: Added environment management routines.

4
docs/pdf/commrout.tex
Unescape Escape View File

@ -4,7 +4,9 @@
% HALO DATA COMMUNICATION
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
The routines in this chapter implement various global communication operators
on vectors associated with a discretization mesh. For auxiliary communication
routines not tied to a discretization space see~\ref{sec:toolsrout}.
\subroutine{psb\_halo}{Halo Data Communication}

246
docs/pdf/toolsrout.tex
Unescape Escape View File

@ -1,4 +1,5 @@
\section{Data management and environment handling routines}
\section{Data management, environment handling and auxiliary
communication routines}
\label{sec:toolsrout}
\subroutine{psb\_init}{Initializes PSBLAS parallel environment}
@ -117,6 +118,21 @@ Specified as: an integer variable.
\end{description}
\subroutine{psb\_abort}{Abort a computation}
\syntax{call psb\_abort}{ictxt}
This subroutine aborts computation on the parallel virtual machine.
\begin{description}
\item[\bf On Entry ]
\item[icontxt] the communication context identifying the virtual
parallel machine.\\
Scope:{\bf global}.\\
Type:{\bf required}.\\
Specified as: an integer variable.
\end{description}
%
%% psb_cdall %%
@ -975,6 +991,234 @@ Type: {\bf required}\\
Specified as: an integer variable.
\end{description}
\subroutine{psb\_bcast}{Broadcast data}
\syntax{call psb\_bcast}{ictxt, dat, root}
This subroutine implements a broadcast operation based on the
underlying communication library.
\begin{description}
\item[\bf On Entry ]
\item[icontxt] the communication context identifying the virtual
parallel machine.\\
Scope:{\bf global}.\\
Type:{\bf required}.\\
Specified as: an integer variable.
\item[dat] On the root process, the data to be broadcast.\\
Scope:{\bf global}.\\
Type:{\bf required}.\\
Specified as: an integer, real or complex variable, which may be a
scalar, or a rank 1 or 2 array. \
Type, rank and size must agree on all processes.
\item[root] Root process holding data to be broadcast.\\
Scope:{\bf global}.\\
Type:{\bf required}.\\
Specified as: an integer value $0<= root <= np-1$. \
\end{description}
\begin{description}
\item[\bf On Return]
\item[dat] On processes other than root, the data to be broadcast.\\
Scope:{\bf global}.\\
Type:{\bf required}.\\
Specified as: an integer, real or complex variable, which may be a
scalar, or a rank 1 or 2 array. \
Type, rank and size must agree on all processes.
\end{description}
\subroutine{psb\_sum}{Global sum}
\syntax{call psb\_sum}{ictxt, dat, dst}
This subroutine implements a sum reduction operation based on the
underlying communication library.
\begin{description}
\item[\bf On Entry ]
\item[icontxt] the communication context identifying the virtual
parallel machine.\\
Scope:{\bf global}.\\
Type:{\bf required}.\\
Specified as: an integer variable.
\item[dat] The local contribution to the global sum.\\
Scope:{\bf global}.\\
Type:{\bf required}.\\
Specified as: an integer, real or complex variable, which may be a
scalar, or a rank 1 or 2 array. \
Type, rank and size must agree on all processes.
\item[dst] Process to hold the final sum, or $-1$ to make it available
on all processes.\\
Scope:{\bf global}.\\
Type:{\bf optional}.\\
Specified as: an integer value $-1<= dst <= np-1$, default -1. \
\end{description}
\begin{description}
\item[\bf On Return]
\item[dat] On destination process(es), the result of the sum operation.\\
Scope:{\bf global}.\\
Type:{\bf required}.\\
Specified as: an integer, real or complex variable, which may be a
scalar, or a rank 1 or 2 array. \\
Type, rank and size must agree on all processes.
\end{description}
\subroutine{psb\_amx}{Global maximum absolute value}
\syntax{call psb\_amx}{ictxt, dat, dst}
This subroutine implements a maximum absolute value reduction
operation based on the underlying communication library.
\begin{description}
\item[\bf On Entry ]
\item[icontxt] the communication context identifying the virtual
parallel machine.\\
Scope:{\bf global}.\\
Type:{\bf required}.\\
Specified as: an integer variable.
\item[dat] The local contribution to the global maximum.\\
Scope:{\bf local}.\\
Type:{\bf required}.\\
Specified as: an integer, real or complex variable, which may be a
scalar, or a rank 1 or 2 array. \
Type, rank and size must agree on all processes.
\item[dst] Process to hold the final sum, or $-1$ to make it available
on all processes.\\
Scope:{\bf global}.\\
Type:{\bf optional}.\\
Specified as: an integer value $-1<= dst <= np-1$, default -1. \\
\end{description}
\begin{description}
\item[\bf On Return]
\item[dat] On destination process(es), the result of the maximum operation.\\
Scope:{\bf global}.\\
Type:{\bf required}.\\
Specified as: an integer, real or complex variable, which may be a
scalar, or a rank 1 or 2 array. \
Type, rank and size must agree on all processes.
\end{description}
\subroutine{psb\_amn}{Global minimum absolute value}
\syntax{call psb\_amn}{ictxt, dat, dst}
This subroutine implements a minimum absolute value reduction
operation based on the underlying communication library.
\begin{description}
\item[\bf On Entry ]
\item[icontxt] the communication context identifying the virtual
parallel machine.\\
Scope:{\bf global}.\\
Type:{\bf required}.\\
Specified as: an integer variable.
\item[dat] The local contribution to the global minimum.\\
Scope:{\bf local}.\\
Type:{\bf required}.\\
Specified as: an integer, real or complex variable, which may be a
scalar, or a rank 1 or 2 array. \
Type, rank and size must agree on all processes.
\item[dst] Process to hold the final sum, or $-1$ to make it available
on all processes.\\
Scope:{\bf global}.\\
Type:{\bf optional}.\\
Specified as: an integer value $-1<= dst <= np-1$, default -1. \\
\end{description}
\begin{description}
\item[\bf On Return]
\item[dat] On destination process(es), the result of the minimum operation.\\
Scope:{\bf global}.\\
Type:{\bf required}.\\
Specified as: an integer, real or complex variable, which may be a
scalar, or a rank 1 or 2 array. \\
Type, rank and size must agree on all processes.
\end{description}
\subroutine{psb\_snd}{Send data}
\syntax{call psb\_snd}{ictxt, dat, dst, m}
This subroutine sends a packet of data to a destination.
\begin{description}
\item[\bf On Entry ]
\item[icontxt] the communication context identifying the virtual
parallel machine.\\
Scope:{\bf global}.\\
Type:{\bf required}.\\
Specified as: an integer variable.
\item[dat] The data to be sent.\\
Scope:{\bf local}.\\
Type:{\bf required}.\\
Specified as: an integer, real or complex variable, which may be a
scalar, or a rank 1 or 2 array. \
Type and rank must agree on sender and receiver process; if $m$ is
not specified, size must agree as well.
\item[dst] Destination process.\\
Scope:{\bf global}.\\
Type:{\bf required}.\\
Specified as: an integer value $0<= dst <= np-1$. \\
\item[m] Number of rows.\\
Scope:{\bf global}.\\
Type:{\bf Optional}.\\
Specified as: an integer value $0<= m <= size(dat,1)$. \\
When $dat$ is a rank 2 array, specifies the number of rows to be sent
independently of the leading dimension $size(dat,1)$; must have the
same value on sending and receiving processes.
\end{description}
\begin{description}
\item[\bf On Return]
\end{description}
\subroutine{psb\_rcv}{Receive data}
\syntax{call psb\_rcv}{ictxt, dat, src, m}
This subroutine receives a packet of data to a destination.
\begin{description}
\item[\bf On Entry ]
\item[icontxt] the communication context identifying the virtual
parallel machine.\\
Scope:{\bf global}.\\
Type:{\bf required}.\\
Specified as: an integer variable.
\item[src] Source process.\\
Scope:{\bf global}.\\
Type:{\bf required}.\\
Specified as: an integer value $0<= src <= np-1$. \\
\item[m] Number of rows.\\
Scope:{\bf global}.\\
Type:{\bf Optional}.\\
Specified as: an integer value $0<= m <= size(dat,1)$. \\
When $dat$ is a rank 2 array, specifies the number of rows to be sent
independently of the leading dimension $size(dat,1)$; must have the
same value on sending and receiving processes.
\end{description}
\begin{description}
\item[\bf On Return]
\item[dat] The data to be received.\\
Scope:{\bf local}.\\
Type:{\bf required}.\\
Specified as: an integer, real or complex variable, which may be a
scalar, or a rank 1 or 2 array. \
Type and rank must agree on sender and receiver process; if $m$ is
not specified, size must agree as well.
\end{description}
%%% Local Variables:
%%% mode: latex
%%% TeX-master: "userguide"

15861
docs/userguide.pdf
View File

File diff suppressed because one or more lines are too long

268
src/modules/psb_blacs_mod.f90
Unescape Escape View File

@ -58,6 +58,19 @@ module psb_blacs_mod
end interface
interface psb_snd
module procedure psb_isnds, psb_isndv, psb_isndm,&
& psb_dsnds, psb_dsndv, psb_dsndm,&
& psb_zsnds, psb_zsndv, psb_zsndm
end interface
interface psb_rcv
module procedure psb_ircvs, psb_ircvv, psb_ircvm,&
& psb_drcvs, psb_drcvv, psb_drcvm,&
& psb_zrcvs, psb_zrcvv, psb_zrcvm
end interface
interface psb_amx
module procedure psb_iamxs, psb_iamxv, psb_iamxm,&
& psb_damxs, psb_damxv, psb_damxm,&
@ -90,7 +103,6 @@ module psb_blacs_mod
& zgebr2ds, zgebr2dv, zgebr2dm
end interface
interface gesd2d
module procedure igesd2ds, igesd2dv, igesd2dm,&
& dgesd2ds, dgesd2dv, dgesd2dm,&
@ -892,6 +904,181 @@ contains
subroutine psb_isnds(ictxt,dat,dst)
integer, intent(in) :: ictxt
integer, intent(in) :: dat
integer, intent(in) :: dst
call gesd2d(ictxt,dat,dst,0)
end subroutine psb_isnds
subroutine psb_isndv(ictxt,dat,dst)
integer, intent(in) :: ictxt
integer, intent(in) :: dat(:)
integer, intent(in) :: dst
call gesd2d(ictxt,dat,dst,0)
end subroutine psb_isndv
subroutine psb_isndm(ictxt,dat,dst)
integer, intent(in) :: ictxt
integer, intent(in) :: dat(:,:)
integer, intent(in) :: dst
call gesd2d(ictxt,dat,dst,0)
end subroutine psb_isndm
subroutine psb_dsnds(ictxt,dat,dst)
integer, intent(in) :: ictxt
real(kind(1.d0)), intent(in) :: dat
integer, intent(in) :: dst
call gesd2d(ictxt,dat,dst,0)
end subroutine psb_dsnds
subroutine psb_dsndv(ictxt,dat,dst)
integer, intent(in) :: ictxt
real(kind(1.d0)), intent(in) :: dat(:)
integer, intent(in) :: dst
call gesd2d(ictxt,dat,dst,0)
end subroutine psb_dsndv
subroutine psb_dsndm(ictxt,dat,dst)
integer, intent(in) :: ictxt
real(kind(1.d0)), intent(in) :: dat(:,:)
integer, intent(in) :: dst
call gesd2d(ictxt,dat,dst,0)
end subroutine psb_dsndm
subroutine psb_zsnds(ictxt,dat,dst)
integer, intent(in) :: ictxt
complex(kind(1.d0)), intent(in) :: dat
integer, intent(in) :: dst
call gesd2d(ictxt,dat,dst,0)
end subroutine psb_zsnds
subroutine psb_zsndv(ictxt,dat,dst)
integer, intent(in) :: ictxt
complex(kind(1.d0)), intent(in) :: dat(:)
integer, intent(in) :: dst
call gesd2d(ictxt,dat,dst,0)
end subroutine psb_zsndv
subroutine psb_zsndm(ictxt,dat,dst)
integer, intent(in) :: ictxt
complex(kind(1.d0)), intent(in) :: dat(:,:)
integer, intent(in) :: dst
call gesd2d(ictxt,dat,dst,0)
end subroutine psb_zsndm
subroutine psb_ircvs(ictxt,dat,src)
integer, intent(in) :: ictxt
integer, intent(inout) :: dat
integer, intent(in) :: src
call gerv2d(ictxt,dat,src,0)
end subroutine psb_ircvs
subroutine psb_ircvv(ictxt,dat,src)
integer, intent(in) :: ictxt
integer, intent(inout) :: dat(:)
integer, intent(in) :: src
call gerv2d(ictxt,dat,src,0)
end subroutine psb_ircvv
subroutine psb_ircvm(ictxt,dat,src)
integer, intent(in) :: ictxt
integer, intent(inout) :: dat(:,:)
integer, intent(in) :: src
call gerv2d(ictxt,dat,src,0)
end subroutine psb_ircvm
subroutine psb_drcvs(ictxt,dat,src)
integer, intent(in) :: ictxt
real(kind(1.d0)), intent(inout) :: dat
integer, intent(in) :: src
call gerv2d(ictxt,dat,src,0)
end subroutine psb_drcvs
subroutine psb_drcvv(ictxt,dat,src)
integer, intent(in) :: ictxt
real(kind(1.d0)), intent(inout) :: dat(:)
integer, intent(in) :: src
call gerv2d(ictxt,dat,src,0)
end subroutine psb_drcvv
subroutine psb_drcvm(ictxt,dat,src)
integer, intent(in) :: ictxt
real(kind(1.d0)), intent(inout) :: dat(:,:)
integer, intent(in) :: src
call gerv2d(ictxt,dat,src,0)
end subroutine psb_drcvm
subroutine psb_zrcvs(ictxt,dat,src)
integer, intent(in) :: ictxt
complex(kind(1.d0)), intent(inout) :: dat
integer, intent(in) :: src
call gerv2d(ictxt,dat,src,0)
end subroutine psb_zrcvs
subroutine psb_zrcvv(ictxt,dat,src)
integer, intent(in) :: ictxt
complex(kind(1.d0)), intent(inout) :: dat(:)
integer, intent(in) :: src
call gerv2d(ictxt,dat,src,0)
end subroutine psb_zrcvv
subroutine psb_zrcvm(ictxt,dat,src)
integer, intent(in) :: ictxt
complex(kind(1.d0)), intent(inout) :: dat(:,:)
integer, intent(in) :: src
call gerv2d(ictxt,dat,src,0)
end subroutine psb_zrcvm
@ -1662,11 +1849,13 @@ contains
end subroutine dgesd2dv
subroutine dgesd2dm(ictxt,dat,rdst,cdst)
subroutine dgesd2dm(ictxt,dat,rdst,cdst,m)
integer, intent(in) :: ictxt
real(kind(1.d0)), intent(in) :: dat(:,:)
integer, intent(in) :: rdst,cdst
integer, intent(in), optional :: m
integer :: m_
interface
subroutine dgesd2d(ictxt,m,n,v,ld,rd,cd)
integer, intent(in) :: ictxt,m,n,ld
@ -1675,7 +1864,13 @@ contains
end subroutine dgesd2d
end interface
call dgesd2d(ictxt,size(dat,1),size(dat,2),dat,size(dat,1),rdst,cdst)
if (present(m)) then
m_ = m
else
m_ = size(dat,1)
endif
call dgesd2d(ictxt,m_,size(dat,2),dat,size(dat,1),rdst,cdst)
end subroutine dgesd2dm
@ -1715,11 +1910,14 @@ contains
end subroutine igesd2dv
subroutine igesd2dm(ictxt,dat,rdst,cdst)
subroutine igesd2dm(ictxt,dat,rdst,cdst,m)
integer, intent(in) :: ictxt
integer, intent(in) :: dat(:,:)
integer, intent(in) :: rdst,cdst
integer, intent(in), optional :: m
integer :: m_
interface
subroutine igesd2d(ictxt,m,n,v,ld,rd,cd)
integer, intent(in) :: ictxt,m,n,ld
@ -1728,7 +1926,13 @@ contains
end subroutine igesd2d
end interface
call igesd2d(ictxt,size(dat,1),size(dat,2),dat,size(dat,1),rdst,cdst)
if (present(m)) then
m_ = m
else
m_ = size(dat,1)
endif
call igesd2d(ictxt,m_,size(dat,2),dat,size(dat,1),rdst,cdst)
end subroutine igesd2dm
@ -1769,11 +1973,14 @@ contains
end subroutine zgesd2dv
subroutine zgesd2dm(ictxt,dat,rdst,cdst)
subroutine zgesd2dm(ictxt,dat,rdst,cdst,m)
integer, intent(in) :: ictxt
complex(kind(1.d0)), intent(in) :: dat(:,:)
integer, intent(in) :: rdst,cdst
integer, intent(in), optional :: m
integer :: m_
interface
subroutine zgesd2d(ictxt,m,n,v,ld,rd,cd)
integer, intent(in) :: ictxt,m,n,ld
@ -1782,7 +1989,13 @@ contains
end subroutine zgesd2d
end interface
call zgesd2d(ictxt,size(dat,1),size(dat,2),dat,size(dat,1),rdst,cdst)
if (present(m)) then
m_ = m
else
m_ = size(dat,1)
endif
call zgesd2d(ictxt,m_,size(dat,2),dat,size(dat,1),rdst,cdst)
end subroutine zgesd2dm
@ -1823,11 +2036,14 @@ contains
end subroutine dgerv2dv
subroutine dgerv2dm(ictxt,dat,rdst,cdst)
subroutine dgerv2dm(ictxt,dat,rdst,cdst,m)
integer, intent(in) :: ictxt
real(kind(1.d0)), intent(inout) :: dat(:,:)
integer, intent(in) :: rdst,cdst
integer, intent(in), optional :: m
integer :: m_
interface
subroutine dgerv2d(ictxt,m,n,v,ld,rd,cd)
integer, intent(in) :: ictxt,m,n,ld
@ -1836,7 +2052,13 @@ contains
end subroutine dgerv2d
end interface
call dgerv2d(ictxt,size(dat,1),size(dat,2),dat,size(dat,1),rdst,cdst)
if (present(m)) then
m_ = m
else
m_ = size(dat,1)
endif
call dgerv2d(ictxt,m_,size(dat,2),dat,size(dat,1),rdst,cdst)
end subroutine dgerv2dm
@ -1876,11 +2098,14 @@ contains
end subroutine igerv2dv
subroutine igerv2dm(ictxt,dat,rdst,cdst)
subroutine igerv2dm(ictxt,dat,rdst,cdst,m)
integer, intent(in) :: ictxt
integer, intent(inout) :: dat(:,:)
integer, intent(in) :: rdst,cdst
integer, intent(in), optional :: m
integer :: m_
interface
subroutine igerv2d(ictxt,m,n,v,ld,rd,cd)
integer, intent(in) :: ictxt,m,n,ld
@ -1889,7 +2114,14 @@ contains
end subroutine igerv2d
end interface
call igerv2d(ictxt,size(dat,1),size(dat,2),dat,size(dat,1),rdst,cdst)
if (present(m)) then
m_ = m
else
m_ = size(dat,1)
endif
call igerv2d(ictxt,m_,size(dat,2),dat,size(dat,1),rdst,cdst)
end subroutine igerv2dm
@ -1930,10 +2162,13 @@ contains
end subroutine zgerv2dv
subroutine zgerv2dm(ictxt,dat,rdst,cdst)
subroutine zgerv2dm(ictxt,dat,rdst,cdst,m)
integer, intent(in) :: ictxt
complex(kind(1.d0)), intent(inout) :: dat(:,:)
integer, intent(in) :: rdst,cdst
integer, intent(in), optional :: m
integer :: m_
interface
subroutine zgerv2d(ictxt,m,n,v,ld,rd,cd)
@ -1943,7 +2178,14 @@ contains
end subroutine zgerv2d
end interface
call zgerv2d(ictxt,size(dat,1),size(dat,2),dat,size(dat,1),rdst,cdst)
if (present(m)) then
m_ = m
else
m_ = size(dat,1)
endif
call zgerv2d(ictxt,m_,size(dat,2),dat,size(dat,1),rdst,cdst)
end subroutine zgerv2dm

231
test/Fileread/mat_dist.f90
Unescape Escape View File

@ -145,7 +145,7 @@ contains
root = 0
end if
call psb_info(ictxt, iam, np)
if (iam == root) then
! extract information from a_glob
if (a_glob%fida.ne. 'CSR') then
@ -170,7 +170,7 @@ contains
call psb_bcast(ictxt, ncol,root)
call psb_bcast(ictxt, nnzero,root)
call psb_bcast(ictxt, nrhs,root)
liwork = max(np, nrow + ncol)
allocate(iwork(liwork), stat = info)
if (info /= 0) then
@ -248,18 +248,16 @@ contains
if (iam == root) then
ll=0
do j = i_count, j_count
icol(j-i_count+1) = a_glob%ia2(j) - &
& a_glob%ia2(i_count) + 1
do k=a_glob%ia2(j),a_glob%ia2(j+1)-1
ll = ll+1
irow(ll) = j
icol(ll) = a_glob%ia1(k)
val(ll) = a_glob%aspk(k)
end do
enddo
k = a_glob%ia2(i_count)
do j = k, a_glob%ia2(j_count)-1
val(j-k+1) = a_glob%aspk(j)
irow(j-k+1) = a_glob%ia1(j)
enddo
ll = icol(nnr+1) - 1
if (iproc == iam) then
call psb_spins(ll,irow,icol,val,a,desc_a,info)
if(info/=0) then
@ -277,19 +275,19 @@ contains
goto 9999
end if
else
call igesd2d(ictxt,1,1,nnr,1,iproc,0)
call igesd2d(ictxt,1,1,ll,1,iproc,0)
call igesd2d(ictxt,nnr+1,1,icol,nnr+1,iproc,0)
call igesd2d(ictxt,ll,1,irow,ll,iproc,0)
call dgesd2d(ictxt,ll,1,val,ll,iproc,0)
call dgesd2d(ictxt,nnr,1,b_glob(i_count:j_count-1),nnr,iproc,0)
call igerv2d(ictxt,1,1,ll,1,iproc,0)
call psb_snd(ictxt,nnr,iproc)
call psb_snd(ictxt,ll,iproc)
call psb_snd(ictxt,irow(1:ll),iproc)
call psb_snd(ictxt,icol(1:ll),iproc)
call psb_snd(ictxt,val(1:ll),iproc)
call psb_snd(ictxt,b_glob(i_count:j_count-1),iproc)
call psb_rcv(ictxt,ll,iproc)
endif
else if (iam /= root) then
if (iproc == iam) then
call igerv2d(ictxt,1,1,nnr,1,root,0)
call igerv2d(ictxt,1,1,ll,1,root,0)
call psb_rcv(ictxt,nnr,root)
call psb_rcv(ictxt,ll,root)
if (ll > size(irow)) then
write(0,*) iam,'need to reallocate ',ll
deallocate(val,irow,icol)
@ -302,11 +300,11 @@ contains
end if
endif
call igerv2d(ictxt,ll,1,irow,ll,root,0)
call igerv2d(ictxt,nnr+1,1,icol,nnr+1,root,0)
call dgerv2d(ictxt,ll,1,val,ll,root,0)
call dgerv2d(ictxt,nnr,1,b_glob(i_count:i_count+nnr-1),nnr,root,0)
call igesd2d(ictxt,1,1,ll,1,root,0)
call psb_rcv(ictxt,irow(1:ll),root)
call psb_rcv(ictxt,icol(1:ll),root)
call psb_rcv(ictxt,val(1:ll),root)
call psb_rcv(ictxt,b_glob(i_count:i_count+nnr-1),root)
call psb_snd(ictxt,ll,root)
call psb_spins(ll,irow,icol,val,a,desc_a,info)
if(info/=0) then
info=4010
@ -333,14 +331,17 @@ contains
do j_count = 1, length_row
k_count = iwork(j_count)
if (iam == root) then
icol(1) = 1
icol(2) = 1
do j = a_glob%ia2(i_count), a_glob%ia2(i_count+1)-1
val(icol(2)) = a_glob%aspk(j)
irow(icol(2)) = a_glob%ia1(j)
icol(2) =icol(2) + 1
ll=0
do j = i_count, i_count
do k=a_glob%ia2(j),a_glob%ia2(j+1)-1
ll = ll+1
irow(ll) = j
icol(ll) = a_glob%ia1(k)
val(ll) = a_glob%aspk(k)
end do
enddo
ll = icol(2) - 1
if (k_count == iam) then
call psb_spins(ll,irow,icol,val,a,desc_a,info)
@ -359,21 +360,22 @@ contains
goto 9999
end if
else
call igesd2d(ictxt,1,1,ll,1,k_count,0)
call igesd2d(ictxt,ll,1,irow,ll,k_count,0)
call dgesd2d(ictxt,ll,1,val,ll,k_count,0)
call dgesd2d(ictxt,1,1,b_glob(i_count),1,k_count,0)
call igerv2d(ictxt,1,1,ll,1,k_count,0)
call psb_snd(ictxt,ll,k_count)
call psb_snd(ictxt,irow(1:ll),k_count)
call psb_snd(ictxt,icol(1:ll),k_count)
call psb_snd(ictxt,val(1:ll),k_count)
call psb_snd(ictxt,b_glob(i_count),k_count)
call psb_rcv(ictxt,ll,k_count)
endif
else if (iam /= root) then
if (k_count == iam) then
call igerv2d(ictxt,1,1,ll,1,root,0)
icol(1) = 1
icol(2) = ll+1
call igerv2d(ictxt,ll,1,irow,ll,root,0)
call dgerv2d(ictxt,ll,1,val,ll,root,0)
call dgerv2d(ictxt,1,1,b_glob(i_count),1,root,0)
call igesd2d(ictxt,1,1,ll,1,root,0)
call psb_rcv(ictxt,ll,root)
call psb_rcv(ictxt,irow(1:ll),root)
call psb_rcv(ictxt,icol(1:ll),root)
call psb_rcv(ictxt,val(1:ll),root)
call psb_rcv(ictxt,b_glob(i_count),root)
call psb_snd(ictxt,ll,root)
call psb_spins(ll,irow,icol,val,a,desc_a,info)
if(info/=0) then
info=4010
@ -698,19 +700,19 @@ contains
goto 9999
end if
else
call igesd2d(ictxt,1,1,nnr,1,iproc,0)
call igesd2d(ictxt,1,1,ll,1,iproc,0)
call igesd2d(ictxt,ll,1,irow,ll,iproc,0)
call igesd2d(ictxt,ll,1,icol,ll,iproc,0)
call dgesd2d(ictxt,ll,1,val,ll,iproc,0)
call dgesd2d(ictxt,nnr,1,b_glob(i_count:j_count-1),nnr,iproc,0)
call igerv2d(ictxt,1,1,ll,1,iproc,0)
call psb_snd(ictxt,nnr,iproc)
call psb_snd(ictxt,ll,iproc)
call psb_snd(ictxt,irow(1:ll),iproc)
call psb_snd(ictxt,icol(1:ll),iproc)
call psb_snd(ictxt,val(1:ll),iproc)
call psb_snd(ictxt,b_glob(i_count:j_count-1),iproc)
call psb_rcv(ictxt,ll,iproc)
endif
else if (iam /= root) then
if (iproc == iam) then
call igerv2d(ictxt,1,1,nnr,1,root,0)
call igerv2d(ictxt,1,1,ll,1,root,0)
call psb_rcv(ictxt,nnr,root)
call psb_rcv(ictxt,ll,root)
if (ll > size(val)) then
write(0,*) iam,'need to reallocate ',ll
deallocate(val,irow,icol)
@ -722,11 +724,11 @@ contains
goto 9999
end if
endif
call igerv2d(ictxt,ll,1,irow,ll,root,0)
call igerv2d(ictxt,ll,1,icol,ll,root,0)
call dgerv2d(ictxt,ll,1,val,ll,root,0)
call dgerv2d(ictxt,nnr,1,b_glob(i_count:i_count+nnr-1),nnr,root,0)
call igesd2d(ictxt,1,1,ll,1,root,0)
call psb_rcv(ictxt,irow(1:ll),root)
call psb_rcv(ictxt,icol(1:ll),root)
call psb_rcv(ictxt,val(1:ll),root)
call psb_rcv(ictxt,b_glob(i_count:i_count+nnr-1),root)
call psb_snd(ictxt,ll,root)
call psb_spins(ll,irow,icol,val,a,desc_a,info)
if(info/=0) then
@ -1019,18 +1021,16 @@ contains
if (iam == root) then
ll=0
do j = i_count, j_count
icol(j-i_count+1) = a_glob%ia2(j) - &
& a_glob%ia2(i_count) + 1
enddo
k = a_glob%ia2(i_count)
do j = k, a_glob%ia2(j_count)-1
val(j-k+1) = a_glob%aspk(j)
irow(j-k+1) = a_glob%ia1(j)
do k=a_glob%ia2(j),a_glob%ia2(j+1)-1
ll = ll+1
irow(ll) = j
icol(ll) = a_glob%ia1(k)
val(ll) = a_glob%aspk(k)
end do
enddo
ll = icol(nnr+1) - 1
if (iproc == iam) then
call psb_spins(ll,irow,icol,val,a,desc_a,info)
if(info/=0) then
@ -1048,19 +1048,19 @@ contains
goto 9999
end if
else
call igesd2d(ictxt,1,1,nnr,1,iproc,0)
call igesd2d(ictxt,1,1,ll,1,iproc,0)
call igesd2d(ictxt,nnr+1,1,icol,nnr+1,iproc,0)
call igesd2d(ictxt,ll,1,irow,ll,iproc,0)
call zgesd2d(ictxt,ll,1,val,ll,iproc,0)
call zgesd2d(ictxt,nnr,1,b_glob(i_count:j_count-1),nnr,iproc,0)
call igerv2d(ictxt,1,1,ll,1,iproc,0)
call psb_snd(ictxt,nnr,iproc)
call psb_snd(ictxt,ll,iproc)
call psb_snd(ictxt,irow(1:ll),iproc)
call psb_snd(ictxt,icol(1:ll),iproc)
call psb_snd(ictxt,val(1:ll),iproc)
call psb_snd(ictxt,b_glob(i_count:j_count-1),iproc)
call psb_rcv(ictxt,ll,iproc)
endif
else if (iam /= root) then
if (iproc == iam) then
call igerv2d(ictxt,1,1,nnr,1,root,0)
call igerv2d(ictxt,1,1,ll,1,root,0)
call psb_rcv(ictxt,nnr,root)
call psb_rcv(ictxt,ll,root)
if (ll > size(irow)) then
write(0,*) iam,'need to reallocate ',ll
deallocate(val,irow,icol)
@ -1073,11 +1073,11 @@ contains
end if
endif
call igerv2d(ictxt,ll,1,irow,ll,root,0)
call igerv2d(ictxt,nnr+1,1,icol,nnr+1,root,0)
call zgerv2d(ictxt,ll,1,val,ll,root,0)
call zgerv2d(ictxt,nnr,1,b_glob(i_count:i_count+nnr-1),nnr,root,0)
call igesd2d(ictxt,1,1,ll,1,root,0)
call psb_rcv(ictxt,irow(1:ll),root)
call psb_rcv(ictxt,icol(1:ll),root)
call psb_rcv(ictxt,val(1:ll),root)
call psb_rcv(ictxt,b_glob(i_count:i_count+nnr-1),root)
call psb_snd(ictxt,ll,root)
call psb_spins(ll,irow,icol,val,a,desc_a,info)
if(info/=0) then
info=4010
@ -1104,14 +1104,17 @@ contains
do j_count = 1, length_row
k_count = iwork(j_count)
if (iam == root) then
icol(1) = 1
icol(2) = 1
do j = a_glob%ia2(i_count), a_glob%ia2(i_count+1)-1
val(icol(2)) = a_glob%aspk(j)
irow(icol(2)) = a_glob%ia1(j)
icol(2) =icol(2) + 1
ll=0
do j = i_count, i_count
do k=a_glob%ia2(j),a_glob%ia2(j+1)-1
ll = ll+1
irow(ll) = j
icol(ll) = a_glob%ia1(k)
val(ll) = a_glob%aspk(k)
end do
enddo
ll = icol(2) - 1
if (k_count == iam) then
call psb_spins(ll,irow,icol,val,a,desc_a,info)
@ -1130,21 +1133,21 @@ contains
goto 9999
end if
else
call igesd2d(ictxt,1,1,ll,1,k_count,0)
call igesd2d(ictxt,ll,1,irow,ll,k_count,0)
call zgesd2d(ictxt,ll,1,val,ll,k_count,0)
call zgesd2d(ictxt,1,1,b_glob(i_count),1,k_count,0)
call igerv2d(ictxt,1,1,ll,1,k_count,0)
call psb_snd(ictxt,ll,k_count)
call psb_snd(ictxt,irow(1:ll),k_count)
call psb_snd(ictxt,icol(1:ll),k_count)
call psb_snd(ictxt,val(1:ll),k_count)
call psb_snd(ictxt,b_glob(i_count),k_count)
call psb_rcv(ictxt,ll,k_count)
endif
else if (iam /= root) then
if (k_count == iam) then
call igerv2d(ictxt,1,1,ll,1,root,0)
icol(1) = 1
icol(2) = ll+1
call igerv2d(ictxt,ll,1,irow,ll,root,0)
call zgerv2d(ictxt,ll,1,val,ll,root,0)
call zgerv2d(ictxt,1,1,b_glob(i_count),1,root,0)
call igesd2d(ictxt,1,1,ll,1,root,0)
call psb_rcv(ictxt,ll,root)
call psb_rcv(ictxt,irow(1:ll),root)
call psb_rcv(ictxt,icol(1:ll),root)
call psb_rcv(ictxt,val(1:ll),root)
call psb_rcv(ictxt,b_glob(i_count),root)
call psb_snd(ictxt,ll,root)
call psb_spins(ll,irow,icol,val,a,desc_a,info)
if(info/=0) then
info=4010
@ -1469,19 +1472,19 @@ contains
goto 9999
end if
else
call igesd2d(ictxt,1,1,nnr,1,iproc,0)
call igesd2d(ictxt,1,1,ll,1,iproc,0)
call igesd2d(ictxt,ll,1,irow,ll,iproc,0)
call igesd2d(ictxt,ll,1,icol,ll,iproc,0)
call zgesd2d(ictxt,ll,1,val,ll,iproc,0)
call zgesd2d(ictxt,nnr,1,b_glob(i_count:j_count-1),nnr,iproc,0)
call igerv2d(ictxt,1,1,ll,1,iproc,0)
call psb_snd(ictxt,nnr,iproc)
call psb_snd(ictxt,ll,iproc)
call psb_snd(ictxt,irow(1:ll),iproc)
call psb_snd(ictxt,icol(1:ll),iproc)
call psb_snd(ictxt,val(1:ll),iproc)
call psb_snd(ictxt,b_glob(i_count:j_count-1),iproc)
call psb_rcv(ictxt,ll,iproc)
endif
else if (iam /= root) then
if (iproc == iam) then
call igerv2d(ictxt,1,1,nnr,1,root,0)
call igerv2d(ictxt,1,1,ll,1,root,0)
call psb_rcv(ictxt,nnr,root)
call psb_rcv(ictxt,ll,root)
if (ll > size(val)) then
write(0,*) iam,'need to reallocate ',ll
deallocate(val,irow,icol)
@ -1493,11 +1496,11 @@ contains
goto 9999
end if
endif
call igerv2d(ictxt,ll,1,irow,ll,root,0)
call igerv2d(ictxt,ll,1,icol,ll,root,0)
call zgerv2d(ictxt,ll,1,val,ll,root,0)
call zgerv2d(ictxt,nnr,1,b_glob(i_count:i_count+nnr-1),nnr,root,0)
call igesd2d(ictxt,1,1,ll,1,root,0)
call psb_rcv(ictxt,irow(1:ll),root)
call psb_rcv(ictxt,icol(1:ll),root)
call psb_rcv(ictxt,val(1:ll),root)
call psb_rcv(ictxt,b_glob(i_count:i_count+nnr-1),root)
call psb_snd(ictxt,ll,root)
call psb_spins(ll,irow,icol,val,a,desc_a,info)
if(info/=0) then

Write Preview
Loading…
Cancel
Save