mirror of
https://github.com/sfilippone/psblas3.git
synced 2026-10-06 22:55:08 +00:00
Added send/receive and other BLACS-like routines.
This commit is contained in:
Salvatore Filippone
@@ -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,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}
|
||||
|
||||
|
||||
+245
-1
@@ -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"
|
||||
|
||||
+12235
-10866
File diff suppressed because one or more lines are too long
+255
-13
@@ -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
|
||||
|
||||
|
||||
+117
-114
@@ -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
|
||||
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
|
||||
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user