Modified interface to GEALL, GEINS et al.

Changed ITRACE behaviour in solver routines.
Updated documentation.
psblas3-type-indexed
Salvatore Filippone 19 years ago
parent 41d7626b66
commit d003f55d95

@ -1,7 +1,11 @@
Changelog. A lot less detailed than usual, at least for past Changelog. A lot less detailed than usual, at least for past
history. history.
2006/04/21: A bunch of fixes related to various scratch spmat(s) initialization 2006/04/24: Rewritten documentation; minor changes to the interface of
dense tools routines, trying to achieve a uniform
look & feel.
2006/04/21: A bunch of fixes related to various matrix initialization
problems that were revealed while testing on SP5. problems that were revealed while testing on SP5.
2006/04/18: Changed interface to spasb and csdp: better handling of 2006/04/18: Changed interface to spasb and csdp: better handling of

@ -6,10 +6,10 @@
####################### Section 1 ####################### ####################### Section 1 #######################
# Define your compilers and compiler flags here # # Define your compilers and compiler flags here #
########################################################## ##########################################################
F90=/usr/local/gfortran/bin/gfortran F90=/usr/local/gcc42/bin/gfortran
FC=/usr/local/gfortran/bin/gfortran FC=/usr/local/gcc42/bin/gfortran
F77=$(FC) F77=$(FC)
CC=/usr/local/gfortran/bin/gcc CC=/usr/local/gcc42/bin/gcc
F90COPT= -O3 -ffast-math -march=pentium4 -msse2 -mfpmath=sse F90COPT= -O3 -ffast-math -march=pentium4 -msse2 -mfpmath=sse
FCOPT=-O3 -ffast-math -march=pentium4 -msse2 -mfpmath=sse FCOPT=-O3 -ffast-math -march=pentium4 -msse2 -mfpmath=sse
CCOPT=-O3 -ffast-math -march=pentium4 -msse2 -mfpmath=sse CCOPT=-O3 -ffast-math -march=pentium4 -msse2 -mfpmath=sse
@ -17,17 +17,17 @@ CCOPT=-O3 -ffast-math -march=pentium4 -msse2 -mfpmath=sse
####################### Section 2 ####################### ####################### Section 2 #######################
# Define your linker and linker flags here # # Define your linker and linker flags here #
########################################################## ##########################################################
F90LINK=/usr/local/mpich-gfortran/bin/mpif90 F90LINK=/usr/local/mpich-gcc42/bin/mpif90
FLINK=/usr/local/mpich-gfortran/bin/mpif77 FLINK=/usr/local/mpich-gcc42/bin/mpif77
MPF90=/usr/local/mpich-gfortran/bin/mpif90 MPF90=/usr/local/mpich-gcc42/bin/mpif90
MPF77=/usr/local/mpich-gfortran/bin/mpif77 MPF77=/usr/local/mpich-gcc42/bin/mpif77
MPCC=/usr/local/mpich-gfortran/bin/mpicc MPCC=/usr/local/mpich-gcc42/bin/mpicc
####################### Section 3 ####################### ####################### Section 3 #######################
# Specify paths to libraries # # Specify paths to libraries #
########################################################## ##########################################################
BLAS=-lblas-gcc41 -L$(HOME)/LIB BLAS=-lblas-gcc42 -L$(HOME)/LIB
BLACS=-lmpiblacs-gfortran -L$(HOME)/LIB BLACS=-lmpiblacs-gcc42 -L$(HOME)/LIB
EXTRA_BLACS_ENV_OBJS=extra_env.o EXTRA_BLACS_ENV_OBJS=extra_env.o
@ -35,7 +35,7 @@ EXTRA_BLACS_ENV_OBJS=extra_env.o
# Other useful tools&defines # # Other useful tools&defines #
########################################################## ##########################################################
SLUDIR=/usr/local/SuperLU_3.0 SLUDIR=/usr/local/SuperLU_3.0
SLU=-lslu_lx_gfort -L$(SLUDIR) SLU=-lslu_lx_gcc42 -L$(SLUDIR)
SLUDEF=-DHave_SLU_ -I$(SLUDIR) SLUDEF=-DHave_SLU_ -I$(SLUDIR)
UMFDIR=$(HOME)/LIB/Umfpack_gcc41 UMFDIR=$(HOME)/LIB/Umfpack_gcc41

@ -1,6 +1,6 @@
include Make.inc include Make.inc
lib: library:
( [ -d lib ] || mkdir lib) ( [ -d lib ] || mkdir lib)
(cd src; make lib) (cd src; make lib)
@echo "=====================================" @echo "====================================="

@ -39,7 +39,7 @@ Long Precision Complex & psb\_halo \\
\item[x] global dense matrix $x$.\\ \item[x] global dense matrix $x$.\\
Scope: {\bf local} \\ Scope: {\bf local} \\
Type: {\bf required} \\ Type: {\bf required} \\
Specified as: a rank one or two array with the POINTER attribute Specified as: a rank one or two array with the TARGET attribute
containing numbers of type specified in containing numbers of type specified in
Table~\ref{tab:f90halo}. Table~\ref{tab:f90halo}.
\item[desc\_a] contains data structures for communications.\\ \item[desc\_a] contains data structures for communications.\\
@ -61,7 +61,7 @@ POINTER attribute.
\item[x] global dense result matrix $x$.\\ \item[x] global dense result matrix $x$.\\
Scope: {\bf local} \\ Scope: {\bf local} \\
Type: {\bf required} \\ Type: {\bf required} \\
Returned as: a rank one or two array with the POINTER attribute Returned as: a rank one or two array
containing numbers of type specified in containing numbers of type specified in
Table~\ref{tab:f90halo}. Table~\ref{tab:f90halo}.
\item[info] the local portion of result submatrix $y$.\\ \item[info] the local portion of result submatrix $y$.\\
@ -104,37 +104,29 @@ Long Precision Complex & psb\_ovrl \\
\end{table} \end{table}
\syntax{CALL psb\_ovrl}{x, desc\_a, info} \syntax{CALL psb\_ovrl}{x, desc\_a, info}
\syntax*{CALL psb\_ovrl}{x, desc\_a, info, choice=choice, \syntax*{CALL psb\_ovrl}{x, desc\_a, info, update=update\_type, work=work}
update\_type=update\_type, work=work}
\begin{description} \begin{description}
\item[\bf On Entry] \item[\bf On Entry]
\item[x] global dense matrix $x$.\\ \item[x] global dense matrix $x$.\\
Scope: {\bf local} \\ Scope: {\bf local} \\
Type: {\bf required} \\ Type: {\bf required} \\
Specified as: a rank one or two array with the POINTER attribute Specified as: a rank one or two array
containing numbers of type specified in containing numbers of type specified in
Table~\ref{tab:f90ovrl}. Table~\ref{tab:f90ovrl}.
\item[desc\_a] contains data structures for communications.\\ \item[desc\_a] contains data structures for communications.\\
Scope: {\bf local} \\ Scope: {\bf local} \\
Type: {\bf required}\\ Type: {\bf required}\\
Specified as: a structured data of type \descdata. Specified as: a structured data of type \descdata.
\item[choice] specify if exchange overlap elements. \item[update] Update operator. \\
\begin{description} \begin{description}
\item[choice = .true.] exchange overlap elements, i.e. apply operator \item[update = psb\_none\_] Do nothing;
$P^{T}$; \item[update = psb\_add\_] Sum overlap entries;
\item[choice = .false.] don't exchange overlap elements \item[update = psb\_avg\_] Average overlap entries;
%% \item[update = psb\_square\_root\_] square root update $\sqrt{P_a}$;
\end{description} \end{description}
Scope: {\bf global} \\ Scope: {\bf global} \\
Type: {\bf optional} \\ Default: $update\_type = psb\_avg\_ $\\
Default: $choice = .true. $\\
Specified as: a logical variable.
\begin{description}
\item[update\_type = 1] normal update $P_a$;
\item[update\_type = 2] square root update $\sqrt{P_a}$;
\end{description}
Scope: {\bf global} \\
Default: $update\_type = .true. $\\
Scope: {\bf global} \\ Scope: {\bf global} \\
Specified as: a integer variable. Specified as: a integer variable.
\item[work] the work array. \\ \item[work] the work array. \\
@ -146,7 +138,7 @@ Specified as: a one dimensional array of the same type of $x$.
\item[x] global dense result matrix $x$.\\ \item[x] global dense result matrix $x$.\\
Scope: {\bf local} \\ Scope: {\bf local} \\
Type: {\bf required} \\ Type: {\bf required} \\
Specified as: a pointer to array of rank one or two Specified as: an array of rank one or two
containing numbers of type specified in containing numbers of type specified in
Table~\ref{tab:f90ovrl}. Table~\ref{tab:f90ovrl}.
\item[info] the local portion of result submatrix $y$.\\ \item[info] the local portion of result submatrix $y$.\\

@ -21,7 +21,7 @@ Fields contained in Sparse matrix structures are:
\item[{\bf aspk}] Contains values of the local distributed sparse \item[{\bf aspk}] Contains values of the local distributed sparse
matrix.\\ matrix.\\
Specified as: a pointer to an array of rank one of type corresponding Specified as: a pointer to an array of rank one of type corresponding
to matrix entries type . to matrix entries type.
\item[{\bf ia1}] Holds integer information on distributed sparse \item[{\bf ia1}] Holds integer information on distributed sparse
matrix. Actual information will depend on data format used.\\ matrix. Actual information will depend on data format used.\\
Specified as: a pointer to an integer array of rank one. Specified as: a pointer to an integer array of rank one.
@ -30,7 +30,7 @@ matrix. Actual information will depend on data format used.\\
Specified as: a pointer to an integer array of rank one. Specified as: a pointer to an integer array of rank one.
\item[{\bf infoa}] On entry can hold auxiliary information on distributed sparse \item[{\bf infoa}] On entry can hold auxiliary information on distributed sparse
matrix. Actual information will depend on data format used.\\ matrix. Actual information will depend on data format used.\\
Specified as: integer array of length 10. Specified as: integer array of length \verb|psb_ifasize_|.
\item[{\bf fida}] Defines the format of the distributed sparse matrix.\\ \item[{\bf fida}] Defines the format of the distributed sparse matrix.\\
Specified as: a string of length 5 Specified as: a string of length 5
\item[{\bf descra}] Describe the characteristic of the distributed sparse matrix.\\ \item[{\bf descra}] Describe the characteristic of the distributed sparse matrix.\\
@ -61,7 +61,7 @@ type psb_dspmat_type
integer :: m, k integer :: m, k
character :: fida(5) character :: fida(5)
character :: descra(10) character :: descra(10)
integer :: infoa(10) integer :: infoa(psb_ifa_size_)
real(kind(1.d0)), pointer :: aspk(:) real(kind(1.d0)), pointer :: aspk(:)
integer, pointer :: ia1(:), ia2(:), pr(:), pl(:) integer, pointer :: ia1(:), ia2(:), pr(:), pl(:)
end type psb_dspmat_type end type psb_dspmat_type
@ -72,7 +72,9 @@ end type psb_dspmat_type
\begin{center} \begin{center}
\fbox{\TheSbox} \fbox{\TheSbox}
\end{center} \end{center}
\caption{\label{fig:spmattype}The PSBLAS defined data type that contains a sparse matrix.} \caption{\label{fig:spmattype}
The PSBLAS defined data type that
contains a sparse matrix.}
\end{figure} \end{figure}
The following two cases are among the most commonly used: The following two cases are among the most commonly used:
@ -98,6 +100,36 @@ column index are stored into \verb|apsk(j)|, \verb|ia1(j)| and
\verb|ia2(j)| respectively. \verb|ia2(j)| respectively.
\end{enumerate} \end{enumerate}
\end{description} \end{description}
A sparse matrix has an associated state, which can take the following
values:
\begin{description}
\item[Build:] State entered after the first allocation, and before the
first assembly; in this state it is possible to add nonzero entries.
\item[Assembled:] State entered after the assembly; computations using
the sparse matrix, such as matrix-vector products, are only possible
in this state;
\item[Update:] State entered after a reinitalization; this is used to
handle applications in which the same sparsity pattern is used
multiple times with different coefficients. In this state it is only
possible to enter coefficients for already existing nonzero entries.
\end{description}
\subsubsection{Named Constants}
\label{sec:sp_constants}
\begin{description}
\item[psb\_nztotreq\_] Request to fetch the total number of nonzeroes
stored in a sparse matrix
\item[psb\_nzrowreq\_] Request to fetch the number of nonzeroes in a
given row in a sparse matrix
\item[psb\_dupl\_ovwrt\_] Duplicate coefficients should be overwritten
(i.e. ignore duplications)
\item[psb\_dupl\_add\_] Duplicate coefficients should be added;
\item[psb\_dupl\_err\_] Duplicate coefficients should trigger an error conditino
\item[psb\_upd\_dflt\_] Default update strategy for matrix coefficients;
\item[psb\_upd\_srch\_] Update strategy based on search into the data structure;
\item[psb\_upd\_perm\_] Update strategy based on additional
permutation data (see tools routine description).
\end{description}
\subsection{Descriptor data structure} \subsection{Descriptor data structure}
@ -196,6 +228,41 @@ end type psb_desc_type
contains the communication descriptor.} contains the communication descriptor.}
\end{figure} \end{figure}
A communication descriptor associated with a sparse matrix has a
state, which can take the following values:
\begin{description}
\item[Build:] State entered after the first allocation, and before the
first assembly; in this state it is possible to add communication
requirements among different processes.
\item[Assembled:] State entered after the assembly; computations using
the associated sparse matrix, such as matrix-vector products, are
only possible in this state.
\end{description}
\subsubsection{Named Constants}
\label{sec:cd_constants}
\begin{description}
\item[psb\_none\_] Generic no-op;
\item[psb\_nohalo\_] Do not fetch halo elements;
\item[psb\_halo\_] Fetch halo elements from neighbouring processes;
\item[psb\_sum\_] Sum overlapped elements
\item[psb\_avg\_] Average overlapped elements
%% \item[psb\_square\_root\_] Update with the square root of the average
%% of overlapped elements;
\item[psb\_dec\_type\_] Entry holding decomposition type (in \verb|desc_a%matrix_data|)
\item[psb\_m\_] Entry holding total number of rows
\item[psb\_n\_] Entry holding total number of columns
\item[ psb\_n\_row\_] Entry holding the number of rows stored in the
current process
\item[psb\_n\_col\_] Entry holding the number of columns stored in the
current process
\item[psb\_ctxt\_] Entry holding a copy of the BLACS communication context
\item[psb\_desc\_asb\_] State of the descriptor: assembled,
i.e. suitable for computational tasks.
\item[psb\_desc\_bld\_] State of the descriptor: build, must be
assembled before computational use.
\end{description}
\subsection{Preconditioner data structure} \subsection{Preconditioner data structure}
\label{sec:prec} \label{sec:prec}
PSBLAS-2.0 offers the possibility to use many different types of PSBLAS-2.0 offers the possibility to use many different types of
@ -203,8 +270,9 @@ preconditioning schemes. Besides the simple well known preconditioners
like Diagonal Scaling or Block Jacobi (with ILU(0) incomplete like Diagonal Scaling or Block Jacobi (with ILU(0) incomplete
factorization) also more complex preconditioning methods are factorization) also more complex preconditioning methods are
implemented like the Additive Schwarz and Two-Level ones. A implemented like the Additive Schwarz and Two-Level ones. A
preconditioner is held in the \hypertarget{precdata}{{\tt psb\_prec\_type}} data structure preconditioner is held in the \hypertarget{precdata}{{\tt
which depends on the \verb|psb_base_prec| reported in psb\_prec\_type}} data structure which depends on the
\verb|psb_base_prec| reported in
figure~\ref{fig:prectype}. The \verb|psb_base_prec| figure~\ref{fig:prectype}. The \verb|psb_base_prec|
data type may contain a simple preconditioning matrix with the data type may contain a simple preconditioning matrix with the
associated communication descriptor which may be different than the associated communication descriptor which may be different than the
@ -216,7 +284,7 @@ The user can choose the type of preconditioner to be used by means of
the \verb|psb_precset| subroutine; once the type of preconditioning the \verb|psb_precset| subroutine; once the type of preconditioning
method is specified, along with all the parameters that characterize method is specified, along with all the parameters that characterize
it, the preconditioner data structure can be built using the it, the preconditioner data structure can be built using the
\verb|psb_precbuild| subroutine. \verb|psb_precbld| subroutine.
This data structure wants to be flexible enough to easily allow the This data structure wants to be flexible enough to easily allow the
implementation of new kind of preconditioners. The values contained in implementation of new kind of preconditioners. The values contained in
the \verb|iprcparm| and \verb|dprcparm| define tha type of the \verb|iprcparm| and \verb|dprcparm| define tha type of
@ -257,8 +325,24 @@ to be interpreted.
\end{center} \end{center}
\caption{\label{fig:prectype}The PSBLAS defined data type that contains a preconditioner.} \caption{\label{fig:prectype}The PSBLAS defined data type that contains a preconditioner.}
\end{figure} \end{figure}
\subsubsection{Named Constants}
\label{sec:prec_constants}
\begin{description}
\item[f\_ilu\_n\_] Incomplete LU factorization with $n$ levels of
fill-in; currently only $n=0$ is implemented;
\item[f\_slu\_] Sparse factorization using SuperLU;
\item[f\_umf\_] Sparse factorization using UMFPACK;
\item[add\_ml\_prec\_] Additive multilevel correction;
\item[mult\_ml\_prec\_] Multiplicative multilevel correction;
\item[pre\_smooth\_] Pre-smoothing in applying multiplicative
multilevel corrections;
\item[post\_smooth\_] Post-smoothing in applying multiplicative
multilevel corrections;
\item[smooth\_both\_] Two-sided (i.e. symmetric) smoothing in applying multiplicative
multilevel corrections;
\item[mat\_distr\_] Coarse matrix distributed among processes
\item[mat\_repl\_] Coarse matrix replicated among processes
\end{description}
%%% Local Variables: %%% Local Variables:

@ -124,6 +124,15 @@ internally defined in the PSBLAS software package:
Interface overloading allows the usage of the same subroutine Interface overloading allows the usage of the same subroutine
interfaces for both real and complex data. interfaces for both real and complex data.
\end{itemize} \end{itemize}
In the description of the subroutines, arguments or argument entries
are classified as:
\begin{description}
\item[global] For input arguments, the value must be the same on all processes
participating in the subroutine call; for output arguments the value
is guaranteed to be the same.
\item[local] Each process has its own value(s) independently.
\end{description}
%%% Local Variables: %%% Local Variables:
%%% mode: latex %%% mode: latex

@ -23,7 +23,7 @@ or
according to the value passed through the istop argument (see later). according to the value passed through the istop argument (see later).
\syntax{call psb\_cgs}{a,prec,b,x,eps,desc\_a,info,itmax,iter,err,itrace,istop} \syntax{call psb\_cg}{a,prec,b,x,eps,desc\_a,info,itmax,iter,err,itrace,istop}
\begin{description} \begin{description}
\item[\bf On Entry] \item[\bf On Entry]
@ -57,7 +57,7 @@ Scope: {\bf global} \\
Type: {\bf optional}\\ Type: {\bf optional}\\
Default: $itmax = 1000$.\\ Default: $itmax = 1000$.\\
Specified as: an integer variable $itmax \ge 1$. Specified as: an integer variable $itmax \ge 1$.
\item[itrace] A tracing parameter.\\ \item[itrace] If $>0$ print out a convergence message every $itrace$ iterations.\\
Scope: {\bf global} \\ Scope: {\bf global} \\
Type: {\bf optional}\\ Type: {\bf optional}\\
\item[istop] An integer specifying the stopping criterion.\\ \item[istop] An integer specifying the stopping criterion.\\

@ -10,14 +10,14 @@
This subroutine is an interface to the computational kernel for This subroutine is an interface to the computational kernel for
dense matrix sum: dense matrix sum:
\[ y \leftarrow \alpha\> x+ \beta y \] \[ y \leftarrow \alpha\> x+ \beta y \]
where: %% where:
\begin{description} %% \begin{description}
\item[$x$] represents the global dense submatrix $x_{:, jx:jx+n-1}$ %% \item[$x$] represents the global dense submatrix $x_{:, :1}$
\item[$y$] represents the global dense submatrix $y_{:, jy:jy+n-1}$ %% \item[$y$] represents the global dense submatrix $y_{:, :}$
\end{description} %% \end{description}
\syntax{call psb\_geaxpby}{alpha, x, beta, y, desc\_a, info} \syntax{call psb\_geaxpby}{alpha, x, beta, y, desc\_a, info}
\syntax*{call psb\_geaxpby}{alpha, x, beta, y, desc\_a, info, n, jx, jy} %% \syntax*{call psb\_geaxpby}{alpha, x, beta, y, desc\_a, info, n, jx, jy}
%( calculating y <- alpha*x+beta*y ) %( calculating y <- alpha*x+beta*y )
\begin{table}[h] \begin{table}[h]
@ -44,7 +44,7 @@ Specified as: a number of the data type indicated in Table~\ref{tab:f90axpby}.
$x$.\\ $x$.\\
Scope: {\bf local} \\ Scope: {\bf local} \\
Type: {\bf required} \\ Type: {\bf required} \\
Specified as: a rank one or two array with the POINTER attribute Specified as: a rank one or two array
containing numbers of type containing numbers of type
specified in Table~\ref{tab:f90axpby}. The rank of $x$ must be the same of $y$. specified in Table~\ref{tab:f90axpby}. The rank of $x$ must be the same of $y$.
\item[beta] the scalar $\beta$.\\ \item[beta] the scalar $\beta$.\\
@ -55,30 +55,29 @@ Specified as: a number of the data type indicated in Table~\ref{tab:f90axpby}.
$y$. \\ $y$. \\
Scope: {\bf local} \\ Scope: {\bf local} \\
Type: {\bf required} \\ Type: {\bf required} \\
Specified as: a rank one or two array with the POINTER Specified as: a rank one or two array containing numbers of the type
attributecontaining numbers of the type
indicated in Table~\ref{tab:f90axpby}. The rank of $y$ must be the same of $x$. indicated in Table~\ref{tab:f90axpby}. The rank of $y$ must be the same of $x$.
\item[desc\_a] contains data structures for communications.\\ \item[desc\_a] contains data structures for communications.\\
Scope: {\bf local} \\ Scope: {\bf local} \\
Type: {\bf required}\\ Type: {\bf required}\\
Specified as: a structured data of type \descdata. Specified as: a structured data of type \descdata.
\item[n] number of columns in dense submatrices $x$ and $y$.\\ %% \item[n] number of columns in dense submatrices $x$ and $y$.\\
Scope: {\bf global} \\ %% Scope: {\bf global} \\
Type: {\bf optional}; can only be present if $x$ and $y$ are of rank 2.\\ %% Type: {\bf optional}; can only be present if $x$ and $y$ are of rank 2.\\
Default: \verb|min(size(x,2),size(y,2))|.\\ %% Default: \verb|min(size(x,2),size(y,2))|.\\
Specified as: an integer variable $n\ge 0$. %% Specified as: an integer variable $n\ge 0$.
\item[jx] the column index of the global dense matrix $x$, %% \item[jx] the column index of the global dense matrix $x$,
identifying the first column of the submatrix $x$.\\ %% identifying the first column of the submatrix $x$.\\
Scope: {\bf global} \\ %% Scope: {\bf global} \\
Type: {\bf optional}; can only be present if $x$ and $y$ are of rank 2.\\ %% Type: {\bf optional}; can only be present if $x$ and $y$ are of rank 2.\\
Default: $jx = 1$.\\ %% Default: $jx = 1$.\\
Specified as: an integer variable $jx\ge 1$. %% Specified as: an integer variable $jx\ge 1$.
\item[jy] the column index of the global dense matrix $y$, %% \item[jy] the column index of the global dense matrix $y$,
identifying the first column of the submatrix $y$.\\ %% identifying the first column of the submatrix $y$.\\
Scope: {\bf global} \\ %% Scope: {\bf global} \\
Type: {\bf optional}; can only be present if $x$ and $y$ are of rank 2.\\ %% Type: {\bf optional}; can only be present if $x$ and $y$ are of rank 2.\\
Default: $jy = 1$.\\ %% Default: $jy = 1$.\\
Specified as: an integer variable $jy\ge 1$. %% Specified as: an integer variable $jy\ge 1$.
\end{description} \end{description}
@ -111,14 +110,14 @@ computes dot-product as:
\[dot \leftarrow x^T y\] \[dot \leftarrow x^T y\]
Else if $x$ and $y$ are double precision complex vectors then computes dot-product as: Else if $x$ and $y$ are double precision complex vectors then computes dot-product as:
\[dot \leftarrow x^H y\] \[dot \leftarrow x^H y\]
where: %% where:
\begin{description} %% \begin{description}
\item[$x$] represents the global subvector $x_{:,jx}$ %% \item[$x$] represents the global subvector $x_{:,jx}$
\item[$y$] represents the global subvector $y_{:,jy}$ %% \item[$y$] represents the global subvector $y_{:,jy}$
\end{description} %% \end{description}
\syntax{psb\_gedot}{x, y, desc\_a, info} \syntax{psb\_gedot}{x, y, desc\_a, info}
\syntax*{psb\_gedot}{x, y, desc\_a, info, jx, jy} %% \syntax*{psb\_gedot}{x, y, desc\_a, info, jx, jy}
\begin{table}[h] \begin{table}[h]
\begin{center} \begin{center}
\begin{tabular}{ll} \begin{tabular}{ll}
@ -136,37 +135,39 @@ Long Precision Complex & psb\_gedot \\
\begin{description} \begin{description}
\item[\bf On Entry] \item[\bf On Entry]
\item[x] the local portion of global dense matrix \item[x] the local portion of global dense matrix
$x$. This function computes the location of the first element of $x$.\\
local subarray used, based on $jx$ and the field $matrix\_data$ of $desc\_a$ . \\ %% This function computes the location of the first element of
%% local subarray used, based on $jx$ and the field $matrix\_data$ of $desc\_a$ . \\
Scope: {\bf local} \\ Scope: {\bf local} \\
Type: {\bf required} \\ Type: {\bf required} \\
Specified as: a pointer to array of rank one or two Specified as: an array of rank one or two
containing numbers of type specified in containing numbers of type specified in
Table~\ref{tab:f90dot}. The rank of $x$ must be the same of $y$. Table~\ref{tab:f90dot}. The rank of $x$ must be the same of $y$.
\item[y] the local portion of global dense matrix \item[y] the local portion of global dense matrix
$y$. This function computes the location of the first element of $y$. \\
local subarray used, based on $iy, jy$ and the field $matrix\_data$ of $desc\_a$ . \\ %% This function computes the location of the first element of
%% local subarray used, based on $iy, jy$ and the field $matrix\_data$ of $desc\_a$ . \\
Scope: {\bf local} \\ Scope: {\bf local} \\
Type: {\bf required} \\ Type: {\bf required} \\
Specified as: a pointer to array of rank one or two Specified as: an array of rank one or two
containing numbers of type specified in containing numbers of type specified in
Table~\ref{tab:f90dot}. The rank of $y$ must be the same of $x$. Table~\ref{tab:f90dot}. The rank of $y$ must be the same of $x$.
\item[desc\_a] contains data structures for communications.\\ \item[desc\_a] contains data structures for communications.\\
Scope: {\bf local} \\ Scope: {\bf local} \\
Type: {\bf required}\\ Type: {\bf required}\\
Specified as: a structured data of type \descdata. Specified as: a structured data of type \descdata.
\item[jx] the column index of global dense matrix $x$, %% \item[jx] the column index of global dense matrix $x$,
identifying the column of subvector $x$.\\ %% identifying the column of subvector $x$.\\
Scope: {\bf global} \\ %% Scope: {\bf global} \\
Type: {\bf optional}; can only be present if $x$ and $y$ are of rank 2.\\ %% Type: {\bf optional}; can only be present if $x$ and $y$ are of rank 2.\\
Default: $jx = 1$.\\ %% Default: $jx = 1$.\\
\item[jy] the column index of global dense matrix $y$, %% \item[jy] the column index of global dense matrix $y$,
identifying the column of subvector $y$.\\ %% identifying the column of subvector $y$.\\
Scope: {\bf global} \\ %% Scope: {\bf global} \\
Type: {\bf optional}; can only be present if $x$ and $y$ are of rank 2.\\ %% Type: {\bf optional}; can only be present if $x$ and $y$ are of rank 2.\\
Default: $jy = 1$.\\ %% Default: $jy = 1$.\\
Specified as: an integer variable $jy\ge 1$. %% Specified as: an integer variable $jy\ge 1$.
\item[\bf On Return] \item[\bf On Return]
\item[Function value] is the dot product of subvectors $x$ and $y$.\\ \item[Function value] is the dot product of subvectors $x$ and $y$.\\
Scope: {\bf global} \\ Scope: {\bf global} \\
@ -213,14 +214,14 @@ Long Precision Complex & psb\_gedot \\
$x$. \\ $x$. \\
Scope: {\bf local} \\ Scope: {\bf local} \\
Type: {\bf required} \\ Type: {\bf required} \\
Specified as: a pointer to array of rank one or two Specified as: an array of rank one or two
containing numbers of type specified in containing numbers of type specified in
Table~\ref{tab:f90mdot}. The rank of $x$ must be the same of $y$. Table~\ref{tab:f90mdot}. The rank of $x$ must be the same of $y$.
\item[y] the local portion of global dense matrix \item[y] the local portion of global dense matrix
$y$. \\ $y$. \\
Scope: {\bf local} \\ Scope: {\bf local} \\
Type: {\bf required} \\ Type: {\bf required} \\
Specified as: a pointer to array of rank one or two Specified as: an array of rank one or two
containing numbers of type specified in containing numbers of type specified in
Table~\ref{tab:f90mdot}. The rank of $y$ must be the same of $x$. Table~\ref{tab:f90mdot}. The rank of $y$ must be the same of $x$.
\item[desc\_a] contains data structures for communications.\\ \item[desc\_a] contains data structures for communications.\\
@ -232,7 +233,7 @@ Specified as: a structured data of type \descdata.
Scope: {\bf global} \\ Scope: {\bf global} \\
Specified as: a number or a rank-one array of the data type indicated Specified as: a number or a rank-one array of the data type indicated
in Table~\ref{tab:f90dot}. in Table~\ref{tab:f90dot}.
\item[info] the local portion of result submatrix $y$.\\ \item[info]
Scope: {\bf local} \\ Scope: {\bf local} \\
Type: {\bf required} \\ Type: {\bf required} \\
An integer value that contains an error code. An integer value that contains an error code.
@ -254,13 +255,13 @@ computes infinity norm as:
\[ amax \leftarrow \max_i |x_i|\] \[ amax \leftarrow \max_i |x_i|\]
else if $x$ is a double precision complex vector then computes infinity-norm as: else if $x$ is a double precision complex vector then computes infinity-norm as:
\[ amax \leftarrow \max_i {(|re(x_i)| + |im(x_i)|)}\] \[ amax \leftarrow \max_i {(|re(x_i)| + |im(x_i)|)}\]
where: %% where:
\begin{description} %% \begin{description}
\item[$x$] represents the global subvector $x_{:,jx}$ %% \item[$x$] represents the global subvector $x_{:,jx}$
\end{description} %% \end{description}
\syntax{psb\_geamax}{x, desc\_a, info} \syntax{psb\_geamax}{x, desc\_a, info}
\syntax*{psb\_geamax}{x, desc\_a, info, jx} %% \syntax*{psb\_geamax}{x, desc\_a, info, jx}
\begin{table}[h] \begin{table}[h]
\begin{center} \begin{center}
@ -280,30 +281,31 @@ Long Precision Real&Long Precision Complex & psb\_geamax \\
\begin{description} \begin{description}
\item[\bf On Entry] \item[\bf On Entry]
\item[x] the local portion of global dense matrix \item[x] the local portion of global dense matrix
$x$. This function computes the location of the first element of $x$. %% This function computes the location of the first element of
local subarray used, based on $jx$ and the field $matrix\_data$ of $desc\_a$ . \\ %% local subarray used, based on $jx$ and the field $matrix\_data$ of $desc\_a$ .
\\
Scope: {\bf local} \\ Scope: {\bf local} \\
Type: {\bf required} \\ Type: {\bf required} \\
Specified as: a rank one or two array with the POINTER attribute Specified as: a rank one or two array
containing numbers of type specified in containing numbers of type specified in
Table~\ref{tab:f90amax}. Table~\ref{tab:f90amax}.
\item[desc\_a] contains data structures for communications.\\ \item[desc\_a] contains data structures for communications.\\
Scope: {\bf local} \\ Scope: {\bf local} \\
Type: {\bf required}\\ Type: {\bf required}\\
Specified as: a structured data of type \descdata. Specified as: a structured data of type \descdata.
\item[jx] the column index of global dense matrix $x$, %% \item[jx] the column index of global dense matrix $x$,
identifying the column of subvector $x$.\\ %% identifying the column of subvector $x$.\\
Scope: {\bf global} \\ %% Scope: {\bf global} \\
Type: {\bf optional}; can only be present if $x$ is of rank 2.\\ %% Type: {\bf optional}; can only be present if $x$ is of rank 2.\\
Default: $jx = 1$\\ %% Default: $jx = 1$\\
Specified as: an integer variable $jx\ge 1$. %% Specified as: an integer variable $jx\ge 1$.
\item[\bf On Return] \item[\bf On Return]
\item[Function value] is the infinity norm of subvector $x$.\\ \item[Function value] is the infinity norm of subvector $x$.\\
Scope: {\bf global} \\ Scope: {\bf global} \\
Specified as: a number of the data type indicated in Table~\ref{tab:f90amax}. Specified as: a long precision real number.
\item[info] the local portion of result submatrix $y$.\\ \item[info]
Scope: {\bf local} \\ Scope: {\bf global} \\
Type: {\bf required} \\ Type: {\bf required} \\
An integer value that contains an error code. An integer value that contains an error code.
\end{description} \end{description}
@ -340,7 +342,7 @@ Long Precision Real &Long Precision Complex & psb\_geamax\\
$x$. \\ $x$. \\
Scope: {\bf local} \\ Scope: {\bf local} \\
Type: {\bf required} \\ Type: {\bf required} \\
Specified as: a rank one or two array with the POINTER attribute Specified as: a rank one or two array
containing numbers of type specified in containing numbers of type specified in
Table~\ref{tab:f90mamax}. Table~\ref{tab:f90mamax}.
\item[desc\_a] contains data structures for communications.\\ \item[desc\_a] contains data structures for communications.\\
@ -350,9 +352,8 @@ Specified as: a structured data of type \descdata.
\item[\bf On Return] \item[\bf On Return]
\item[res] is the infinity norm of the columns of $x$.\\ \item[res] is the infinity norm of the columns of $x$.\\
Scope: {\bf global} \\ Scope: {\bf global} \\
Specified as: a number or a rank-one array of the data type indicated Specified as: a number or a rank-one array of long precision real numbers.
in Table~\ref{tab:f90amax}. \item[info]
\item[info] the local portion of result submatrix $y$.\\
Scope: {\bf local} \\ Scope: {\bf local} \\
Type: {\bf required} \\ Type: {\bf required} \\
An integer value that contains an error code. An integer value that contains an error code.
@ -373,22 +374,18 @@ computes 1-norm as:
\[ asum \leftarrow \|x_i\|\] \[ asum \leftarrow \|x_i\|\]
else if $x$ ic double precision complex vector then computes 1-norm as: else if $x$ ic double precision complex vector then computes 1-norm as:
\[ asum \leftarrow \|re(x)\|_1 + \|im(x)\|_1\] \[ asum \leftarrow \|re(x)\|_1 + \|im(x)\|_1\]
where:
\begin{description}
\item[$x$] represents the global subvector $x_{:,jx}$
\end{description}
\syntax{psb\_geasum}{x, desc\_a, info} \syntax{psb\_geasum}{x, desc\_a, info}
\syntax*{psb\_geasum}{x, desc\_a, info, jx}
\begin{table}[h] \begin{table}[h]
\begin{center} \begin{center}
\begin{tabular}{ll} \begin{tabular}{lll}
\hline \hline
$dot$, $x$, $y$ & {\bf Function}\\ $asum$ & $x$ & {\bf Function}\\
\hline \hline
Long Precision Real & psb\_geasum \\ Long Precision Real&Long Precision Real & psb\_geasum \\
Long Precision Complex & psb\_geasum \\ Long Precision Real&Long Precision Complex & psb\_geasum \\
\hline \hline
\end{tabular} \end{tabular}
\end{center} \end{center}
@ -398,29 +395,24 @@ Long Precision Complex & psb\_geasum \\
\begin{description} \begin{description}
\item[\bf On Entry] \item[\bf On Entry]
\item[x] the local portion of global dense matrix \item[x] the local portion of global dense matrix
$x$. This function computes the location of the first element of $x$. %% This function computes the location of the first element of
local subarray used, based on $jx$ and the field $matrix\_data$ of $desc\_a$ . \\ %% local subarray used, based on the field $matrix\_data$ of $desc\_a$ .
\\
Scope: {\bf local} \\ Scope: {\bf local} \\
Type: {\bf required} \\ Type: {\bf required} \\
Specified as: a rank one or two array with the POINTER attribute Specified as: a rank one or two array
containing numbers of type specified in containing numbers of type specified in
Table~\ref{tab:f90asum}. Table~\ref{tab:f90asum}.
\item[desc\_a] contains data structures for communications.\\ \item[desc\_a] contains data structures for communications.\\
Scope: {\bf local} \\ Scope: {\bf local} \\
Type: {\bf required}\\ Type: {\bf required}\\
Specified as: a structured data of type \descdata. Specified as: a structured data of type \descdata.
\item[jx] the column index of global dense matrix $x$,
identifying the column of subvector $x$.\\
Scope: {\bf global} \\
Type: {\bf optional}; can only be present if $x$ is of rank 2.\\
Default: $jx = 1$\\
Specified as: an integer variable $jx\ge 1$.
\item[\bf On Return] \item[\bf On Return]
\item[Function value] is the 1-norm of subvector $x$.\\ \item[Function value] is the 1-norm of vector $x$.\\
Scope: {\bf global} \\ Scope: {\bf global} \\
Specified as: a number of the data type indicated in Table~\ref{tab:f90asum}. Specified as: a long precision real number.
\item[info] the local portion of result submatrix $y$.\\ \item[info]
Scope: {\bf local} \\ Scope: {\bf local} \\
Type: {\bf required} \\ Type: {\bf required} \\
An integer value that contains an error code. An integer value that contains an error code.
@ -442,19 +434,19 @@ computes 2-norm as:
\[ nrm2 \leftarrow \sqrt{x^T x}\] \[ nrm2 \leftarrow \sqrt{x^T x}\]
else if $x$ is double precision complex vector then computes 2-norm as: else if $x$ is double precision complex vector then computes 2-norm as:
\[ nrm2 \leftarrow \sqrt{x^H x}\] \[ nrm2 \leftarrow \sqrt{x^H x}\]
where: %% where:
\begin{description} %% \begin{description}
\item[$x$] represents the global subvector $x_{:,jx}$ %% \item[$x$] represents the global subvector $x_{:,jx}$
\end{description} %% \end{description}
\begin{table}[h] \begin{table}[h]
\begin{center} \begin{center}
\begin{tabular}{ll} \begin{tabular}{lll}
\hline \hline
$nrm2$, $x$ & {\bf Function}\\ $nrm2$ & $x$ & {\bf Function}\\
\hline \hline
Long Precision Real & psb\_genrm2 \\ Long Precision Real&Long Precision Real & psb\_genrm2 \\
Long Precision Complex & psb\_genrm2 \\ Long Precision Real&Long Precision Complex & psb\_genrm2 \\
\hline \hline
\end{tabular} \end{tabular}
\end{center} \end{center}
@ -462,34 +454,35 @@ Long Precision Complex & psb\_genrm2 \\
\end{table} \end{table}
\syntax{psb\_genrm2}{x, desc\_a, info} \syntax{psb\_genrm2}{x, desc\_a, info}
\syntax*{psb\_genrm2}{x, desc\_a, info, jx} %% \syntax*{psb\_genrm2}{x, desc\_a, info, jx}
\begin{description} \begin{description}
\item[\bf On Entry] \item[\bf On Entry]
\item[x] the local portion of global dense matrix \item[x] the local portion of global dense matrix
$x$. This function computes the location of the first element of $x$.%% This function computes the location of the first element of
local subarray used, based on $jx$ and the field $matrix\_data$ of $desc\_a$ . \\ %% local subarray used, based on $jx$ and the field $matrix\_data$ of $desc\_a$ .
\\
Scope: {\bf local} \\ Scope: {\bf local} \\
Type: {\bf required} \\ Type: {\bf required} \\
Specified as: a rank one or two array with the POINTER attribute Specified as: a rank one or two array
containing numbers of type specified in containing numbers of type specified in
Table~\ref{tab:f90nrm2}. Table~\ref{tab:f90nrm2}.
\item[desc\_a] contains data structures for communications.\\ \item[desc\_a] contains data structures for communications.\\
Scope: {\bf local} \\ Scope: {\bf local} \\
Type: {\bf required}\\ Type: {\bf required}\\
Specified as: a structured data of type \descdata. Specified as: a structured data of type \descdata.
\item[jx] the column index of global dense matrix $x$, %% \item[jx] the column index of global dense matrix $x$,
identifying the column of subvector $x$.\\ %% identifying the column of subvector $x$.\\
Scope: {\bf global} \\ %% Scope: {\bf global} \\
Type: {\bf optional}; can only be present if $x$ is of rank 2.\\ %% Type: {\bf optional}; can only be present if $x$ is of rank 2.\\
Default: $jx = 1$\\ %% Default: $jx = 1$\\
Specified as: an integer variable $jx\ge 1$. %% Specified as: an integer variable $jx\ge 1$.
\item[\bf On Return] \item[\bf On Return]
\item[Function Value] is the 2-norm of subvector $x$.\\ \item[Function Value] is the 2-norm of subvector $x$.\\
Scope: {\bf global} \\ Scope: {\bf global} \\
Type: {\bf required} \\ Type: {\bf required} \\
Specified as: a number of the data type indicated in Table~\ref{tab:f90nrm2}. Specified as: a long precision real number.
\item[info] the local portion of result submatrix $y$.\\ \item[info]
Scope: {\bf local} \\ Scope: {\bf local} \\
Type: {\bf required} \\ Type: {\bf required} \\
An integer value that contains an error code. An integer value that contains an error code.
@ -516,7 +509,7 @@ where:
\begin{center} \begin{center}
\begin{tabular}{ll} \begin{tabular}{ll}
\hline \hline
$nrmi$, $A$ & {\bf Function}\\ $A$ & {\bf Function}\\
\hline \hline
Long Precision Real & psb\_spnrmi \\ Long Precision Real & psb\_spnrmi \\
Long Precision Complex & psb\_spnrmi \\ Long Precision Complex & psb\_spnrmi \\
@ -542,8 +535,8 @@ Specified as: a structured data of type \descdata.
\item[\bf On Return] \item[\bf On Return]
\item[Function value] is the infinity-norm of sparse submatrix $A$.\\ \item[Function value] is the infinity-norm of sparse submatrix $A$.\\
Scope: {\bf global} \\ Scope: {\bf global} \\
Specified as: a number of the data type indicated in Table~\ref{tab:f90nrmi}. Specified as: a long precision real number.
\item[info] the local portion of result submatrix $y$.\\ \item[info]
Scope: {\bf local} \\ Scope: {\bf local} \\
Type: {\bf required} \\ Type: {\bf required} \\
An integer value that contains an error code. An integer value that contains an error code.
@ -576,8 +569,8 @@ y \leftarrow \alpha P_r A^H P_c x + \beta y
where: where:
\begin{description} \begin{description}
\item[$x$] is the global dense submatrix $x_{:, jx:jx+k-1}$ \item[$x$] is the global dense submatrix $x_{:, :}$
\item[$y$] is the global dense submatrix $y_{:, jy:jy+k-1}$ \item[$y$] is the global dense submatrix $y_{:, :}$
\item[$A$] is the global sparse submatrix $A$ \item[$A$] is the global sparse submatrix $A$
\item[$P_r, P_c$] are the permutation matrices. \item[$P_r, P_c$] are the permutation matrices.
\end{description} \end{description}
@ -598,7 +591,7 @@ Long Precision Complex & psb\_spmm \\
\syntax{CALL psb\_spmm}{alpha, a, x, beta, y, desc\_a, info} \syntax{CALL psb\_spmm}{alpha, a, x, beta, y, desc\_a, info}
\syntax*{CALL psb\_spmm}{alpha, a, x, beta, y,desc\_a, info, \syntax*{CALL psb\_spmm}{alpha, a, x, beta, y,desc\_a, info,
trans, k, jx, jy, work} trans, work}
\begin{description} \begin{description}
\item[\bf On Entry] \item[\bf On Entry]
@ -613,11 +606,12 @@ Scope: {\bf local} \\
Type: {\bf required}\\ Type: {\bf required}\\
Specified as: a structured data of type \spdata. Specified as: a structured data of type \spdata.
\item[x] the local portion of global dense matrix \item[x] the local portion of global dense matrix
$x$. This subroutine computes the location of the first element of $x$. %% This subroutine computes the location of the first element of
local subarray used, based on $jx$ and the field $matrix\_data$ of $desc\_a$ . \\ %% local subarray used, based on $jx$ and the field $matrix\_data$ of $desc\_a$ .
\\
Scope: {\bf local} \\ Scope: {\bf local} \\
Type: {\bf required} \\ Type: {\bf required} \\
Specified as: a rank one or two array with the POINTER attribute Specified as: a rank one or two array
containing numbers of type specified in containing numbers of type specified in
Table~\ref{tab:f90spmm}. The rank of $x$ must be the same of $y$. Table~\ref{tab:f90spmm}. The rank of $x$ must be the same of $y$.
\item[beta] the scalar $\beta$.\\ \item[beta] the scalar $\beta$.\\
@ -625,11 +619,12 @@ Scope: {\bf global} \\
Type: {\bf required} \\ Type: {\bf required} \\
Specified as: a number of the data type indicated in Table~\ref{tab:f90spmm}. Specified as: a number of the data type indicated in Table~\ref{tab:f90spmm}.
\item[y] the local portion of global dense matrix \item[y] the local portion of global dense matrix
$y$. This subroutine computes the location of the first element of $y$. %% This subroutine computes the location of the first element of
local subarray used, based on $jy$ and the field $matrix\_data$ of $desc\_a$ . \\ %% local subarray used, based on $jy$ and the field $matrix\_data$ of $desc\_a$ .
\\
Scope: {\bf local} \\ Scope: {\bf local} \\
Type: {\bf required} \\ Type: {\bf required} \\
Specified as: a rank one or two array with the POINTER attribute Specified as: a rank one or two array
containing numbers of type specified in containing numbers of type specified in
Table~\ref{tab:f90spmm}. The rank of $y$ must be the same of $x$. Table~\ref{tab:f90spmm}. The rank of $y$ must be the same of $x$.
\item[desc\_a] contains data structures for communications.\\ \item[desc\_a] contains data structures for communications.\\
@ -648,37 +643,38 @@ Scope: {\bf global} \\
Type: {\bf optional}\\ Type: {\bf optional}\\
Default: $trans = N$\\ Default: $trans = N$\\
Specified as: a character variable. Specified as: a character variable.
\item[k] number of columns in dense submatrices $x$ and $y$. \\ %% \item[k] number of columns in dense submatrices $x$ and $y$. \\
Scope: {\bf global} \\ %% Scope: {\bf global} \\
Type: {\bf optional}\\ %% Type: {\bf optional}\\
Default: \verb|min(size(x,2)-jx+1,size(y,2)-jy+1)|\\ %% Default: \verb|min(size(x,2)-jx+1,size(y,2)-jy+1)|\\
Specified as: an integer variable $ k \ge 1$. %% Specified as: an integer variable $ k \ge 1$.
\item[jx] the column index of global dense matrix $x$, %% \item[jx] the column index of global dense matrix $x$,
identifying the column of subvector $x$.\\ %% identifying the column of subvector $x$.\\
Scope: {\bf global} \\ %% Scope: {\bf global} \\
Type: {\bf optional}; can only be present if $x$ is of rank 2.\\ %% Type: {\bf optional}; can only be present if $x$ is of rank 2.\\
Default: $iy = 1$\\ %% Default: $iy = 1$\\
Specified as: an integer variable $jx\ge 1$. %% Specified as: an integer variable $jx\ge 1$.
\item[jy] the column index of global dense matrix $y$, %% \item[jy] the column index of global dense matrix $y$,
identifying the column of subvector $y$.\\ %% identifying the column of subvector $y$.\\
Scope: {\bf global} \\ %% Scope: {\bf global} \\
Type: {\bf optional}; can only be present if $y$ is of rank 2.\\ %% Type: {\bf optional}; can only be present if $y$ is of rank 2.\\
Default: $jy = 1$\\ %% Default: $jy = 1$\\
Specified as: an integer variable $jy\ge 1$. %% Specified as: an integer variable $jy\ge 1$.
\item[work] the work array.\\ \item[work] work array.\\
Scope: {\bf local} \\ Scope: {\bf local} \\
Type: {\bf optional}\\
Specified as: a rank one array of the same type of $x$ and $y$ with Specified as: a rank one array of the same type of $x$ and $y$ with
the POINTER attribute. the TARGET attribute.
\item[\bf On Return] \item[\bf On Return]
\item[y] the local portion of result submatrix $y$.\\ \item[y] the local portion of result submatrix $y$.\\
Scope: {\bf local} \\ Scope: {\bf local} \\
Type: {\bf required} \\ Type: {\bf required} \\
Specified as: a pointer to array of rank one or two Specified as: an array of rank one or two
containing numbers of type specified in containing numbers of type specified in
Table~\ref{tab:f90spmm}. Table~\ref{tab:f90spmm}.
\item[info] the local portion of result submatrix $y$.\\ \item[info]
Scope: {\bf local} \\ Scope: {\bf local} \\
Type: {\bf required} \\ Type: {\bf required} \\
An integer value that contains an error code. An integer value that contains an error code.
@ -710,8 +706,8 @@ y &\leftarrow& \alpha P_r T^{-H} P_c D x + \beta y\\
where: where:
\begin{description} \begin{description}
\item[$x$] is the global dense submatrix $x_{:, jx:jx+n-1}$ \item[$x$] is the global dense submatrix $x_{:, :}$
\item[$y$] is the global dense submatrix $y_{:, jy:jy+n-1}$ \item[$y$] is the global dense submatrix $y_{:, :}$
\item[$T$] is the global sparse block triangular submatrix $T$ \item[$T$] is the global sparse block triangular submatrix $T$
\item[$D$] is the scaling diagonal matrix. \item[$D$] is the scaling diagonal matrix.
\item[$P_r, P_c$] are the permutation matrices. \item[$P_r, P_c$] are the permutation matrices.
@ -719,7 +715,7 @@ where:
\syntax{CALL psb\_spsm}{alpha, t, x, beta, y, desc\_a, info} \syntax{CALL psb\_spsm}{alpha, t, x, beta, y, desc\_a, info}
\syntax*{CALL psb\_spsm}{alpha, t, x, beta, y, desc\_a, info, \syntax*{CALL psb\_spsm}{alpha, t, x, beta, y, desc\_a, info,
trans, unit, choice, diag, n, jx, jy, work} trans, unit, choice, diag, work}
\begin{table}[h] \begin{table}[h]
\begin{center} \begin{center}
@ -751,11 +747,12 @@ Type: {\bf required}\\
Specified as: a structured data type specified in Specified as: a structured data type specified in
\S~\ref{sec:datastruct}. \S~\ref{sec:datastruct}.
\item[x] the local portion of global dense matrix \item[x] the local portion of global dense matrix
$x$. This subroutine computes the location of the first element of $x$. %% This subroutine computes the location of the first element of
local subarray used, based on $jx$ and the field $matrix\_data$ of $desc\_a$ . \\ %% local subarray used, based on $jx$ and the field $matrix\_data$ of $desc\_a$ .
\\
Scope: {\bf local} \\ Scope: {\bf local} \\
Type: {\bf required} \\ Type: {\bf required} \\
Specified as: a rank one or two array with the POINTER attribute Specified as: a rank one or two array
containing numbers of type specified in containing numbers of type specified in
Table~\ref{tab:f90spsm}. The rank of $x$ must be the same of $y$. Table~\ref{tab:f90spsm}. The rank of $x$ must be the same of $y$.
\item[beta] the scalar $\beta$.\\ \item[beta] the scalar $\beta$.\\
@ -763,11 +760,12 @@ Scope: {\bf global} \\
Type: {\bf required} \\ Type: {\bf required} \\
Specified as: a number of the data type indicated in Table~\ref{tab:f90spsm}. Specified as: a number of the data type indicated in Table~\ref{tab:f90spsm}.
\item[y] the local portion of global dense matrix \item[y] the local portion of global dense matrix
$y$. This subroutine computes the location of the first element of $y$. %% This subroutine computes the location of the first element of
local subarray used, based on $jy$ and the field $matrix\_data$ of $desc\_a$ . \\ %% local subarray used, based on $jy$ and the field $matrix\_data$ of $desc\_a$ .
\\
Scope: {\bf local} \\ Scope: {\bf local} \\
Type: {\bf required} \\ Type: {\bf required} \\
Specified as: a rank one or two array with the POINTER attribute Specified as: a rank one or two array
containing numbers of type specified in containing numbers of type specified in
Table~\ref{tab:f90spsm}. The rank of $y$ must be the same of $x$. Table~\ref{tab:f90spsm}. The rank of $y$ must be the same of $x$.
\item[desc\_a] contains data structures for communications.\\ \item[desc\_a] contains data structures for communications.\\
@ -794,57 +792,41 @@ Scope: {\bf global} \\
Type: {\bf optional}\\ Type: {\bf optional}\\
Default: $unitd = U$\\ Default: $unitd = U$\\
Specified as: a character variable. Specified as: a character variable.
\item[choice] specify whether a cleanup of the overlapped elements is \item[choice] specifies the update of overlap elements to be performed
required on exit. on exit:
\begin{description} \begin{description}
\item[choice = .false.] no cleanup on exit \item \verb|psb_none_|
\item[choice = .true.] cleanup on exit.\\ \item \verb|psb_sum_|
\item \verb|psb_avg_|
\item \verb|psb_square_root_|
\end{description} \end{description}
Scope: {\bf global} \\ Scope: {\bf global} \\
Type: {\bf optional}\\ Type: {\bf optional}\\
Default: $choice = .true.$\\ Default: \verb|psb_avg_|\\
Specified as: a logical variable. Specified as: an integer variable.
\item[diag] the diagonal scaling matrix.\\ \item[diag] the diagonal scaling matrix.\\
Scope: {\bf local} \\ Scope: {\bf local} \\
Type: {\bf optional}\\ Type: {\bf optional}\\
Default: $diag(1) = 1 (no scaling)$\\ Default: $diag(1) = 1 (no scaling)$\\
Specified as: a rank one array containing numbers of the type Specified as: a rank one array containing numbers of the type
indicated in Table~\ref{tab:f90spsm}. indicated in Table~\ref{tab:f90spsm}.
\item[n] number of columns in dense submatrices $x$ and $y$. \\ \item[work] a work array. \\
Scope: {\bf global} \\
Type: {\bf optional}\\
Default: \verb|min(size(x,2)-jx+1,size(y,2)-jy+1)|\\
Specified as: an integer variable $ n \ge 0$.
\item[jx] the column index of global dense matrix $x$,
identifying the column of subvector $x$.\\
Scope: {\bf global} \\
Type: {\bf optional}; can only be present if $x$ is of rank 2.\\
Default: $jx = 1 $\\
Specified as: an integer variable $jx\ge 1$.
\item[jy] the column index of global dense matrix $y$,
identifying the column of subvector $y$.\\
Scope: {\bf global} \\
Type: {\bf optional}; can only be present if $y$ is of rank 2.\\
Default: $jy = 1 $\\
Specified as: an integer variable $jy\ge 1$. \\
Scope: {\bf global} \\
Specified as: a number of the data type indicated in Table~\ref{tab:f90spsm}.
\item[work] the work array. \\
Scope: {\bf local} \\ Scope: {\bf local} \\
Type: {\bf optional}\\ Type: {\bf optional}\\
Specified as: a rank one array of the same type of $x$ with the Specified as: a rank one array of the same type of $x$ with the
POINTER attribute. TARGET attribute.
\item[\bf On Return] \item[\bf On Return]
\item[y] the local portion of global dense matrix \item[y] the local portion of global dense matrix
$y$. This subroutine computes the location of the first element of $y$. %% This subroutine computes the location of the first element of
local subarray used, based on $jy$ and the field $matrix\_data$ of $desc\_a$ . \\ %% local subarray used, based on $jy$ and the field $matrix\_data$ of $desc\_a$ .
\\
Scope: {\bf local} \\ Scope: {\bf local} \\
Type: {\bf required} \\ Type: {\bf required} \\
Specified as: a pointer to array of rank one or two Specified as: a pointer to array of rank one or two
containing numbers of type specified in containing numbers of type specified in
Table~\ref{tab:f90spsm}. Table~\ref{tab:f90spsm}.
\item[info] the local portion of result submatrix $y$.\\ \item[info]
Scope: {\bf local} \\ Scope: {\bf local} \\
Type: {\bf required} \\ Type: {\bf required} \\
An integer value that contains an error code. An integer value that contains an error code.

@ -1,291 +1,116 @@
\section{Data management and initialization routines} \section{Data management and initialization routines}
\label{sec:toolsrout} \label{sec:toolsrout}
%
%% psb_alloc %%
%
\subroutine{psb\_geall}{Allocates a dense matrix}
\syntax{call psb\_geall}{m, n, x, desc\_a, info, js}
\begin{description}
\item[\bf On Entry]
\item[m] The number of rows of the dense matrix to be allocated.\\
Scope: {\bf local} \\
Type: {\bf required}\\
Specified as: Integer scalar.
\item[n] The number of columns of the dense matrix to be allocated.\\
Scope: {\bf local} \\
Type: {\bf required}\\
Specified as: Integer scalar.
\item[desc\_a] The communication descriptor.\\
Scope: {\bf local} \\
Type: {\bf required}\\
Specified as: a variable of type \descdata.\\
\item[js] The starting column.\\
Scope: {\bf local} \\
Type: {\bf optional}\\
Specified as: Integer scalar.
\end{description}
\begin{description}
\item[\bf On Return]
\item[x] The dense matrix to be allocated.\\
Scope: {\bf local} \\
Type: {\bf required}\\
Specified as: a one or two dimensional array.\\
\item[info] Error code.
Scope: {\bf local} \\
Type: {\bf required}\\
Specified as: Integer scalar.
\end{description}
% %
%% psb_asb %% %% psb_cdall %%
%
\subroutine{psb\_geasb}{Assembly a dense matrix}
\syntax{call psb\_geasb}{x, desc\_a, info}
\begin{description}
\item[\bf On Entry]
\item[desc\_a] The communication descriptor.\\
Scope: {\bf local} \\
Type: {\bf required}\\
Specified as: a variable of type \descdata.\\
\end{description}
\begin{description}
\item[\bf On Return]
\item[x] The dense matrix to be assembled.\\
Scope: {\bf local} \\
Type: {\bf required}\\
Specified as: a one or two dimensional array.\\
\item[info] Error code.\\
Scope: {\bf local} \\
Type: {\bf required}\\
Specified as: Integer scalar.\\
\end{description}
%
%% psb_csrp %%
%
\subroutine{psb\_csrp}{Applies a right permutation to a sparse matrix}
\syntax{call psb\_csrp}{trans, iperm, a, desc\_a, info}
\begin{description}
\item[\bf On Entry]
\item[trans] A character that specifies whether to permute $A$ or $A^T$.\\
Scope: {\bf local} \\
Type: {\bf required}\\
Specified as: a single character with value 'N' for $A$ or 'T' for $A^T$.\\
\item[iperm] An integer array containing permutation information.\\
Scope: {\bf local} \\
Type: {\bf required}\\
Specified as: an integer one-dimensional array.\\
\item[a] The sparse matrix to be permuted.\\
Scope: {\bf local} \\
Type: {\bf required}\\
Specified as: a \spdata variable.\\
\item[desc\_a] The communication descriptor of type \descdata.\\
Scope: {\bf local} \\
Type: {\bf required}\\
Specified as: a variable of type \descdata.\\
\end{description}
\begin{description}
\item[\bf On Return]
\item[info] Error code.\\
Scope: {\bf local} \\
Type: {\bf required}\\
Specified as: Integer scalar.\\
\end{description}
%
%% psb_descprt %%
%
\subroutine{psb\_cdprt}{Prints a descriptor}
\syntax{call psb\_cdprt}{iout, desc\_a, glob, short}
\begin{description}
\item[\bf On Entry]
\item[iout] An integer that defines the output unit.
Scope: {\bf local} \\
Type: {\bf required}\\
Specified as: Integer scalar.\\
\item[desc\_a] The communication descriptor of type \descdata that
must be printed.\\
Scope: {\bf local} \\
Type: {\bf required}\\
Specified as: a variable of type \descdata.\\
\end{description}
\begin{description}
\item[\bf On Return]
\item[glob] ??????
\item[short] ??????
\end{description}
%
%% psb_free %%
%
\subroutine{psb\_gefree}{Frees a dense matrix}
\syntax{call psb\_gefree}{x, desc\_a, info}
\begin{description}
\item[\bf On Entry]
\item[x] The dense matrix to
be freed.\\
Scope: {\bf local} \\
Type: {\bf required}\\
Specified as: a one or two dimensional array.
\item[desc\_a] The communication descriptor.\\
Scope: {\bf local} \\
Type: {\bf required}\\
Specified as: a variable of type \descdata.\\
\end{description}
\begin{description}
\item[\bf On Return]
\item[info] Error code.\\
Scope: {\bf local} \\
Type: {\bf required}\\
Specified as: Integer scalar.\\
\end{description}
%
%% psb_gelp %%
% %
\subroutine{psb\_gelp}{Applies a left permutation to a dense matrix} \subroutine{psb\_cdall}{Allocates a communication descriptor}
\syntax{call psb\_gelp}{trans, iperm, x, desc\_a, info}
\begin{description} \syntax{call psb\_cdall}{m, n, parts, icontxt, desc\_a, info}
\item[\bf On Entry] \syntax*{call psb\_cdall}{m, v, icontxt, desc\_a, info, flag}
\item[trans] A character that specifies whether to permute $A$ or $A^T$.\\
Scope: {\bf local} \\
Type: {\bf required}\\
Specified as: a single character with value 'N' for $A$ or 'T' for $A^T$.\\
\item[iperm] An integer array containing permutation information.\\
Scope: {\bf local} \\
Type: {\bf required}\\
Specified as: an integer one-dimensional array.\\
\item[x] The dense matrix to be permuted.\\
Scope: {\bf local} \\
Type: {\bf required}\\
Specified as: a one or two dimensional array.\\
\item[desc\_a] The communication descriptor.\\
Scope: {\bf local} \\
Type: {\bf required}\\
Specified as: a variable of type \descdata.\\
\end{description}
This subroutine initializes the communication descriptor associated
with an index space. It takes two forms depending on whether the user
specifies the domain partitioning through a subroutine or through a vector
\begin{description} \begin{description}
\item[\bf On Return] \item[\bf First Form: On Entry ]
\item[info] Error code.\\ \item[m] the number of rows of the problem.\\
Scope: {\bf local} \\ Scope:{\bf global}.\\
Type: {\bf required}\\ Type:{\bf required}.\\
Specified as: Integer scalar.\\ Specified as: an integer value.
\item[n] the number of columns of the problem.\\
Scope:{\bf global}.\\
Type:{\bf required}.\\
Specified as: an integer value. Currently constrained to be $m=n$.
\item[parts] the subroutine that defines the partitioning scheme.\\
Scope:{\bf global}.\\
Type:{\bf required}.\\
Specified as: a subroutine.
\item[icontxt] the communication context.\\
Scope:{\bf global}.\\
Type:{\bf required}.\\
Specified as: an integer value.
\end{description} \end{description}
%
%% psb_spins %%
%
\subroutine{psb\_spins}{Insert a cloud of elements into a sparse matrix}
\syntax{call psb\_spins}{nz, ia, ja, val, a, desc\_a, info, is, js}
\begin{description} \begin{description}
\item[\bf On Entry] \item[\bf Second Form: On Entry ]
\item[nz] the number of elements to be inserted.\\ \item[m] the size of the index space.\\
Scope:{\bf local}.\\ Scope:{\bf global}.\\
Type:{\bf required}.\\
Specified as: an integer scalar.
\item[ia] the row indices of the elements to be inserted.\\
Scope:{\bf local}.\\
Type:{\bf required}.\\ Type:{\bf required}.\\
Specified as: an integer array of size $nz$. Specified as: an integer value $m>0$.
\item[ja] the column indices of the elements to be inserted.\\ \item[v] Data allocation: each index $i\in \{1\dots m\}$ is allocated
Scope:{\bf local}.\\ to process $v(i)$.
Scope:{\bf global}.\\
Type:{\bf required}.\\ Type:{\bf required}.\\
Specified as: an integer array of size $nz$. Specified as: an integer array of size $m$.
\item[val] the elements to be inserted.\\ \item[icontxt] the communication context.\\
Scope:{\bf local}.\\ Scope:{\bf global}.\\
Type:{\bf required}.\\ Type:{\bf required}.\\
Specified as: an array of size $nz$. Specified as: an integer value.
\item[desc\_a] The communication descriptor.\\ \item[flag] Specifies whether entries in $v$ are zero- or one-based.
Scope: {\bf local}. \\ Scope:{\bf global}.\\
Type: {\bf required}.\\
Specified as: a variable of type \descdata.\\
\item[is] the starting row on matrix $a$.\\
Scope:{\bf local}.\\
Type:{\bf optional}.\\ Type:{\bf optional}.\\
Specified as: an integer vaule. Specified as: an integer value $0,1$, default $0$.
\item[js] the starting column on matrix $a$.\\
Scope:{\bf local}.\\
Type:{\bf optional}\\
Specified as: an integer value
\end{description} \end{description}
\begin{description} \begin{description}
\item[\bf On Return] \item[\bf On Return]
\item[a] the matrix into which elements will be inserted.\\ \item[desc\_a] the communication descriptor.\\
Scope:{\bf local}\\ Scope:{\bf local}.\\
Type:{\bf required}\\ Type:{\bf required}.\\
Specified as: a structured data of type \spdata. Specified as: a structured data of type \descdata.
\item[info] Error code.\\ \item[info] Error code.
Scope: {\bf local} \\ Scope: {\bf local} \\
Type: {\bf required}\\ Type: {\bf required}\\
Specified as: an integer variable.\\
\end{description} \end{description}
% %
%% psb_cdall %% %% psb_cdins %%
% %
\subroutine{psb\_cdall}{Allocates a communication descriptor} \subroutine{psb\_cdins}{Communication descriptor insert routine}
\syntax{call psb\_cdall}{m, n, parts, icontxt, desc\_a, info} \syntax{call psb\_cdins}{nz, ia, ja, desc\_a, info}
\syntax*{call psb\_cdall}{m, v, icontxt, desc\_a, info, flag}
\begin{description} \begin{description}
\item[\bf On Entry] \item[\bf On Entry]
\item[m] the number of rows of the problem.\\ \item[nz] the number of points being inserted.\\
Scope:{\bf global}.\\ Scope: {\bf local}.\\
Type:{\bf required}.\\ Type: {\bf required}.\\
Specified as: an integer value.
\item[n] the number of columns of the problem.\\
Scope:{\bf global}.\\
Type:{\bf required}.\\
Specified as: an integer value.
\item[parts] the subroutine that defines the partitioning scheme.\\
Scope:{\bf global}.\\
Type:{\bf required}.\\
Specified as: a subroutine as described in ???
\item[icontxt] the communication context.\\
Scope:{\bf global}.\\
Type:{\bf required}.\\
Specified as: an integer value. Specified as: an integer value.
\item[ia] the row indices of the points being inserted.\\
Scope: {\bf local}.\\
Type: {\bf required}.\\
Specified as: an integer array of length $nz$.
\item[ja] the column indices of the points being inserted.\\
Scope: {\bf local}.\\
Type: {\bf required}.\\
Specified as: an integer array of length $nz$.
%% \item[is] the row offset.\\
%% Scope:{\bf local}.\\
%% Type:{\bf optional}.\\
%% Specified as: an integer value.
%% \item[js] the column offset.\\
%% Scope: {\bf local}.\\
%% Type: {\bf optional}.\\
%% Specified as: an integer value.
\end{description} \end{description}
\begin{description} \begin{description}
\item[\bf On Return] \item[\bf On Return]
\item[desc\_a] the communication descriptor.\\ \item[desc\_a] the communication descriptor to be freed.\\
Scope:{\bf local}.\\ Scope:{\bf local}.\\
Type:{\bf required}.\\ Type:{\bf required}.\\
Specified as: a structured data of type \descdata. Specified as: a structured data of type \descdata.
\item[info] Error code. \item[info] Error code.
Scope: {\bf local} \\ Scope: {\bf local} \\
Type: {\bf required}\\ Type: {\bf required}\\
Specified as: an integer variable.\\ Specified as: an integer variable.
\end{description} \end{description}
% %
%% psb_cdasb %% %% psb_cdasb %%
% %
@ -307,7 +132,7 @@ Specified as: a structured data of type \descdata.
Scope: {\bf local} \\ Scope: {\bf local} \\
Type: {\bf required}\\ Type: {\bf required}\\
Specified as: an integer variable. Specified as: an integer variable.
\item[arg] %\item[arg]
\end{description} \end{description}
@ -365,76 +190,96 @@ Specified as: an integer variable.
\end{description} \end{description}
%% %
%% %% psb_cdren %%
%% %
%% \subroutine{psb\_cdren}{Applies a renumeration to a communication descriptor}
%% \syntax{call psb\_cdren}{trans, iperm, desc\_a, info}
%% \begin{description}
%% \item[\bf On Entry]
%% \item[trans] A character that specifies whether to permute $A$ or $A^T$.\\
%% Scope: {\bf local} \\
%% Type: {\bf required}\\
%% Specified as: a single character with value 'N' for $A$ or 'T' for $A^T$.\\
%% \item[iperm] An integer array containing permutation information.\\
%% Scope: {\bf local} \\
%% Type: {\bf required}\\
%% Specified as: an integer one-dimensional array.\\
%% \item[desc\_a] the communication descriptor.\\
%% Scope:{\bf local}.\\
%% Type:{\bf required}.\\
%% Specified as: a structured data of type \descdata.
%% \end{description}
%% \begin{description}
%% \item[\bf On Return]
%% \item[info] Error code.
%% Scope: {\bf local} \\
%% Type: {\bf required}\\
%% Specified as: an integer variable.
%% \end{description}
% %
%% psb_cdins %% %% psb_descprt %%
% %
\subroutine{psb\_cdins}{Comunnication descriptor insert routine} %% \subroutine{psb\_cdprt}{Prints a descriptor}
\syntax{call psb\_cdins}{nz, ia, ja, desc\_a, info, is, js} %% \syntax{call psb\_cdprt}{iout, desc\_a, glob, short}
\begin{description} %% \begin{description}
\item[\bf On Entry] %% \item[\bf On Entry]
\item[nz] the number of points being inserted.\\ %% \item[iout] An integer that defines the output unit.
Scope: {\bf local}.\\ %% Scope: {\bf local} \\
Type: {\bf required}.\\ %% Type: {\bf required}\\
Specified as: an integer value. %% Specified as: Integer scalar.\\
\item[ia] the row indices of the points being inserted.\\ %% \item[desc\_a] The communication descriptor of type \descdata that
Scope: {\bf local}.\\ %% must be printed.\\
Type: {\bf required}.\\ %% Scope: {\bf local} \\
Specified as: an integer array of length $nz$. %% Type: {\bf required}\\
\item[ja] the column indices of the points being inserted.\\ %% Specified as: a variable of type \descdata.\\
Scope: {\bf local}.\\ %% \end{description}
Type: {\bf required}.\\
Specified as: an integer array of length $nz$.
\item[is] the row offset.\\
Scope:{\bf local}.\\
Type:{\bf optional}.\\
Specified as: an integer value.
\item[js] the column offset.\\
Scope: {\bf local}.\\
Type: {\bf optional}.\\
Specified as: an integer value.
\end{description}
\begin{description} %% \begin{description}
\item[\bf On Return] %% \item[\bf On Return]
\item[desc\_a] the communication descriptor to be freed.\\ %% \item[glob] ??????
Scope:{\bf local}.\\ %% \item[short] ??????
Type:{\bf required}.\\ %% \end{description}
Specified as: a structured data of type \descdata.
\item[info] Error code.
Scope: {\bf local} \\
Type: {\bf required}\\
Specified as: an integer variable.
\end{description}
% %
%% psb_cdren %% %% psb_spalloc %%
% %
\subroutine{psb\_cdren}{Applies a renumeration to a communication descriptor} \subroutine{psb\_spall}{Allocates a sparse matrix}
\syntax{call psb\_cdren}{trans, iperm, desc\_a, info} \syntax{call psb\_spall}{a, desc\_a, info, nnz}
\begin{description} \begin{description}
\item[\bf On Entry] \item[\bf On Entry]
\item[trans] A character that specifies whether to permute $A$ or $A^T$.\\
Scope: {\bf local} \\
Type: {\bf required}\\
Specified as: a single character with value 'N' for $A$ or 'T' for $A^T$.\\
\item[iperm] An integer array containing permutation information.\\
Scope: {\bf local} \\
Type: {\bf required}\\
Specified as: an integer one-dimensional array.\\
\item[desc\_a] the communication descriptor.\\ \item[desc\_a] the communication descriptor.\\
Scope:{\bf local}.\\ Scope:{\bf local}.\\
Type:{\bf required}.\\ Type:{\bf required}.\\
Specified as: a structured data of type \descdata. Specified as: a structured data of type \descdata.
\item[nnz] the number of nonzeroes in the local part of the assembled matrix.\\
Scope: {\bf global}.\\
Type: {\bf optional}.\\
Specified as: an integer value. Note: a good estimate for the number
of nonzeroes in the assembled matrix may substantially improve
performance in the matrix build phase, as it will reduce or eliminate
the need for multiple data allocation.
\end{description} \end{description}
\begin{description} \begin{description}
\item[\bf On Return] \item[\bf On Return]
\item[a] the matrix to be allocated.\\
Scope:{\bf local}\\
Type:{\bf required}\\
Specified as: a structured data of type \spdata.
\item[info] Error code. \item[info] Error code.
Scope: {\bf local} \\ Scope: {\bf local} \\
Type: {\bf required}\\ Type: {\bf required}\\
@ -444,44 +289,66 @@ Specified as: an integer variable.
% %
%% psb_spalloc %% %% psb_spins %%
% %
\subroutine{psb\_spall}{Allocates a sparse matrix} \subroutine{psb\_spins}{Insert a cloud of elements into a sparse matrix}
\syntax{call psb\_spall}{a, desc\_a, info, nnz} \syntax{call psb\_spins}{nz, ia, ja, val, a, desc\_a, info}
\begin{description} \begin{description}
\item[\bf On Entry] \item[\bf On Entry]
\item[desc\_a] the communication descriptor.\\ \item[nz] the number of elements to be inserted.\\
Scope:{\bf local}.\\ Scope:{\bf local}.\\
Type:{\bf required}.\\ Type:{\bf required}.\\
Specified as: a structured data of type \descdata. Specified as: an integer scalar.
\item[nnz] the number of nonzeroes in the matrix.\\ \item[ia] the row indices of the elements to be inserted.\\
Scope: {\bf global}.\\ Scope:{\bf local}.\\
Type: {\bf optional}.\\ Type:{\bf required}.\\
Specified as: an integer value. Specified as: an integer array of size $nz$.
\item[ja] the column indices of the elements to be inserted.\\
Scope:{\bf local}.\\
Type:{\bf required}.\\
Specified as: an integer array of size $nz$.
\item[val] the elements to be inserted.\\
Scope:{\bf local}.\\
Type:{\bf required}.\\
Specified as: an array of size $nz$.
\item[desc\_a] The communication descriptor.\\
Scope: {\bf local}. \\
Type: {\bf required}.\\
Specified as: a variable of type \descdata.\\
%% \item[is] the starting row on matrix $a$.\\
%% Scope:{\bf local}.\\
%% Type:{\bf optional}.\\
%% Specified as: an integer vaule.
%% \item[js] the starting column on matrix $a$.\\
%% Scope:{\bf local}.\\
%% Type:{\bf optional}\\
%% Specified as: an integer value
\end{description} \end{description}
\begin{description} \begin{description}
\item[\bf On Return] \item[\bf On Return]
\item[a] the matrix to be allocated.\\ \item[a] the matrix into which elements will be inserted.\\
Scope:{\bf local}\\ Scope:{\bf local}\\
Type:{\bf required}\\ Type:{\bf required}\\
Specified as: a structured data of type \spdata. Specified as: a structured data of type \spdata.
\item[info] Error code. \item[desc\_a] The communication descriptor.\\
Scope: {\bf local}. \\
Type: {\bf required}.\\
Specified as: a variable of type \descdata.\\
\item[info] Error code.\\
Scope: {\bf local} \\ Scope: {\bf local} \\
Type: {\bf required}\\ Type: {\bf required}\\
Specified as: an integer variable.
\end{description} \end{description}
% %
%% psb_spasb %% %% psb_spasb %%
% %
\subroutine{psb\_spasb}{Sparse matrix assembly routine} \subroutine{psb\_spasb}{Sparse matrix assembly routine}
\syntax{call psb\_spasb}{a, desc\_a, info, afmt, up, dup} \syntax{call psb\_spasb}{a, desc\_a, info, afmt, upd, dupl}
\begin{description} \begin{description}
\item[\bf On Entry] \item[\bf On Entry]
@ -492,15 +359,16 @@ Specified as: a structured data of type \descdata.
\item[afmt] the storage format for the sparse matrix.\\ \item[afmt] the storage format for the sparse matrix.\\
Scope: {\bf global}.\\ Scope: {\bf global}.\\
Type: {\bf optional}.\\ Type: {\bf optional}.\\
Specified as: an array of characters. If not specified 'CSR' will be assumed. Specified as: an array of characters. Defalt: 'CSR'.
\item[up] ???.\\ \item[upd] Provide for updates to the matrix coefficients.\\
Scope: {\bf global}.\\ Scope: {\bf global}.\\
Type: {\bf optional}.\\ Type: {\bf optional}.\\
Specified as: . Specified as: integer, possible values: \verb|psb_upd_srch_|, \verb|psb_upd_perm_|
\item[dup] ???.\\ \item[dupl] How to handle duplicate coefficients.\\
Scope: {\bf global}.\\ Scope: {\bf global}.\\
Type: {\bf optional}.\\ Type: {\bf optional}.\\
Specified as: Specified as: integer, possible values: \verb|psb_dupl_ovwrt_|,
\verb|psb_dupl_add_|, \verb|psb_dupl_err_|.
\end{description} \end{description}
\begin{description} \begin{description}
@ -517,16 +385,49 @@ Specified as: an integer variable.
%% %
%% %% psb_spcnv %%
%% %
%% \subroutine{psb\_spcnv}{Converts a sparse matrix storage format}
%% \syntax{call psb\_spcnv}{a, b, desc\_a, info}
%% \begin{description}
%% \item[\bf On Entry]
%% \item[a] the matrix to be converted.\\
%% Scope:{\bf local}\\
%% Type:{\bf required}\\
%% Specified as: a structured data of type \spdata.
%% \item[desc\_a] the communication descriptor.\\
%% Scope:{\bf local}.\\
%% Type:{\bf required}.\\
%% Specified as: a structured data of type \descdata.
%% \end{description}
%% \begin{description}
%% \item[\bf On Return]
%% \item[b] the converted matrix.\\
%% Scope:{\bf local}\\
%% Type:{\bf required}\\
%% Specified as: a structured data of type \spdata.
%% \item[info] Error code.
%% Scope: {\bf local} \\
%% Type: {\bf required}\\
%% Specified as: an integer variable.
%% \end{description}
% %
%% psb_spcnv %% %% psb_spfree %%
% %
\subroutine{psb\_spcnv}{Converts a sparse matrix storage format} \subroutine{psb\_spfree}{Frees a sparse matrix}
\syntax{call psb\_spcnv}{a, b, desc\_a, info} \syntax{call psb\_spfree}{a, desc\_a, info}
\begin{description} \begin{description}
\item[\bf On Entry] \item[\bf On Entry]
\item[a] the matrix to be converted.\\ \item[a] the matrix to be freed.\\
Scope:{\bf local}\\ Scope:{\bf local}\\
Type:{\bf required}\\ Type:{\bf required}\\
Specified as: a structured data of type \spdata. Specified as: a structured data of type \spdata.
@ -538,10 +439,6 @@ Specified as: a structured data of type \descdata.
\begin{description} \begin{description}
\item[\bf On Return] \item[\bf On Return]
\item[b] the converted matrix.\\
Scope:{\bf local}\\
Type:{\bf required}\\
Specified as: a structured data of type \spdata.
\item[info] Error code. \item[info] Error code.
Scope: {\bf local} \\ Scope: {\bf local} \\
Type: {\bf required}\\ Type: {\bf required}\\
@ -550,16 +447,17 @@ Specified as: an integer variable.
% %
%% psb_spfree %% %% psb_sprn %%
% %
\subroutine{psb\_spfree}{Frees a sparse matrix} \subroutine{psb\_sprn}{Reinit sparse matrix structure for psblas routines.}
\syntax{call psb\_spfree}{a, desc\_a, info} \syntax{call psb\_sprn}{a, decsc\_a, info}
\begin{description} \begin{description}
\item[\bf On Entry] \item[\bf On Entry]
\item[a] the matrix to be freed.\\ \item[a] the matrix to be reinitialized.\\
Scope:{\bf local}\\ Scope:{\bf local}\\
Type:{\bf required}\\ Type:{\bf required}\\
Specified as: a structured data of type \spdata. Specified as: a structured data of type \spdata.
@ -577,6 +475,88 @@ Type: {\bf required}\\
Specified as: an integer variable. Specified as: an integer variable.
\end{description} \end{description}
%
%% psb_spupdate %%
%
%% \subroutine{psb\_spupdate}{Updates a sparse matrix.}
%% \syntax{call psb\_spupdate}{a, ia, ja, blck, desc\_a, info, ix, jx, updflag}
%% \begin{description}
%% \item[\bf On Entry]
%% \end{description}
%% \begin{description}
%% \item[\bf On Return]
%% \end{description}
%% %
%% %% psb_csrp %%
%% %
%% \subroutine{psb\_csrp}{Applies a right permutation to a sparse matrix}
%% \syntax{call psb\_csrp}{trans, iperm, a, desc\_a, info}
%% \begin{description}
%% \item[\bf On Entry]
%% \item[trans] A character that specifies whether to permute $A$ or $A^T$.\\
%% Scope: {\bf local} \\
%% Type: {\bf required}\\
%% Specified as: a single character with value 'N' for $A$ or 'T' for $A^T$.\\
%% \item[iperm] An integer array containing permutation information.\\
%% Scope: {\bf local} \\
%% Type: {\bf required}\\
%% Specified as: an integer one-dimensional array.\\
%% \item[a] The sparse matrix to be permuted.\\
%% Scope: {\bf local} \\
%% Type: {\bf required}\\
%% Specified as: a \spdata variable.\\
%% \item[desc\_a] The communication descriptor of type \descdata.\\
%% Scope: {\bf local} \\
%% Type: {\bf required}\\
%% Specified as: a variable of type \descdata.\\
%% \end{description}
%% \begin{description}
%% \item[\bf On Return]
%% \item[info] Error code.\\
%% Scope: {\bf local} \\
%% Type: {\bf required}\\
%% Specified as: Integer scalar.\\
%% \end{description}
%
%% psb_alloc %%
%
\subroutine{psb\_geall}{Allocates a dense matrix}
\syntax{call psb\_geall}{x, desc\_a, info, n}
\begin{description}
\item[\bf On Entry]
\item[desc\_a] The communication descriptor.\\
Scope: {\bf local} \\
Type: {\bf required}\\
Specified as: a variable of type \descdata.\\
\item[n] The number of columns of the dense matrix to be allocated.\\
Scope: {\bf local} \\
Type: {\bf optional}\\
Specified as: Integer scalar, default $1$. It is ignored if $x$ is a
rank-1 array.
\end{description}
\begin{description}
\item[\bf On Return]
\item[x] The dense matrix to be allocated.\\
Scope: {\bf local} \\
Type: {\bf required}\\
Specified as: a rank one or two array with the POINTER
attribute, of type real, complex or integer.\\
\item[info] Error code.
Scope: {\bf local} \\
Type: {\bf required}\\
Specified as: Integer scalar.
\end{description}
% %
@ -584,7 +564,8 @@ Specified as: an integer variable.
% %
\subroutine{psb\_geins}{Dense matrix insertion routine} \subroutine{psb\_geins}{Dense matrix insertion routine}
\syntax{call psb\_geins}{m, n, x, ix, jx, blck, desc\_a, info, iblck, jblck} \syntax{call psb\_geins}{m, n, blck, x, ix, jx, desc\_a, info,dupl}
\syntax*{call psb\_geins}{m, blck, x, ix, desc\_a, info,dupl}
\begin{description} \begin{description}
\item[\bf On Entry] \item[\bf On Entry]
@ -592,15 +573,8 @@ Specified as: an integer variable.
Scope:{\bf local}.\\ Scope:{\bf local}.\\
Type:{\bf required}.\\ Type:{\bf required}.\\
Specified as: an integer value. Specified as: an integer value.
\item[n] columns number of submatrix belonging to blck to be inserted.\\ \item[n] columns number of submatrix belonging to blck to be inserted
Scope:{\bf local}.\\ (only when $x$ is of rank 2).\\
Type:{\bf required}.\\
Specified as: an integer value.
\item[ix] x global-row corresponding to position at which blck submatrix must be inserted.\\
Scope:{\bf local}.\\
Type:{\bf required}.\\
Specified as: an integer value.
\item[jx] x global-col corresponding to position at which blck submatrix must be inserted.\\
Scope:{\bf local}.\\ Scope:{\bf local}.\\
Type:{\bf required}.\\ Type:{\bf required}.\\
Specified as: an integer value. Specified as: an integer value.
@ -608,18 +582,23 @@ Specified as: an integer value.
Scope:{\bf local}.\\ Scope:{\bf local}.\\
Type:{\bf required}.\\ Type:{\bf required}.\\
Specified as: a one or two dimensional array. Specified as: a one or two dimensional array.
\item[desc\_a] the communication descriptor.\\ \item[ix] x global-row corresponding to position at which blck submatrix must be inserted.\\
Scope:{\bf local}.\\ Scope:{\bf local}.\\
Type:{\bf required}.\\ Type:{\bf required}.\\
Specified as: a structured data of type \descdata. Specified as: an integer value.
\item[iblck] first row of submatrix belonging to blck to be inserted.\\ \item[jx] x global-col corresponding to position at which blck submatrix must be inserted (only when $x$ is of rank 2).\\
Scope:{\bf local}.\\ Scope:{\bf local}.\\
Type:{\bf required}.\\ Type:{\bf required}.\\
Specified as: an integer value. Specified as: an integer value.
\item[jblck] first column of submatrix belonging to blck to be inserted.\\ \item[desc\_a] the communication descriptor.\\
Scope:{\bf local}.\\ Scope:{\bf local}.\\
Type:{\bf required}.\\ Type:{\bf required}.\\
Specified as: an integer value. Specified as: a structured data of type \descdata.
\item[dupl] How to handle duplicate coefficients.\\
Scope: {\bf global}.\\
Type: {\bf optional}.\\
Specified as: integer, possible values: \verb|psb_dupl_ovwrt_|,
\verb|psb_dupl_add_|, \verb|psb_dupl_err_|.
\end{description} \end{description}
\begin{description} \begin{description}
@ -627,57 +606,106 @@ Specified as: an integer value.
\item[x] the output dense matrix.\\ \item[x] the output dense matrix.\\
Scope: {\bf local} \\ Scope: {\bf local} \\
Type: {\bf required}\\ Type: {\bf required}\\
Specified as: a one or two dimensional array.\\ Specified as: a rank one or two array with the POINTER
attribute, of type real, complex or integer.\\
\item[info] Error code. \item[info] Error code.
Scope: {\bf local} \\ Scope: {\bf local} \\
Type: {\bf required}\\ Type: {\bf required}\\
Specified as: an integer variable. Specified as: an integer variable.
\end{description} \end{description}
%
%% psb_asb %%
%
\subroutine{psb\_geasb}{Assembly a dense matrix}
\syntax{call psb\_geasb}{x, desc\_a, info}
\begin{description}
\item[\bf On Entry]
\item[desc\_a] The communication descriptor.\\
Scope: {\bf local} \\
Type: {\bf required}\\
Specified as: a variable of type \descdata.\\
\end{description}
\begin{description}
\item[\bf On Return]
\item[x] The dense matrix to be assembled.\\
Scope: {\bf local} \\
Type: {\bf required}\\
Specified as: a rank one or two array with the POINTER
attribute, of type real, complex or integer.\\
\item[info] Error code.\\
Scope: {\bf local} \\
Type: {\bf required}\\
Specified as: Integer scalar.\\
\end{description}
% %
%% psb_sprn %% %% psb_free %%
% %
\subroutine{psb\_sprn}{Reinit sparse matrix structure for psblas routines.} \subroutine{psb\_gefree}{Frees a dense matrix}
\syntax{call psb\_sprn}{a, decsc\_a, info} \syntax{call psb\_gefree}{x, desc\_a, info}
\begin{description} \begin{description}
\item[\bf On Entry] \item[\bf On Entry]
\item[a] the matrix to be reinitialized.\\ \item[x] The dense matrix to
Scope:{\bf local}\\ be freed.\\
Type:{\bf required}\\ Scope: {\bf local} \\
Specified as: a structured data of type \spdata. Type: {\bf required}\\
\item[desc\_a] the communication descriptor.\\ Specified as: a rank one or two array with the POINTER
Scope:{\bf local}.\\ attribute, of type real, complex or integer.\\
Type:{\bf required}.\\
Specified as: a structured data of type \descdata. \item[desc\_a] The communication descriptor.\\
Scope: {\bf local} \\
Type: {\bf required}\\
Specified as: a variable of type \descdata.\\
\end{description} \end{description}
\begin{description} \begin{description}
\item[\bf On Return] \item[\bf On Return]
\item[info] Error code. \item[info] Error code.\\
Scope: {\bf local} \\ Scope: {\bf local} \\
Type: {\bf required}\\ Type: {\bf required}\\
Specified as: an integer variable. Specified as: Integer scalar.\\
\end{description} \end{description}
% %
%% psb_spupdate %% %% psb_gelp %%
% %
%% \subroutine{psb\_spupdate}{Updates a sparse matrix.} \subroutine{psb\_gelp}{Applies a left permutation to a dense matrix}
%% \syntax{call psb\_spupdate}{a, ia, ja, blck, desc\_a, info, ix, jx, updflag}
%% \begin{description} \syntax{call psb\_gelp}{trans, iperm, x, desc\_a, info}
%% \item[\bf On Entry]
%% \end{description}
%% \begin{description} \begin{description}
%% \item[\bf On Return] \item[\bf On Entry]
%% \end{description} \item[trans] A character that specifies whether to permute $A$ or $A^T$.\\
Scope: {\bf local} \\
Type: {\bf required}\\
Specified as: a single character with value 'N' for $A$ or 'T' for $A^T$.\\
\item[iperm] An integer array containing permutation information.\\
Scope: {\bf local} \\
Type: {\bf required}\\
Specified as: an integer one-dimensional array.\\
\item[x] The dense matrix to be permuted.\\
Scope: {\bf local} \\
Type: {\bf required}\\
Specified as: a one or two dimensional array.\\
\item[desc\_a] The communication descriptor.\\
Scope: {\bf local} \\
Type: {\bf required}\\
Specified as: a variable of type \descdata.\\
\end{description}
\begin{description}
\item[\bf On Return]
\item[info] Error code.\\
Scope: {\bf local} \\
Type: {\bf required}\\
Specified as: Integer scalar.\\
\end{description}
% %

File diff suppressed because one or more lines are too long

@ -40,10 +40,9 @@
! jx - integer(optional). The starting column of the global matrix. ! jx - integer(optional). The starting column of the global matrix.
! ik - integer(optional). The number of columns to gather. ! ik - integer(optional). The number of columns to gather.
! work - real(optional). A working area. ! work - real(optional). A working area.
! choice - logical(optional). ???. ! update - integer(optional). ???.
! update_type - integer(optional). ???.
! !
subroutine psb_dovrlm(x,desc_a,info,jx,ik,work,choice,update_type) subroutine psb_dovrlm(x,desc_a,info,jx,ik,work,update)
use psb_descriptor_type use psb_descriptor_type
use psb_const_mod use psb_const_mod
use psi_mod use psi_mod
@ -56,15 +55,14 @@ subroutine psb_dovrlm(x,desc_a,info,jx,ik,work,choice,update_type)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info integer, intent(out) :: info
real(kind(1.d0)), optional, target :: work(:) real(kind(1.d0)), optional, target :: work(:)
logical, intent(in), optional :: choice integer, intent(in), optional :: update,jx,ik
integer, intent(in), optional :: update_type,jx,ik
! locals ! locals
integer :: int_err(5), icontxt, nprow, npcol, myrow, mycol,& integer :: int_err(5), icontxt, nprow, npcol, myrow, mycol,&
& err_act, m, n, iix, jjx, temp(2), ix, ijx, nrow, ncol, k, maxk, iupdate,& & err_act, m, n, iix, jjx, temp(2), ix, ijx, nrow, ncol, k, maxk, iupdate,&
& imode, err, liwork, i & imode, err, liwork, i
real(kind(1.d0)),pointer :: iwork(:), xp(:,:) real(kind(1.d0)),pointer :: iwork(:), xp(:,:)
logical :: ichoice logical :: do_update
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_dovrlm' name='psb_dovrlm'
@ -111,17 +109,13 @@ subroutine psb_dovrlm(x,desc_a,info,jx,ik,work,choice,update_type)
k = maxk k = maxk
end if end if
if (present(choice)) then if (present(update)) then
ichoice = choice iupdate = update
else else
ichoice = .true. iupdate = psb_avg_
endif
if (present(update_type)) then
iupdate = update_type
else
iupdate = psb_none_
endif endif
do_update = (iupdate /= psb_none_)
imode = IOR(psb_swap_send_,psb_swap_recv_) imode = IOR(psb_swap_send_,psb_swap_recv_)
! check vector correctness ! check vector correctness
@ -166,7 +160,7 @@ subroutine psb_dovrlm(x,desc_a,info,jx,ik,work,choice,update_type)
end if end if
! exchange overlap elements ! exchange overlap elements
if(ichoice) then if(do_update) then
xp => x(iix:size(x,1),jjx:jjx+k-1) xp => x(iix:size(x,1),jjx:jjx+k-1)
call psi_swapdata(imode,k,1.d0,xp,& call psi_swapdata(imode,k,1.d0,xp,&
& desc_a,iwork,info,data=psb_comm_ovr_) & desc_a,iwork,info,data=psb_comm_ovr_)
@ -263,10 +257,9 @@ end subroutine psb_dovrlm
! desc_a - type(<psb_desc_type>). The communication descriptor. ! desc_a - type(<psb_desc_type>). The communication descriptor.
! info - integer. Eventually returns an error code. ! info - integer. Eventually returns an error code.
! work - real(optional). A working area. ! work - real(optional). A working area.
! choice - logical(optional). ???. ! update - integer(optional). ???.
! update_type - integer(optional). ???.
! !
subroutine psb_dovrlv(x,desc_a,info,work,choice,update_type) subroutine psb_dovrlv(x,desc_a,info,work,update)
use psb_descriptor_type use psb_descriptor_type
use psi_mod use psi_mod
use psb_const_mod use psb_const_mod
@ -279,15 +272,14 @@ subroutine psb_dovrlv(x,desc_a,info,work,choice,update_type)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info integer, intent(out) :: info
real(kind(1.d0)), optional, target :: work(:) real(kind(1.d0)), optional, target :: work(:)
logical, intent(in), optional :: choice integer, intent(in), optional :: update
integer, intent(in), optional :: update_type
! locals ! locals
integer :: int_err(5), icontxt, nprow, npcol, myrow, mycol,& integer :: int_err(5), icontxt, nprow, npcol, myrow, mycol,&
& err_act, m, n, iix, jjx, temp(2), ix, ijx, nrow, ncol, k, maxk, iupdate,& & err_act, m, n, iix, jjx, temp(2), ix, ijx, nrow, ncol, k, maxk, iupdate,&
& imode, err, liwork, i & imode, err, liwork, i
real(kind(1.d0)),pointer :: iwork(:) real(kind(1.d0)),pointer :: iwork(:)
logical :: ichoice logical :: do_update
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_dovrlv' name='psb_dovrlv'
@ -320,17 +312,13 @@ subroutine psb_dovrlv(x,desc_a,info,work,choice,update_type)
k = 1 k = 1
if (present(choice)) then if (present(update)) then
ichoice = choice iupdate = update
else
ichoice = .true.
endif
if (present(update_type)) then
iupdate = update_type
else else
iupdate = psb_none_ iupdate = psb_avg_
endif endif
do_update = (iupdate /= psb_none_)
imode = IOR(psb_swap_send_,psb_swap_recv_) imode = IOR(psb_swap_send_,psb_swap_recv_)
! check vector correctness ! check vector correctness
@ -375,7 +363,7 @@ subroutine psb_dovrlv(x,desc_a,info,work,choice,update_type)
end if end if
! exchange overlap elements ! exchange overlap elements
if(ichoice) then if(do_update) then
call psi_swapdata(imode,1.d0,x(iix:size(x)),& call psi_swapdata(imode,1.d0,x(iix:size(x)),&
& desc_a,iwork,info,data=psb_comm_ovr_) & desc_a,iwork,info,data=psb_comm_ovr_)
end if end if

@ -40,10 +40,9 @@
! jx - integer(optional). The starting column of the global matrix. ! jx - integer(optional). The starting column of the global matrix.
! ik - integer(optional). The number of columns to gather. ! ik - integer(optional). The number of columns to gather.
! work - real(optional). A working area. ! work - real(optional). A working area.
! choice - logical(optional). ???. ! update - integer(optional). ???.
! update_type - integer(optional). ???.
! !
subroutine psb_zovrlm(x,desc_a,info,jx,ik,work,choice,update_type) subroutine psb_zovrlm(x,desc_a,info,jx,ik,work,update)
use psb_descriptor_type use psb_descriptor_type
use psb_const_mod use psb_const_mod
use psi_mod use psi_mod
@ -56,15 +55,14 @@ subroutine psb_zovrlm(x,desc_a,info,jx,ik,work,choice,update_type)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info integer, intent(out) :: info
complex(kind(1.d0)), optional, target :: work(:) complex(kind(1.d0)), optional, target :: work(:)
logical, intent(in), optional :: choice integer, intent(in), optional :: update,jx,ik
integer, intent(in), optional :: update_type,jx,ik
! locals ! locals
integer :: int_err(5), icontxt, nprow, npcol, myrow, mycol,& integer :: int_err(5), icontxt, nprow, npcol, myrow, mycol,&
& err_act, m, n, iix, jjx, temp(2), ix, ijx, nrow, ncol, k, maxk, iupdate,& & err_act, m, n, iix, jjx, temp(2), ix, ijx, nrow, ncol, k, maxk, iupdate,&
& imode, err, liwork, i & imode, err, liwork, i
complex(kind(1.d0)),pointer :: iwork(:), xp(:,:) complex(kind(1.d0)),pointer :: iwork(:), xp(:,:)
logical :: ichoice logical :: do_update
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_zovrlm' name='psb_zovrlm'
@ -111,17 +109,13 @@ subroutine psb_zovrlm(x,desc_a,info,jx,ik,work,choice,update_type)
k = maxk k = maxk
end if end if
if (present(choice)) then if (present(update)) then
ichoice = choice iupdate = update
else else
ichoice = .true. iupdate = psb_avg_
endif
if (present(update_type)) then
iupdate = update_type
else
iupdate = psb_none_
endif endif
do_update = (iupdate /= psb_none_)
imode = IOR(psb_swap_send_,psb_swap_recv_) imode = IOR(psb_swap_send_,psb_swap_recv_)
! check vector correctness ! check vector correctness
@ -166,7 +160,7 @@ subroutine psb_zovrlm(x,desc_a,info,jx,ik,work,choice,update_type)
end if end if
! exchange overlap elements ! exchange overlap elements
if(ichoice) then if(do_update) then
xp => x(iix:size(x,1),jjx:jjx+k-1) xp => x(iix:size(x,1),jjx:jjx+k-1)
call psi_swapdata(imode,k,zone,xp,& call psi_swapdata(imode,k,zone,xp,&
& desc_a,iwork,info,data=psb_comm_ovr_) & desc_a,iwork,info,data=psb_comm_ovr_)
@ -263,10 +257,9 @@ end subroutine psb_zovrlm
! desc_a - type(<psb_desc_type>). The communication descriptor. ! desc_a - type(<psb_desc_type>). The communication descriptor.
! info - integer. Eventually returns an error code. ! info - integer. Eventually returns an error code.
! work - real(optional). A working area. ! work - real(optional). A working area.
! choice - logical(optional). ???. ! update - integer(optional). ???.
! update_type - integer(optional). ???.
! !
subroutine psb_zovrlv(x,desc_a,info,work,choice,update_type) subroutine psb_zovrlv(x,desc_a,info,work,update)
use psb_descriptor_type use psb_descriptor_type
use psi_mod use psi_mod
use psb_const_mod use psb_const_mod
@ -279,15 +272,14 @@ subroutine psb_zovrlv(x,desc_a,info,work,choice,update_type)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info integer, intent(out) :: info
complex(kind(1.d0)), optional, target :: work(:) complex(kind(1.d0)), optional, target :: work(:)
logical, intent(in), optional :: choice integer, intent(in), optional :: update
integer, intent(in), optional :: update_type
! locals ! locals
integer :: int_err(5), icontxt, nprow, npcol, myrow, mycol,& integer :: int_err(5), icontxt, nprow, npcol, myrow, mycol,&
& err_act, m, n, iix, jjx, temp(2), ix, ijx, nrow, ncol, k, maxk, iupdate,& & err_act, m, n, iix, jjx, temp(2), ix, ijx, nrow, ncol, k, maxk, iupdate,&
& imode, err, liwork, i & imode, err, liwork, i
complex(kind(1.d0)),pointer :: iwork(:) complex(kind(1.d0)),pointer :: iwork(:)
logical :: ichoice logical :: do_update
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_zovrlv' name='psb_zovrlv'
@ -320,17 +312,13 @@ subroutine psb_zovrlv(x,desc_a,info,work,choice,update_type)
k = 1 k = 1
if (present(choice)) then if (present(update)) then
ichoice = choice iupdate = update
else
ichoice = .true.
endif
if (present(update_type)) then
iupdate = update_type
else else
iupdate = psb_none_ iupdate = psb_none_
endif endif
do_update = (iupdate /= psb_none_)
imode = IOR(psb_swap_send_,psb_swap_recv_) imode = IOR(psb_swap_send_,psb_swap_recv_)
! check vector correctness ! check vector correctness
@ -376,7 +364,7 @@ subroutine psb_zovrlv(x,desc_a,info,work,choice,update_type)
! exchange overlap elements ! exchange overlap elements
if(ichoice) then if(do_update) then
call psi_swapdata(imode,zone,x(iix:size(x)),& call psi_swapdata(imode,zone,x(iix:size(x)),&
& desc_a,iwork,info,data=psb_comm_ovr_) & desc_a,iwork,info,data=psb_comm_ovr_)
end if end if

@ -102,7 +102,7 @@ subroutine psb_dbicg(a,prec,b,x,eps,desc_a,info,&
& r(:), p(:), zt(:), pt(:), z(:), rt(:),qt(:) & r(:), p(:), zt(:), pt(:), z(:), rt(:),qt(:)
integer, pointer :: iperm(:), ipnull(:), ipsave(:), int_err(:) integer, pointer :: iperm(:), ipnull(:), ipsave(:), int_err(:)
real(kind(1.d0)) ::rerr real(kind(1.d0)) ::rerr
integer ::litmax, liter, naux, m, mglob, it, itrac,& integer ::litmax, liter, naux, m, mglob, it, itrace_,&
& nprows,npcols,me,mecol, n_row, n_col, istop_, err_act & nprows,npcols,me,mecol, n_row, n_col, istop_, err_act
character ::diagl, diagu character ::diagl, diagu
logical, parameter :: debug = .false. logical, parameter :: debug = .false.
@ -159,7 +159,7 @@ subroutine psb_dbicg(a,prec,b,x,eps,desc_a,info,&
naux=4*n_col naux=4*n_col
allocate(aux(naux),stat=info) allocate(aux(naux),stat=info)
call psb_geall(mglob,9,wwrk,desc_a,info) call psb_geall(wwrk,desc_a,info,n=9)
call psb_geasb(wwrk,desc_a,info) call psb_geasb(wwrk,desc_a,info)
if(info.ne.0) then if(info.ne.0) then
info=4011 info=4011
@ -186,9 +186,9 @@ subroutine psb_dbicg(a,prec,b,x,eps,desc_a,info,&
endif endif
if (present(itrace)) then if (present(itrace)) then
itrac = itrace itrace_ = itrace
else else
itrac = -1 itrace_ = 0
end if end if
diagl = 'u' diagl = 'u'
@ -241,15 +241,8 @@ subroutine psb_dbicg(a,prec,b,x,eps,desc_a,info,&
if (istop_ == 1) then if (istop_ == 1) then
xni = psb_geamax(x,desc_a,info) xni = psb_geamax(x,desc_a,info)
rerr = rni/(ani*xni+bni) rerr = rni/(ani*xni+bni)
if (itrac /= -1) then
if (me.eq.0) write(itrac,'(a,i4,5(2x,es10.4))') 'bicg: ',itx,rerr,rni,bni,&
&xni,ani
endif
else if (istop_ == 2) then else if (istop_ == 2) then
rerr = rni/bn2 rerr = rni/bn2
if (itrac /= -1) then
if (me.eq.0) write(itrac,'(a,i4,3(2x,es10.4))') 'bicg: ',itx,rerr,rni,bn2
endif
endif endif
if(info.ne.0) then if(info.ne.0) then
@ -261,6 +254,11 @@ subroutine psb_dbicg(a,prec,b,x,eps,desc_a,info,&
if (rerr<=eps) then if (rerr<=eps) then
exit restart exit restart
end if end if
If (itrace_ > 0) then
if ((mod(itx,itrace_)==0).and.(me == 0))&
& write(*,'(a,i4,3(2x,es10.4))') 'bicg: ',itx,rerr
end If
iteration: do iteration: do
it = it + 1 it = it + 1
@ -315,23 +313,25 @@ subroutine psb_dbicg(a,prec,b,x,eps,desc_a,info,&
if (istop_ == 1) then if (istop_ == 1) then
xni = psb_geamax(x,desc_a,info) xni = psb_geamax(x,desc_a,info)
rerr = rni/(ani*xni+bni) rerr = rni/(ani*xni+bni)
if (itrac /= -1) then
if (me.eq.0) write(itrac,'(a,i4,5(2x,es10.4))') 'bicg: ',itx,rerr,rni,bni,&
&xni,ani
endif
else if (istop_ == 2) then else if (istop_ == 2) then
rerr = rni/bn2 rerr = rni/bn2
if (itrac /= -1) then
if (me.eq.0) write(itrac,'(a,i4,3(2x,es10.4))') 'bicg: ',itx,rerr,rni,bn2
endif
endif endif
if (rerr<=eps) then if (rerr<=eps) then
exit restart exit restart
end if end if
if (itx.ge.litmax) exit restart if (itx.ge.litmax) exit restart
If (itrace_ > 0) then
if ((mod(itx,itrace_)==0).and.(me == 0))&
& write(*,'(a,i4,3(2x,es10.4))') 'bicg: ',itx,rerr
end If
end do iteration end do iteration
end do restart end do restart
If (itrace_ > 0) then
if (me == 0) write(*,'(a,i4,3(2x,es10.4))') 'bicg: ',itx,rerr
end If
if (present(err)) err=rerr if (present(err)) err=rerr
if (present(iter)) iter = itx if (present(iter)) iter = itx
if (rerr>eps) then if (rerr>eps) then

@ -102,7 +102,7 @@ Subroutine psb_dcg(a,prec,b,x,eps,desc_a,info,&
real(kind(1.d0)) ::rerr real(kind(1.d0)) ::rerr
real(kind(1.d0)) ::alpha, beta, rho, rho_old, rni, xni, bni, ani,bn2,& real(kind(1.d0)) ::alpha, beta, rho, rho_old, rni, xni, bni, ani,bn2,&
& sigma & sigma
integer :: litmax, liter, istop_, naux, m, mglob, it, itx, itrac,& integer :: litmax, liter, istop_, naux, m, mglob, it, itx, itrace_,&
& nprows,npcols,me,mecol, n_col, isvch, ich, icontxt, n_row,err_act, int_err(5) & nprows,npcols,me,mecol, n_col, isvch, ich, icontxt, n_row,err_act, int_err(5)
character ::diagl, diagu character ::diagl, diagu
logical, parameter :: exchange=.true., noexchange=.false. logical, parameter :: exchange=.true., noexchange=.false.
@ -148,7 +148,7 @@ Subroutine psb_dcg(a,prec,b,x,eps,desc_a,info,&
naux=4*n_col naux=4*n_col
allocate(aux(naux), stat=info) allocate(aux(naux), stat=info)
call psb_geall(mglob,5,wwrk,desc_a,info) call psb_geall(wwrk,desc_a,info,n=5)
call psb_geasb(wwrk,desc_a,info) call psb_geasb(wwrk,desc_a,info)
if (info.ne.0) then if (info.ne.0) then
info=4011 info=4011
@ -170,9 +170,9 @@ Subroutine psb_dcg(a,prec,b,x,eps,desc_a,info,&
endif endif
if (present(itrace)) then if (present(itrace)) then
itrac = itrace itrace_ = itrace
else else
itrac = -1 itrace_ = 0
end if end if
itx=0 itx=0
@ -243,23 +243,24 @@ Subroutine psb_dcg(a,prec,b,x,eps,desc_a,info,&
rni = psb_geamax(r,desc_a,info) rni = psb_geamax(r,desc_a,info)
xni = psb_geamax(x,desc_a,info) xni = psb_geamax(x,desc_a,info)
rerr = rni/(ani*xni+bni) rerr = rni/(ani*xni+bni)
If (itrac /= -1) Then
If (me.Eq.0) Write(itrac,'(a,i4,5(2x,es10.4))') 'cg: ',itx,rerr,rni,bni,&
&xni,ani
Endif
Else If (istop_ == 2) Then Else If (istop_ == 2) Then
rni = psb_genrm2(r,desc_a,info) rni = psb_genrm2(r,desc_a,info)
rerr = rni/bn2 rerr = rni/bn2
If (itrac /= -1) Then
If (me.Eq.0) Write(itrac,'(a,i4,3(2x,es10.4)))') 'cg: ',itx,rerr,rni,bn2
Endif
Endif Endif
if (rerr<=eps) exit restart if (rerr<=eps) exit restart
if (itx>= litmax) exit restart if (itx>= litmax) exit restart
If (itrace_ > 0) then
if ((mod(itx,itrace_)==0).and.(me == 0))&
& write(*,'(a,i4,3(2x,es10.4))') 'cg: ',itx,rerr
end If
end do iteration end do iteration
end do restart end do restart
If (itrace_ > 0) then
if (me == 0) write(*,'(a,i4,3(2x,es10.4))') 'cg: ',itx,rerr
end If
if (present(err)) err=rerr if (present(err)) err=rerr
if (present(iter)) iter = itx if (present(iter)) iter = itx

@ -100,7 +100,7 @@ Subroutine psb_dcgs(a,prec,b,x,eps,desc_a,info,&
& r(:), p(:), v(:), s(:), t(:), z(:), f(:), rt(:),qt(:),uv(:) & r(:), p(:), v(:), s(:), t(:), z(:), f(:), rt(:),qt(:),uv(:)
Integer, Pointer :: iperm(:), ipnull(:), ipsave(:) Integer, Pointer :: iperm(:), ipnull(:), ipsave(:)
Real(Kind(1.d0)) ::rerr Real(Kind(1.d0)) ::rerr
Integer ::litmax, liter, naux, m, mglob, it, itrac,int_err(5),& Integer ::litmax, liter, naux, m, mglob, it, itrace_,int_err(5),&
& nprows,npcols,me,mecol, n_row, n_col,istop_, err_act & nprows,npcols,me,mecol, n_row, n_col,istop_, err_act
Character ::diagl, diagu Character ::diagl, diagu
Logical, Parameter :: exchange=.True., noexchange=.False. Logical, Parameter :: exchange=.True., noexchange=.False.
@ -153,7 +153,7 @@ Subroutine psb_dcgs(a,prec,b,x,eps,desc_a,info,&
naux=4*n_col naux=4*n_col
Allocate(aux(naux),stat=info) Allocate(aux(naux),stat=info)
Call psb_geall(mglob,11,wwrk,desc_a,info) Call psb_geall(wwrk,desc_a,info,n=11)
Call psb_geasb(wwrk,desc_a,info) Call psb_geasb(wwrk,desc_a,info)
if (info.ne.0) Then if (info.ne.0) Then
info=4011 info=4011
@ -181,9 +181,9 @@ Subroutine psb_dcgs(a,prec,b,x,eps,desc_a,info,&
Endif Endif
If (Present(itrace)) Then If (Present(itrace)) Then
itrac = itrace itrace_ = itrace
Else Else
itrac = -1 itrace_ = 0
End If End If
! Ensure global coherence for convergence checks. ! Ensure global coherence for convergence checks.
@ -227,26 +227,23 @@ Subroutine psb_dcgs(a,prec,b,x,eps,desc_a,info,&
rni = psb_geamax(r,desc_a,info) rni = psb_geamax(r,desc_a,info)
xni = psb_geamax(x,desc_a,info) xni = psb_geamax(x,desc_a,info)
rerr = rni/(ani*xni+bni) rerr = rni/(ani*xni+bni)
if (itrac /= -1) then
If (me == 0) Write(itrac,'(a,i4,5(2x,es10.4))') 'cgs: ',&
& itx,rerr,rni,bni,xni,ani
endif
else if (istop_ == 2) then else if (istop_ == 2) then
rni = psb_genrm2(r,desc_a,info) rni = psb_genrm2(r,desc_a,info)
rerr = rni/bn2 rerr = rni/bn2
if (itrac /= -1) then
If (me == 0) Write(itrac,'(a,i4,3(2x,es10.4))') 'cgs: ',itx,rerr,rni,bn2
endif
endif endif
if(info/=0)then if(info/=0)then
info=4011 info=4011
call psb_errpush(info,name) call psb_errpush(info,name)
goto 9999 goto 9999
end if end if
If (rerr<=eps) Then If (rerr<=eps) Then
Exit restart Exit restart
End If End If
If (itrace_ > 0) then
if ((mod(itx,itrace_)==0).and.(me == 0))&
& write(*,'(a,i4,3(2x,es10.4))') 'cgs: ',itx,rerr
end If
iteration: Do iteration: Do
it = it + 1 it = it + 1
@ -303,28 +300,31 @@ Subroutine psb_dcgs(a,prec,b,x,eps,desc_a,info,&
rni = psb_geamax(r,desc_a,info) rni = psb_geamax(r,desc_a,info)
xni = psb_geamax(x,desc_a,info) xni = psb_geamax(x,desc_a,info)
rerr = rni/(ani*xni+bni) rerr = rni/(ani*xni+bni)
if (itrac /= -1) then
If (me == 0) Write(itrac,'(a,i4,5(2x,es10.4))') 'cgs: ',&
& itx,rerr,rni,bni,xni,ani
endif
else if (istop_ == 2) then else if (istop_ == 2) then
rni = psb_genrm2(r,desc_a,info) rni = psb_genrm2(r,desc_a,info)
rerr = rni/bn2 rerr = rni/bn2
if (itrac /= -1) then
If (me == 0) Write(itrac,'(a,i4,3(2x,es10.4))') 'cgs: ',&
& itx,rerr,rni,bn2
endif
endif endif
If (rerr<=eps) Then If (rerr<=eps) Then
Exit restart Exit restart
End If End If
If (itx.Ge.litmax) Exit restart If (itx.Ge.litmax) Exit restart
If (itrace_ > 0) then
if ((mod(itx,itrace_)==0).and.(me == 0))&
& write(*,'(a,i4,3(2x,es10.4))') 'cgs: ',itx,rerr
end If
End Do iteration End Do iteration
End Do restart End Do restart
If (itrace_ > 0) then
if ((mod(itx,itrace_)==0).and.(me == 0))&
& write(*,'(a,i4,3(2x,es10.4))') 'cgs: ',itx,rerr
end If
If (Present(err)) err=rerr If (Present(err)) err=rerr
If (Present(iter)) iter = itx If (Present(iter)) iter = itx
If (rerr>eps) Then If (rerr>eps) Then

@ -100,7 +100,7 @@ Subroutine psb_dcgstab(a,prec,b,x,eps,desc_a,info,&
& r(:), p(:), v(:), s(:), t(:), z(:), f(:) & r(:), p(:), v(:), s(:), t(:), z(:), f(:)
Integer, Pointer :: iperm(:), ipnull(:), ipsave(:) Integer, Pointer :: iperm(:), ipnull(:), ipsave(:)
Real(Kind(1.d0)) ::rerr Real(Kind(1.d0)) ::rerr
Integer ::litmax, liter, naux, m, mglob, it,itrac,& Integer ::litmax, liter, naux, m, mglob, it,itrace_,&
& nprows,npcols,myrow,mycol, n_row, n_col & nprows,npcols,myrow,mycol, n_row, n_col
Character ::diagl, diagu Character ::diagl, diagu
Logical, Parameter :: debug = .false. Logical, Parameter :: debug = .false.
@ -158,7 +158,7 @@ Subroutine psb_dcgstab(a,prec,b,x,eps,desc_a,info,&
naux=6*n_col naux=6*n_col
allocate(aux(naux),stat=info) allocate(aux(naux),stat=info)
if (info == 0) call psb_geall(mglob,8,wwrk,desc_a,info) if (info == 0) call psb_geall(wwrk,desc_a,info,n=8)
if (info == 0) call psb_geasb(wwrk,desc_a,info) if (info == 0) call psb_geasb(wwrk,desc_a,info)
if (info /= 0) then if (info /= 0) then
info=4011 info=4011
@ -182,9 +182,9 @@ Subroutine psb_dcgstab(a,prec,b,x,eps,desc_a,info,&
Endif Endif
If (Present(itrace)) Then If (Present(itrace)) Then
itrac = itrace itrace_ = itrace
Else Else
itrac = -1 itrace_ = 0
End If End If
diagl = 'U' diagl = 'U'
@ -245,8 +245,8 @@ Subroutine psb_dcgstab(a,prec,b,x,eps,desc_a,info,&
rn0 = rni rn0 = rni
End If End If
If (rn0 == 0.d0 ) Then If (rn0 == 0.d0 ) Then
If (itrac /= -1) Then If (itrace_ > 0 ) Then
If (myrow == 0) Write(itrac,*) 'BiCGSTAB: ',itx,rn0 If (myrow == 0) Write(*,*) 'BiCGSTAB: ',itx,rn0
Endif Endif
Exit restart Exit restart
End If End If
@ -254,15 +254,8 @@ Subroutine psb_dcgstab(a,prec,b,x,eps,desc_a,info,&
If (istop_ == 1) Then If (istop_ == 1) Then
xni = psb_geamax(x,desc_a,info) xni = psb_geamax(x,desc_a,info)
rerr = rni/(ani*xni+bni) rerr = rni/(ani*xni+bni)
If (itrac /= -1) Then
If (myrow == 0) Write(itrac,'(a,i4,5(2x,es10.4))') 'bicgstab: ',itx,rerr,rni,bni,&
&xni,ani
Endif
Else If (istop_ == 2) Then Else If (istop_ == 2) Then
rerr = rni/bn2 rerr = rni/bn2
If (itrac /= -1) Then
If (myrow == 0) Write(itrac,'(a,i4,3(2x,es10.4))') 'bicgstab: ',itx,rerr,rni,bn2
Endif
Endif Endif
if (info /= 0) Then if (info /= 0) Then
info=4011 info=4011
@ -270,10 +263,14 @@ Subroutine psb_dcgstab(a,prec,b,x,eps,desc_a,info,&
goto 9999 goto 9999
End If End If
If (rerr<=eps) Then If (rerr<=eps) Then
Exit restart Exit restart
End If End If
If (itrace_ > 0) then
if (((itx==0).or.(mod(itx,itrace_)==0)).and.(myrow == 0)) &
& write(*,'(a,i4,3(2x,es10.4))') 'bicgstab: ',itx,rerr
Endif
iteration: Do iteration: Do
it = it + 1 it = it + 1
@ -357,33 +354,35 @@ Subroutine psb_dcgstab(a,prec,b,x,eps,desc_a,info,&
rni = psb_geamax(r,desc_a,info) rni = psb_geamax(r,desc_a,info)
xni = psb_geamax(x,desc_a,info) xni = psb_geamax(x,desc_a,info)
rerr = rni/(ani*xni+bni) rerr = rni/(ani*xni+bni)
If (itrac /= -1) Then
If (myrow == 0) Write(itrac,'(a,i4,5(2x,es10.4))') &
& 'bicgstab: ',itx,rerr,rni,bni,xni,ani
Endif
Else If (istop_ == 2) Then Else If (istop_ == 2) Then
rni = psb_genrm2(r,desc_a,info) rni = psb_genrm2(r,desc_a,info)
rerr = rni/bn2 rerr = rni/bn2
If (itrac /= -1) Then
If (myrow == 0) Write(itrac,'(a,i4,3(2x,es10.4)))') &
& 'bicgstab: ',itx,rerr,rni,bn2
Endif
Endif Endif
If (rerr<=eps) Then If (rerr<=eps) Then
Exit restart Exit restart
End If End If
If (itx.Ge.litmax) Exit restart If (itx.Ge.litmax) Exit restart
If (itrace_ > 0) then
if ((mod(itx,itrace_)==0).and.(myrow == 0)) &
& write(*,'(a,i4,3(2x,es10.4)))') &
& 'bicgstab: ',itx,rerr
Endif
End Do iteration End Do iteration
End Do restart End Do restart
If (itrace_ > 0) then
if (myrow == 0) write(*,'(a,i4,3(2x,es10.4))') 'bicgstab: ',itx,rerr
Endif
If (Present(err)) err=rerr If (Present(err)) err=rerr
If (Present(iter)) iter = itx If (Present(iter)) iter = itx
If (rerr>eps) Then If (rerr>eps) Then
Write(0,*) 'BI-CGSTAB FAILED TO CONVERGE TO ',EPS,& Write(0,*) 'BI-CGSTAB failed to converge to ',EPS,&
& ' IN ',ITX,' ITERATIONS ' & ' in ',ITX,' iterations. '
End If End If
Deallocate(aux) Deallocate(aux)

@ -109,7 +109,7 @@ Subroutine psb_dcgstabl(a,prec,b,x,eps,desc_a,info,&
&pv1(:), pv2(:), pm1(:,:), pm2(:,:) &pv1(:), pv2(:), pm1(:,:), pm2(:,:)
Integer, Pointer :: iperm(:), ipnull(:), ipsave(:) Integer, Pointer :: iperm(:), ipnull(:), ipsave(:)
Real(Kind(1.d0)) ::rerr Real(Kind(1.d0)) ::rerr
Integer ::litmax, liter, naux, m, mglob, it, itrac,& Integer ::litmax, liter, naux, m, mglob, it, itrace_,&
& nprows,npcols,me,mecol, n_row, n_col, nl, err_act & nprows,npcols,me,mecol, n_row, n_col, nl, err_act
Character ::diagl, diagu Character ::diagl, diagu
Logical, Parameter :: exchange=.True., noexchange=.False. Logical, Parameter :: exchange=.True., noexchange=.False.
@ -161,9 +161,9 @@ Subroutine psb_dcgstabl(a,prec,b,x,eps,desc_a,info,&
Endif Endif
If (Present(itrace)) Then If (Present(itrace)) Then
itrac = itrace itrace_ = itrace
Else Else
itrac = -1 itrace_ = 0
End If End If
If (Present(irst)) Then If (Present(irst)) Then
@ -183,9 +183,9 @@ Subroutine psb_dcgstabl(a,prec,b,x,eps,desc_a,info,&
call psb_errpush(info,name) call psb_errpush(info,name)
goto 9999 goto 9999
End If End If
Call psb_geall(mglob,10,wwrk,desc_a,info) Call psb_geall(wwrk,desc_a,info,n=10)
Call psb_geall(mglob,nl+1,uh,desc_a,info,js=0) Call psb_geall(uh,desc_a,info,n=nl+1)
Call psb_geall(mglob,nl+1,rh,desc_a,info,js=0) Call psb_geall(rh,desc_a,info,n=nl+1)
Call psb_geasb(wwrk,desc_a,info) Call psb_geasb(wwrk,desc_a,info)
Call psb_geasb(uh,desc_a,info) Call psb_geasb(uh,desc_a,info)
Call psb_geasb(rh,desc_a,info) Call psb_geasb(rh,desc_a,info)
@ -255,17 +255,9 @@ Subroutine psb_dcgstabl(a,prec,b,x,eps,desc_a,info,&
rni = psb_geamax(r,desc_a,info) rni = psb_geamax(r,desc_a,info)
xni = psb_geamax(x,desc_a,info) xni = psb_geamax(x,desc_a,info)
rerr = rni/(ani*xni+bni) rerr = rni/(ani*xni+bni)
if (itrac /= -1) then
If (me == 0) Write(itrac,'(a,i4,5(2x,es10.4))') 'bicgstab(l): ',&
& itx,rerr,rni,bni,xni,ani
endif
else if (istop_ == 2) then else if (istop_ == 2) then
rni = psb_genrm2(r,desc_a,info) rni = psb_genrm2(r,desc_a,info)
rerr = rni/bn2 rerr = rni/bn2
if (itrac /= -1) then
If (me == 0) Write(itrac,'(a,i4,3(2x,es10.4))') 'bicgstab(l): ',&
& itx,rerr,rni,bn2
endif
endif endif
if (info.ne.0) Then if (info.ne.0) Then
info=4011 info=4011
@ -276,6 +268,10 @@ Subroutine psb_dcgstabl(a,prec,b,x,eps,desc_a,info,&
If (rerr<=eps) Then If (rerr<=eps) Then
Exit restart Exit restart
End If End If
If (itrace_ > 0) then
if ((mod(itx,itrace_)==0).and.(me == 0))&
& write(*,'(a,i4,3(2x,es10.4))') 'bicgstab(l): ',itx,rerr
end If
iteration: Do iteration: Do
it = it + nl it = it + nl
@ -364,29 +360,27 @@ Subroutine psb_dcgstabl(a,prec,b,x,eps,desc_a,info,&
rni = psb_geamax(rh(:,0),desc_a,info) rni = psb_geamax(rh(:,0),desc_a,info)
xni = psb_geamax(x,desc_a,info) xni = psb_geamax(x,desc_a,info)
rerr = rni/(ani*xni+bni) rerr = rni/(ani*xni+bni)
if (itrac /= -1) then
If (me == 0) Write(itrac,'(a,i4,5(2x,es10.4))') 'bicgstab(l): ',&
& itx,rerr,rni,bni,xni,ani
endif
else if (istop_ == 2) then else if (istop_ == 2) then
rni = psb_genrm2(rh(:,0),desc_a,info) rni = psb_genrm2(rh(:,0),desc_a,info)
rerr = rni/bn2 rerr = rni/bn2
if (itrac /= -1) then
If (me == 0) Write(itrac,'(a,i4,3(2x,es10.4))') 'bicgstab(l): ',&
& itx,rerr,rni,bn2
endif
endif endif
If (rerr<=eps) Then If (rerr<=eps) Then
Exit restart Exit restart
End If End If
If (itx.Ge.litmax) Exit restart If (itx.Ge.litmax) Exit restart
If (itrace_ > 0) then
if ((mod(itx,itrace_)==0).and.(me == 0))&
& write(*,'(a,i4,3(2x,es10.4))') 'bicgstab(l): ',itx,rerr
end If
End Do iteration End Do iteration
End Do restart End Do restart
If (itrace_ > 0) then
if (me == 0) write(*,'(a,i4,3(2x,es10.4))') 'bicgstab(l): ',itx,rerr
end If
If (Present(err)) err=rerr If (Present(err)) err=rerr
If (Present(iter)) iter = itx If (Present(iter)) iter = itx
If (rerr>eps) Then If (rerr>eps) Then

@ -111,7 +111,7 @@ Subroutine psb_dgmresr(a,prec,b,x,eps,desc_a,info,&
&pv1(:), pv2(:), pm1(:,:), rr(:,:) &pv1(:), pv2(:), pm1(:,:), rr(:,:)
Integer, Pointer :: iperm(:), ipnull(:), ipsave(:), ierrv(:) Integer, Pointer :: iperm(:), ipnull(:), ipsave(:), ierrv(:)
Real(Kind(1.d0)) :: rerr, scal, gm Real(Kind(1.d0)) :: rerr, scal, gm
Integer ::litmax, liter, naux, m, mglob, it,k, itrac,& Integer ::litmax, liter, naux, m, mglob, it,k, itrace_,&
& nprows,npcols,me,mecol, n_row, n_col, nl, int_err(5) & nprows,npcols,me,mecol, n_row, n_col, nl, int_err(5)
Character ::diagl, diagu Character ::diagl, diagu
Logical, Parameter :: exchange=.True., noexchange=.False. Logical, Parameter :: exchange=.True., noexchange=.False.
@ -164,9 +164,9 @@ Subroutine psb_dgmresr(a,prec,b,x,eps,desc_a,info,&
Endif Endif
If (Present(itrace)) Then If (Present(itrace)) Then
itrac = itrace itrace_ = itrace
Else Else
itrac = -1 itrace_ = 0
End If End If
If (Present(irst)) Then If (Present(irst)) Then
@ -188,8 +188,8 @@ Subroutine psb_dgmresr(a,prec,b,x,eps,desc_a,info,&
goto 9999 goto 9999
End If End If
Call psb_geall(mglob,nl+1,v,desc_a,info) Call psb_geall(v,desc_a,info,n=nl+1)
Call psb_geall(mglob,w,desc_a,info) Call psb_geall(w,desc_a,info)
Call psb_geasb(v,desc_a,info) Call psb_geasb(v,desc_a,info)
Call psb_geasb(w,desc_a,info) Call psb_geasb(w,desc_a,info)
if (info.ne.0) Then if (info.ne.0) Then
@ -247,17 +247,9 @@ Subroutine psb_dgmresr(a,prec,b,x,eps,desc_a,info,&
rni = psb_geamax(v(:,1),desc_a,info) rni = psb_geamax(v(:,1),desc_a,info)
xni = psb_geamax(x,desc_a,info) xni = psb_geamax(x,desc_a,info)
rerr = rni/(ani*xni+bni) rerr = rni/(ani*xni+bni)
if (itrac /= -1) then
If (me == 0) Write(itrac,'(a,i4,5(2x,es10.4))') 'gmresr(l): ',&
& itx,rerr,rni,bni,xni,ani
endif
else if (istop_ == 2) then else if (istop_ == 2) then
rni = psb_genrm2(v(:,1),desc_a,info) rni = psb_genrm2(v(:,1),desc_a,info)
rerr = rni/bn2 rerr = rni/bn2
if (itrac /= -1) then
If (me == 0) Write(itrac,'(a,i4,3(2x,es10.4))') 'gmresr(l): ',&
& itx,rerr,rni,bn2
endif
endif endif
if (info.ne.0) Then if (info.ne.0) Then
info=4011 info=4011
@ -268,6 +260,10 @@ Subroutine psb_dgmresr(a,prec,b,x,eps,desc_a,info,&
If (rerr<=eps) Then If (rerr<=eps) Then
Exit restart Exit restart
End If End If
If (itrace_ > 0) then
if ((mod(itx,itrace_)==0).and.(me == 0))&
& write(*,'(a,i4,3(2x,es10.4))') 'gmres(l): ',itx,rerr
end If
If (itx.Ge.litmax) Exit restart If (itx.Ge.litmax) Exit restart
@ -304,17 +300,9 @@ Subroutine psb_dgmresr(a,prec,b,x,eps,desc_a,info,&
rni = abs(rs(i+1)) rni = abs(rs(i+1))
xni = psb_geamax(x,desc_a,info) xni = psb_geamax(x,desc_a,info)
rerr = rni/(ani*xni+bni) rerr = rni/(ani*xni+bni)
if (itrac /= -1) then
If (me == 0) Write(itrac,'(a,i4,5(2x,es10.4))') 'gmresr(l): ',&
& itx,rerr,rni,bni,xni,ani
endif
else if (istop_ == 2) then else if (istop_ == 2) then
rni = abs(rs(i+1)) rni = abs(rs(i+1))
rerr = rni/bn2 rerr = rni/bn2
if (itrac /= -1) then
If (me == 0) Write(itrac,'(a,i4,3(2x,es10.4))') 'gmresr(l): ',&
& itx,rerr,rni,bn2
endif
endif endif
if (rerr < eps ) then if (rerr < eps ) then
@ -325,6 +313,10 @@ Subroutine psb_dgmresr(a,prec,b,x,eps,desc_a,info,&
end do end do
exit restart exit restart
end if end if
If (itrace_ > 0) then
if ((mod(itx,itrace_)==0).and.(me == 0))&
& write(*,'(a,i4,3(2x,es10.4))') 'gmres(l): ',itx,rerr
end If
end Do inner end Do inner
if (debug) write(0,*) 'Before DTRSM :',rs(1:nl) if (debug) write(0,*) 'Before DTRSM :',rs(1:nl)
@ -335,6 +327,9 @@ Subroutine psb_dgmresr(a,prec,b,x,eps,desc_a,info,&
end do end do
End Do restart End Do restart
If (itrace_ > 0) then
if (me == 0) write(*,'(a,i4,3(2x,es10.4))') 'gmres(l): ',itx,rerr
end If
If (Present(err)) err=rerr If (Present(err)) err=rerr
If (Present(iter)) iter = itx If (Present(iter)) iter = itx

@ -100,7 +100,7 @@ Subroutine psb_zcgs(a,prec,b,x,eps,desc_a,info,&
& r(:), p(:), v(:), s(:), t(:), z(:), f(:), rt(:),qt(:),uv(:) & r(:), p(:), v(:), s(:), t(:), z(:), f(:), rt(:),qt(:),uv(:)
Integer, Pointer :: iperm(:), ipnull(:), ipsave(:) Integer, Pointer :: iperm(:), ipnull(:), ipsave(:)
Real(Kind(1.d0)) ::rerr Real(Kind(1.d0)) ::rerr
Integer ::litmax, liter, naux, m, mglob, it, itrac,int_err(5),& Integer ::litmax, liter, naux, m, mglob, it, itrace_,int_err(5),&
& nprows,npcols,me,mecol, n_row, n_col,istop_, err_act & nprows,npcols,me,mecol, n_row, n_col,istop_, err_act
Character ::diagl, diagu Character ::diagl, diagu
Logical, Parameter :: exchange=.True., noexchange=.False. Logical, Parameter :: exchange=.True., noexchange=.False.
@ -153,7 +153,7 @@ Subroutine psb_zcgs(a,prec,b,x,eps,desc_a,info,&
naux=4*n_col naux=4*n_col
Allocate(aux(naux),stat=info) Allocate(aux(naux),stat=info)
Call psb_geall(mglob,11,wwrk,desc_a,info) Call psb_geall(wwrk,desc_a,info,n=11)
Call psb_geasb(wwrk,desc_a,info) Call psb_geasb(wwrk,desc_a,info)
if (info.ne.0) Then if (info.ne.0) Then
info=4011 info=4011
@ -181,9 +181,9 @@ Subroutine psb_zcgs(a,prec,b,x,eps,desc_a,info,&
Endif Endif
If (Present(itrace)) Then If (Present(itrace)) Then
itrac = itrace itrace_ = itrace
Else Else
itrac = -1 itrace_ = 0
End If End If
! Ensure global coherence for convergence checks. ! Ensure global coherence for convergence checks.
@ -227,16 +227,9 @@ Subroutine psb_zcgs(a,prec,b,x,eps,desc_a,info,&
rni = psb_geamax(r,desc_a,info) rni = psb_geamax(r,desc_a,info)
xni = psb_geamax(x,desc_a,info) xni = psb_geamax(x,desc_a,info)
rerr = rni/(ani*xni+bni) rerr = rni/(ani*xni+bni)
if (itrac /= -1) then
If (me == 0) Write(itrac,'(a,i4,5(2x,es10.4))') 'cgs: ',&
& itx,rerr,rni,bni,xni,ani
endif
else if (istop_ == 2) then else if (istop_ == 2) then
rni = psb_genrm2(r,desc_a,info) rni = psb_genrm2(r,desc_a,info)
rerr = rni/bn2 rerr = rni/bn2
if (itrac /= -1) then
If (me == 0) Write(itrac,'(a,i4,3(2x,es10.4))') 'cgs: ',itx,rerr,rni,bn2
endif
endif endif
if(info/=0)then if(info/=0)then
info=4011 info=4011
@ -247,6 +240,10 @@ Subroutine psb_zcgs(a,prec,b,x,eps,desc_a,info,&
If (rerr<=eps) Then If (rerr<=eps) Then
Exit restart Exit restart
End If End If
If (itrace_ > 0) then
if ((mod(itx,itrace_)==0).and.(me == 0))&
& write(*,'(a,i4,3(2x,es10.4))') 'cgs: ',itx,rerr
end If
iteration: Do iteration: Do
it = it + 1 it = it + 1
@ -303,27 +300,26 @@ Subroutine psb_zcgs(a,prec,b,x,eps,desc_a,info,&
rni = psb_geamax(r,desc_a,info) rni = psb_geamax(r,desc_a,info)
xni = psb_geamax(x,desc_a,info) xni = psb_geamax(x,desc_a,info)
rerr = rni/(ani*xni+bni) rerr = rni/(ani*xni+bni)
if (itrac /= -1) then
If (me == 0) Write(itrac,'(a,i4,5(2x,es10.4))') 'cgs: ',&
& itx,rerr,rni,bni,xni,ani
endif
else if (istop_ == 2) then else if (istop_ == 2) then
rni = psb_genrm2(r,desc_a,info) rni = psb_genrm2(r,desc_a,info)
rerr = rni/bn2 rerr = rni/bn2
if (itrac /= -1) then
If (me == 0) Write(itrac,'(a,i4,3(2x,es10.4))') 'cgs: ',&
& itx,rerr,rni,bn2
endif
endif endif
If (rerr<=eps) Then If (rerr<=eps) Then
Exit restart Exit restart
End If End If
If (itx.Ge.litmax) Exit restart If (itx.Ge.litmax) Exit restart
If (itrace_ > 0) then
if ((mod(itx,itrace_)==0).and.(me == 0))&
& write(*,'(a,i4,3(2x,es10.4))') 'cgs: ',itx,rerr
end If
End Do iteration End Do iteration
End Do restart End Do restart
If (itrace_ > 0) then
if (me == 0) write(*,'(a,i4,3(2x,es10.4))') 'cgs: ',itx,rerr
end If
If (Present(err)) err=rerr If (Present(err)) err=rerr
If (Present(iter)) iter = itx If (Present(iter)) iter = itx

@ -100,7 +100,7 @@ Subroutine psb_zcgstab(a,prec,b,x,eps,desc_a,info,&
& r(:), p(:), v(:), s(:), t(:), z(:), f(:) & r(:), p(:), v(:), s(:), t(:), z(:), f(:)
Integer, Pointer :: iperm(:), ipnull(:), ipsave(:) Integer, Pointer :: iperm(:), ipnull(:), ipsave(:)
Real(Kind(1.d0)) :: rerr Real(Kind(1.d0)) :: rerr
Integer :: litmax, liter, naux, m, mglob, it,itrac,& Integer :: litmax, liter, naux, m, mglob, it,itrace_,&
& nprows,npcols,myrow,mycol, n_row, n_col & nprows,npcols,myrow,mycol, n_row, n_col
Character ::diagl, diagu Character ::diagl, diagu
Logical, Parameter :: debug = .false. Logical, Parameter :: debug = .false.
@ -158,7 +158,7 @@ Subroutine psb_zcgstab(a,prec,b,x,eps,desc_a,info,&
naux=6*n_col naux=6*n_col
allocate(aux(naux),stat=info) allocate(aux(naux),stat=info)
call psb_geall(mglob,8,wwrk,desc_a,info) call psb_geall(wwrk,desc_a,info,n=8)
call psb_geasb(wwrk,desc_a,info) call psb_geasb(wwrk,desc_a,info)
if (info /= 0) then if (info /= 0) then
info=4011 info=4011
@ -182,9 +182,9 @@ Subroutine psb_zcgstab(a,prec,b,x,eps,desc_a,info,&
Endif Endif
If (Present(itrace)) Then If (Present(itrace)) Then
itrac = itrace itrace_ = itrace
Else Else
itrac = -1 itrace_ = 0
End If End If
diagl = 'U' diagl = 'U'
@ -245,24 +245,14 @@ Subroutine psb_zcgstab(a,prec,b,x,eps,desc_a,info,&
rn0 = rni rn0 = rni
End If End If
If (rn0 == 0.d0 ) Then If (rn0 == 0.d0 ) Then
If (itrac /= -1) Then
If (myrow == 0) Write(itrac,*) 'BiCGSTAB: ',itx,rn0
Endif
Exit restart Exit restart
End If End If
If (istop_ == 1) Then If (istop_ == 1) Then
xni = psb_geamax(x,desc_a,info) xni = psb_geamax(x,desc_a,info)
rerr = rni/(ani*xni+bni) rerr = rni/(ani*xni+bni)
If (itrac /= -1) Then
If (myrow == 0) Write(itrac,'(a,i4,5(2x,es10.4))') 'bicgstab: ',itx,rerr,rni,bni,&
&xni,ani
Endif
Else If (istop_ == 2) Then Else If (istop_ == 2) Then
rerr = rni/bn2 rerr = rni/bn2
If (itrac /= -1) Then
If (myrow == 0) Write(itrac,'(a,i4,3(2x,es10.4))') 'bicgstab: ',itx,rerr,rni,bn2
Endif
Endif Endif
if (info /= 0) Then if (info /= 0) Then
info=4011 info=4011
@ -270,11 +260,15 @@ Subroutine psb_zcgstab(a,prec,b,x,eps,desc_a,info,&
goto 9999 goto 9999
End If End If
If (rerr<=eps) Then If (rerr<=eps) Then
Exit restart Exit restart
End If End If
If (itrace_ > 0) then
if ((mod(itx,itrace_)==0).and.(myrow == 0))&
& write(*,'(a,i4,3(2x,es10.4))') 'bicgstab: ',itx,rerr
end If
iteration: Do iteration: Do
it = it + 1 it = it + 1
itx = itx + 1 itx = itx + 1
@ -356,18 +350,9 @@ Subroutine psb_zcgstab(a,prec,b,x,eps,desc_a,info,&
rni = psb_geamax(r,desc_a,info) rni = psb_geamax(r,desc_a,info)
xni = psb_geamax(x,desc_a,info) xni = psb_geamax(x,desc_a,info)
rerr = rni/(ani*xni+bni) rerr = rni/(ani*xni+bni)
If (itrac /= -1) Then
If (myrow == 0) Write(itrac,'(a,i4,5(2x,es10.4))') &
& 'bicgstab: ',itx,rerr,rni,bni,xni,ani
Endif
Else If (istop_ == 2) Then Else If (istop_ == 2) Then
rni = psb_genrm2(r,desc_a,info) rni = psb_genrm2(r,desc_a,info)
rerr = rni/bn2 rerr = rni/bn2
If (itrac /= -1) Then
If (myrow == 0) Write(itrac,'(a,i4,3(2x,es10.4)))') &
& 'bicgstab: ',itx,rerr,rni,bn2
Endif
Endif Endif
If (rerr<=eps) Then If (rerr<=eps) Then
@ -375,14 +360,22 @@ Subroutine psb_zcgstab(a,prec,b,x,eps,desc_a,info,&
End If End If
If (itx.Ge.litmax) Exit restart If (itx.Ge.litmax) Exit restart
If (itrace_ > 0) then
if ((mod(itx,itrace_)==0).and.(myrow == 0))&
& write(*,'(a,i4,3(2x,es10.4))') 'bicgstab: ',itx,rerr
end If
End Do iteration End Do iteration
End Do restart End Do restart
If (itrace_ > 0) then
if (myrow == 0) write(*,'(a,i4,3(2x,es10.4))') 'bicgstab: ',itx,rerr
end If
If (Present(err)) err=rerr If (Present(err)) err=rerr
If (Present(iter)) iter = itx If (Present(iter)) iter = itx
If (rerr>eps) Then If (rerr>eps) Then
Write(0,*) 'BI-CGSTAB FAILED TO CONVERGE TO ',EPS,& Write(0,*) 'BI-cgstab failed to converge to ',eps,&
& ' IN ',ITX,' ITERATIONS ' & ' in ',itx,' iterations. '
End If End If
Deallocate(aux) Deallocate(aux)

@ -234,11 +234,11 @@ subroutine psb_dbaseprc_aply(prec,x,beta,y,desc_data,trans,work,info)
case(psb_none_) case(psb_none_)
! Would work anyway, but since it's supposed to do nothing... ! Would work anyway, but since it's supposed to do nothing...
! call f90_psovrl(ty,prec%desc_data,update_type=prec%a_restrict) ! call f90_psovrl(ty,prec%desc_data,update=prec%a_restrict)
case(psb_sum_,psb_avg_) case(psb_sum_,psb_avg_)
call psb_ovrl(ty,prec%desc_data,info,& call psb_ovrl(ty,prec%desc_data,info,&
& update_type=prec%iprcparm(prol_),work=aux) & update=prec%iprcparm(prol_),work=aux)
if(info /=0) then if(info /=0) then
info=4010 info=4010
ch_err='psb_ovrl' ch_err='psb_ovrl'

@ -89,7 +89,7 @@ subroutine psb_dslu_bld(a,desc_a,p,info)
call blacs_barrier(icontxt,'All') call blacs_barrier(icontxt,'All')
endif endif
call psb_dcsdp(a,atmp,info) call psb_csdp(a,atmp,info)
if(info /= 0) then if(info /= 0) then
info=4010 info=4010
ch_err='psb_dcsdp' ch_err='psb_dcsdp'

@ -234,11 +234,11 @@ subroutine psb_zbaseprc_aply(prec,x,beta,y,desc_data,trans,work,info)
case(psb_none_) case(psb_none_)
! Would work anyway, but since it's supposed to do nothing... ! Would work anyway, but since it's supposed to do nothing...
! call f90_psovrl(ty,prec%desc_data,update_type=prec%a_restrict) ! call f90_psovrl(ty,prec%desc_data,update=prec%a_restrict)
case(psb_sum_,psb_avg_) case(psb_sum_,psb_avg_)
call psb_ovrl(ty,prec%desc_data,info,& call psb_ovrl(ty,prec%desc_data,info,&
& update_type=prec%iprcparm(prol_),work=aux) & update=prec%iprcparm(prol_),work=aux)
if(info /=0) then if(info /=0) then
info=4010 info=4010
ch_err='psb_ovrl' ch_err='psb_ovrl'

@ -624,7 +624,7 @@ contains
if (debug) write(0,*) me,'Done NUMBMM 2' if (debug) write(0,*) me,'Done NUMBMM 2'
if (p%iprcparm(smth_kind_) == smth_omg_) then if (p%iprcparm(smth_kind_) == smth_omg_) then
call psb_transp(am1,am2,fmt='COO') call psb_transc(am1,am2,fmt='COO')
nzl = am2%infoa(psb_nnz_) nzl = am2%infoa(psb_nnz_)
i=0 i=0
! !
@ -643,7 +643,7 @@ contains
am2%infoa(psb_nnz_) = i am2%infoa(psb_nnz_) = i
call psb_ipcoo2csr(am2,info) call psb_ipcoo2csr(am2,info)
else else
call psb_transp(am1,am2) call psb_transc(am1,am2)
endif endif
if (debug) write(0,*) me,'starting sphalo/ rwxtd' if (debug) write(0,*) me,'starting sphalo/ rwxtd'

@ -51,7 +51,7 @@ subroutine psb_zslu_bld(a,desc_a,p,info)
character(len=5) :: fmt character(len=5) :: fmt
character :: upd='F' character :: upd='F'
integer :: i,j,nza,nzb,nzt,icontxt, me,mycol,nprow,npcol,err_act integer :: i,j,nza,nzb,nzt,icontxt, me,mycol,nprow,npcol,err_act
logical, parameter :: debug=.false. logical, parameter :: debug=.true.
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
interface psb_asmatbld interface psb_asmatbld
@ -85,14 +85,14 @@ subroutine psb_zslu_bld(a,desc_a,p,info)
atmp%fida='COO' atmp%fida='COO'
if (Debug) then if (Debug) then
write(0,*) me, 'SPLUBLD: Calling csdp' write(0,*) me, 'ZSLUBLD: Calling csdp'
call blacs_barrier(icontxt,'All') call blacs_barrier(icontxt,'All')
endif endif
call psb_zcsdp(a,atmp,info) call psb_csdp(a,atmp,info)
if(info /= 0) then if(info /= 0) then
info=4010 info=4010
ch_err='psb_zcsdp' ch_err='psb_csdp'
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

@ -188,26 +188,26 @@ subroutine psb_dspmm(alpha,a,x,beta,y,desc_a,info,&
liwork= 2*ncol liwork= 2*ncol
if (a%pr(1) /= 0) liwork = liwork + n * ik if (a%pr(1) /= 0) liwork = liwork + n * ik
if (a%pl(1) /= 0) liwork = liwork + m * ik if (a%pl(1) /= 0) liwork = liwork + m * ik
if (present(work)) then if (present(work)) then
if (size(work) >= liwork) then if (size(work) >= liwork) then
aliw =.false. aliw =.false.
else else
aliw=.true. aliw=.true.
endif endif
else else
aliw=.true. aliw=.true.
end if end if
if (aliw) then if (aliw) then
call psb_realloc(liwork,iwork,info) call psb_realloc(liwork,iwork,info)
if(info.ne.0) then if(info.ne.0) then
info=4010 info=4010
ch_err='psb_realloc' ch_err='psb_realloc'
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
else else
iwork => work iwork => work
endif endif
iwork(1)=dzero iwork(1)=dzero

@ -196,26 +196,26 @@ subroutine psb_dspsm(alpha,a,x,beta,y,desc_a,info,&
liwork= 2*ncol liwork= 2*ncol
if (a%pr(1) /= 0) llwork = liwork + m * ik if (a%pr(1) /= 0) llwork = liwork + m * ik
if (a%pl(1) /= 0) llwork = llwork + m * ik if (a%pl(1) /= 0) llwork = llwork + m * ik
if (present(work)) then if (present(work)) then
if (size(work) >= liwork) then if (size(work) >= liwork) then
aliw =.false. aliw =.false.
else else
aliw=.true. aliw=.true.
endif endif
else else
aliw=.true. aliw=.true.
end if end if
if (aliw) then if (aliw) then
call psb_realloc(liwork,iwork,info) call psb_realloc(liwork,iwork,info)
if(info.ne.0) then if(info.ne.0) then
info=4010 info=4010
ch_err='psb_realloc' ch_err='psb_realloc'
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
else else
iwork => work iwork => work
endif endif
iwork(1)=0.d0 iwork(1)=0.d0
@ -490,27 +490,27 @@ subroutine psb_dspsv(alpha,a,x,beta,y,desc_a,info,&
liwork= 2*ncol liwork= 2*ncol
if (a%pr(1) /= 0) llwork = liwork + m * ik if (a%pr(1) /= 0) llwork = liwork + m * ik
if (a%pl(1) /= 0) llwork = llwork + m * ik if (a%pl(1) /= 0) llwork = llwork + m * ik
if (present(work)) then if (present(work)) then
if (size(work) >= liwork) then if (size(work) >= liwork) then
aliw =.false. aliw =.false.
else else
aliw=.true. aliw=.true.
endif endif
else else
aliw=.true. aliw=.true.
end if end if
if (aliw) then if (aliw) then
call psb_realloc(liwork,iwork,info) call psb_realloc(liwork,iwork,info)
if(info.ne.0) then if(info.ne.0) then
info=4010 info=4010
ch_err='psb_realloc' ch_err='psb_realloc'
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
else else
iwork => work iwork => work
endif endif
iwork(1)=0.d0 iwork(1)=0.d0
@ -596,7 +596,7 @@ subroutine psb_dspsv(alpha,a,x,beta,y,desc_a,info,&
end select end select
end if end if
if (aliw) deallocate(iwork) if (aliw) deallocate(iwork)
if(.not.present(d)) deallocate(id) if(.not.present(d)) deallocate(id)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)

@ -183,26 +183,26 @@ subroutine psb_zspmm(alpha,a,x,beta,y,desc_a,info,&
liwork= 2*ncol liwork= 2*ncol
if (a%pr(1) /= 0) liwork = liwork + n * ik if (a%pr(1) /= 0) liwork = liwork + n * ik
if (a%pl(1) /= 0) liwork = liwork + m * ik if (a%pl(1) /= 0) liwork = liwork + m * ik
if (present(work)) then if (present(work)) then
if (size(work) >= liwork) then if (size(work) >= liwork) then
aliw =.false. aliw =.false.
else else
aliw=.true. aliw=.true.
endif endif
else else
aliw=.true. aliw=.true.
end if end if
if (aliw) then if (aliw) then
call psb_realloc(liwork,iwork,info) call psb_realloc(liwork,iwork,info)
if(info.ne.0) then if(info.ne.0) then
info=4010 info=4010
ch_err='psb_realloc' ch_err='psb_realloc'
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
else else
iwork => work iwork => work
endif endif
iwork(1)=zzero iwork(1)=zzero
@ -315,7 +315,7 @@ if (present(work)) then
y(iiy+nrow+1-1:iiy+ncol,1:ik)=zzero y(iiy+nrow+1-1:iiy+ncol,1:ik)=zzero
! local Matrix-vector product ! local Matrix-vector product
call psb_csmm(alpha,a,x(iix:lldx,jjx:jjx+ik-1),& call psb_csmm(alpha,a,x(iix:lldx,jjx:jjx+ik-1),&
& beta,y(iiy:lldy,jjy:jjy+ik-1),info,trans=itrans) & beta,y(iiy:lldy,jjy:jjy+ik-1),info,trans=itrans)

@ -199,26 +199,26 @@ subroutine psb_zspsm(alpha,a,x,beta,y,desc_a,info,&
liwork= 2*ncol liwork= 2*ncol
if (a%pr(1) /= 0) llwork = liwork + m * ik if (a%pr(1) /= 0) llwork = liwork + m * ik
if (a%pl(1) /= 0) llwork = llwork + m * ik if (a%pl(1) /= 0) llwork = llwork + m * ik
if (present(work)) then if (present(work)) then
if (size(work) >= liwork) then if (size(work) >= liwork) then
aliw =.false. aliw =.false.
else else
aliw=.true. aliw=.true.
endif endif
else else
aliw=.true. aliw=.true.
end if end if
if (aliw) then if (aliw) then
call psb_realloc(liwork,iwork,info) call psb_realloc(liwork,iwork,info)
if(info.ne.0) then if(info.ne.0) then
info=4010 info=4010
ch_err='psb_realloc' ch_err='psb_realloc'
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
else else
iwork => work iwork => work
endif endif
iwork(1)=0.d0 iwork(1)=0.d0
@ -428,14 +428,14 @@ subroutine psb_zspsv(alpha,a,x,beta,y,desc_a,info,&
! check on blacs grid ! check on blacs grid
call blacs_gridinfo(icontxt, nprow, npcol, myrow, mycol) call blacs_gridinfo(icontxt, nprow, npcol, myrow, mycol)
if (nprow == -1) then if (nprow == -1) then
info = 2010 info = 2010
call psb_errpush(info,name) call psb_errpush(info,name)
goto 9999 goto 9999
else if (npcol /= 1) then else if (npcol /= 1) then
info = 2030 info = 2030
int_err(1) = npcol int_err(1) = npcol
call psb_errpush(info,name) call psb_errpush(info,name)
goto 9999 goto 9999
endif endif
! just this case right now ! just this case right now
@ -469,7 +469,7 @@ subroutine psb_zspsv(alpha,a,x,beta,y,desc_a,info,&
goto 9999 goto 9999
end if end if
else else
itrans = 'N' itrans = 'N'
endif endif
m = desc_a%matrix_data(psb_m_) m = desc_a%matrix_data(psb_m_)
@ -479,9 +479,9 @@ subroutine psb_zspsv(alpha,a,x,beta,y,desc_a,info,&
lldy = size(y) lldy = size(y)
if((lldx.lt.ncol).or.(lldy.lt.ncol)) then if((lldx.lt.ncol).or.(lldy.lt.ncol)) then
info=3010 info=3010
call psb_errpush(info,name) call psb_errpush(info,name)
goto 9999 goto 9999
end if end if
iwork => null() iwork => null()
@ -489,38 +489,38 @@ subroutine psb_zspsv(alpha,a,x,beta,y,desc_a,info,&
liwork= 2*ncol liwork= 2*ncol
if (a%pr(1) /= 0) llwork = liwork + m * ik if (a%pr(1) /= 0) llwork = liwork + m * ik
if (a%pl(1) /= 0) llwork = llwork + m * ik if (a%pl(1) /= 0) llwork = llwork + m * ik
if (present(work)) then if (present(work)) then
if (size(work) >= liwork) then if (size(work) >= liwork) then
aliw =.false. aliw =.false.
else else
aliw=.true. aliw=.true.
endif endif
else else
aliw=.true. aliw=.true.
end if end if
if (aliw) then if (aliw) then
call psb_realloc(liwork,iwork,info) call psb_realloc(liwork,iwork,info)
if(info.ne.0) then if(info.ne.0) then
info=4010 info=4010
ch_err='psb_realloc' ch_err='psb_realloc'
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
else else
iwork => work iwork => work
endif endif
iwork(1)=0.d0 iwork(1)=0.d0
if(present(d)) then if(present(d)) then
lld = size(d) lld = size(d)
id => d id => d
else else
lld=1 lld=1
allocate(id(1)) allocate(id(1))
id=1.d0 id=1.d0
end if end if
! checking for matrix correctness ! checking for matrix correctness
@ -529,25 +529,25 @@ subroutine psb_zspsv(alpha,a,x,beta,y,desc_a,info,&
call psb_chkvect(m,ik,size(x),ix,jx,desc_a%matrix_data,info,iix,jjx) call psb_chkvect(m,ik,size(x),ix,jx,desc_a%matrix_data,info,iix,jjx)
call psb_chkvect(m,ik,size(y),iy,jy,desc_a%matrix_data,info,iiy,jjy) call psb_chkvect(m,ik,size(y),iy,jy,desc_a%matrix_data,info,iiy,jjy)
if(info.ne.0) then if(info.ne.0) then
info=4010 info=4010
ch_err='psb_chkvect/mat' ch_err='psb_chkvect/mat'
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
if(ja.ne.ix) then if(ja.ne.ix) then
! this case is not yet implemented ! this case is not yet implemented
info = 3030 info = 3030
end if end if
if((iix.ne.1).or.(iiy.ne.1)) then if((iix.ne.1).or.(iiy.ne.1)) then
! this case is not yet implemented ! this case is not yet implemented
info = 3040 info = 3040
end if end if
if(info.ne.0) then if(info.ne.0) then
call psb_errpush(info,name) call psb_errpush(info,name)
goto 9999 goto 9999
end if end if
! Perform local triangular system solve ! Perform local triangular system solve
@ -556,46 +556,46 @@ subroutine psb_zspsv(alpha,a,x,beta,y,desc_a,info,&
call psb_cssm(alpha,a,xp,beta,yp,info,unitd=lunitd,d=id,trans=itrans) call psb_cssm(alpha,a,xp,beta,yp,info,unitd=lunitd,d=id,trans=itrans)
if(info.ne.0) then if(info.ne.0) then
info = 4010 info = 4010
ch_err='dcssm' ch_err='dcssm'
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
! update overlap elements ! update overlap elements
if(lchoice.gt.0) then if(lchoice.gt.0) then
call psi_swapdata(ior(psb_swap_send_,psb_swap_recv_),& call psi_swapdata(ior(psb_swap_send_,psb_swap_recv_),&
& zone,yp,desc_a,iwork,info) & zone,yp,desc_a,iwork,info)
i=0 i=0
! switch on update type ! switch on update type
select case (lchoice) select case (lchoice)
case(psb_square_root_) case(psb_square_root_)
do while(desc_a%ovrlap_elem(i).ne.-ione) do while(desc_a%ovrlap_elem(i).ne.-ione)
y(desc_a%ovrlap_elem(i+psb_ovrlp_elem_)) =& y(desc_a%ovrlap_elem(i+psb_ovrlp_elem_)) =&
& y(desc_a%ovrlap_elem(i+psb_ovrlp_elem_))/& & y(desc_a%ovrlap_elem(i+psb_ovrlp_elem_))/&
& sqrt(real(desc_a%ovrlap_elem(i+psb_n_dom_ovr_))) & sqrt(real(desc_a%ovrlap_elem(i+psb_n_dom_ovr_)))
i = i+2 i = i+2
end do end do
case(psb_avg_) case(psb_avg_)
do while(desc_a%ovrlap_elem(i).ne.-ione) do while(desc_a%ovrlap_elem(i).ne.-ione)
y(desc_a%ovrlap_elem(i+psb_ovrlp_elem_)) =& y(desc_a%ovrlap_elem(i+psb_ovrlp_elem_)) =&
& y(desc_a%ovrlap_elem(i+psb_ovrlp_elem_))/& & y(desc_a%ovrlap_elem(i+psb_ovrlp_elem_))/&
& real(desc_a%ovrlap_elem(i+psb_n_dom_ovr_)) & real(desc_a%ovrlap_elem(i+psb_n_dom_ovr_))
i = i+2 i = i+2
end do end do
case(psb_sum_) case(psb_sum_)
! do nothing ! do nothing
case default case default
! wrong value for choice argument ! wrong value for choice argument
info = 70 info = 70
int_err=(/10,lchoice,0,0,0/) int_err=(/10,lchoice,0,0,0/)
call psb_errpush(info,name,i_err=int_err) call psb_errpush(info,name,i_err=int_err)
goto 9999 goto 9999
end select end select
end if end if
if (aliw) deallocate(iwork) if (aliw) deallocate(iwork)
if(.not.present(d)) deallocate(id) if(.not.present(d)) deallocate(id)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
@ -605,8 +605,8 @@ subroutine psb_zspsv(alpha,a,x,beta,y,desc_a,info,&
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then if (err_act.eq.act_abort) then
call psb_error(icontxt) call psb_error(icontxt)
return return
end if end if
return return
end subroutine psb_zspsv end subroutine psb_zspsv

@ -118,8 +118,7 @@ subroutine psb_dcsdp(a, b,info,ifc,check,trans,unitd,upd,dupl)
if (check_=='R') then if (check_=='R') then
allocate(work(max(size(a%aspk),size(b%aspk))+1000),stat=info) allocate(work(max(size(a%aspk),size(b%aspk))+1000),stat=info)
else else
allocate(work(max(size(a%ia1),size(b%ia1),& allocate(work(max(size(a%ia1),size(a%ia2))+max(a%m,b%m)+1000),stat=info)
& size(a%ia2),size(b%ia2))+max(a%m,b%m)+1000),stat=info)
endif endif
if (info /= 0) then if (info /= 0) then
@ -196,13 +195,20 @@ subroutine psb_dcsdp(a, b,info,ifc,check,trans,unitd,upd,dupl)
call psb_errpush(info,name,a_err=ch_err) call psb_errpush(info,name,a_err=ch_err)
goto 9999 goto 9999
endif endif
if ((size(b%aspk) < aspk_size) .or.& if (.not.associated(b%aspk).or.&
&.not.associated(b%ia1).or.&
&.not.associated(b%ia2).or.&
&.not.associated(b%pl).or.&
&.not.associated(b%pr)) then
call psb_sp_reall(b,ia1_size,ia2_size,aspk_size,info)
else if ((size(b%aspk) < aspk_size) .or.&
&(size(b%ia1) < ia1_size) .or.& &(size(b%ia1) < ia1_size) .or.&
&(size(b%ia2) < ia2_size) .or.& &(size(b%ia2) < ia2_size) .or.&
&(size(b%pl) < b%m) .or.& &(size(b%pl) < b%m) .or.&
&(size(b%pr) < b%k )) then &(size(b%pr) < b%k )) then
call psb_sp_reall(b,ia1_size,ia2_size,aspk_size,info) call psb_sp_reall(b,ia1_size,ia2_size,aspk_size,info)
endif endif
if (info /= no_err) then if (info /= no_err) then
info=4010 info=4010
ch_err='psb_sp_reall' ch_err='psb_sp_reall'

@ -67,7 +67,7 @@ subroutine psb_zcsdp(a, b,info,ifc,check,trans,unitd,upd,dupl)
& ipc, i, count, err_act, ierrv(5), i1, i2, ia & ipc, i, count, err_act, ierrv(5), i1, i2, ia
character :: check_,trans_,unitd_, up character :: check_,trans_,unitd_, up
Integer, Parameter :: maxtry=8 Integer, Parameter :: maxtry=8
logical, parameter :: debug=.false. logical, parameter :: debug=.true.
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
interface psb_cest interface psb_cest
@ -114,11 +114,11 @@ subroutine psb_zcsdp(a, b,info,ifc,check,trans,unitd,upd,dupl)
unitd_ = 'U' unitd_ = 'U'
endif endif
if (check_=='R') then if (check_=='R') then
allocate(work(max(size(a%aspk),size(b%aspk))+1000),stat=info) allocate(work(max(size(a%aspk),size(b%aspk))+1000),stat=info)
else else
allocate(work(max(size(a%ia1),size(b%ia1),& allocate(work(max(size(a%ia1),size(a%ia2))+max(a%m,b%m)+1000),stat=info)
& size(a%ia2),size(b%ia2))+max(a%m,b%m)+1000),stat=info)
endif endif
if (info /= 0) then if (info /= 0) then
@ -127,7 +127,7 @@ subroutine psb_zcsdp(a, b,info,ifc,check,trans,unitd,upd,dupl)
goto 9999 goto 9999
end if end if
if (ifc_<1) then if (ifc_<1) then
write(0,*) 'dcsdp90 Error: invalid ifc ',ifc_ write(0,*) 'csdp90 Error: invalid ifc ',ifc_
info = -4 info = -4
call psb_errpush(info,name) call psb_errpush(info,name)
goto 9999 goto 9999
@ -181,13 +181,15 @@ subroutine psb_zcsdp(a, b,info,ifc,check,trans,unitd,upd,dupl)
b%m=a%m b%m=a%m
b%k=a%k b%k=a%k
call psb_spinfo(psb_nztotreq_,a,size_req,info) call psb_spinfo(psb_nztotreq_,a,size_req,info)
if (debug) write(0,*) 'DCSDP : size_req 1:',size_req if (debug) write(0,*) 'DCSDP : size_req 1:',size_req,a%m,a%k
! !
n_row=b%m n_row=b%m
n_col=b%k n_col=b%k
call psb_cest(b%fida, n_row,n_col,size_req,& call psb_cest(b%fida, n_row,n_col,size_req,&
& ia1_size, ia2_size, aspk_size, upd_,info) & ia1_size, ia2_size, aspk_size, upd_,info)
!!$ write(0,*) size(b%aspk),size(b%ia1),size(b%ia2),size(b%pl),size(b%pr),&
!!$ & ia1_size, ia2_size, aspk_size,b%fida,b%m,b%k
if (info /= no_err) then if (info /= no_err) then
info=4010 info=4010
@ -195,13 +197,20 @@ subroutine psb_zcsdp(a, b,info,ifc,check,trans,unitd,upd,dupl)
call psb_errpush(info,name,a_err=ch_err) call psb_errpush(info,name,a_err=ch_err)
goto 9999 goto 9999
endif endif
if ((size(b%aspk) < aspk_size) .or.& if (.not.associated(b%aspk).or.&
&.not.associated(b%ia1).or.&
&.not.associated(b%ia2).or.&
&.not.associated(b%pl).or.&
&.not.associated(b%pr)) then
call psb_sp_reall(b,ia1_size,ia2_size,aspk_size,info)
else if ((size(b%aspk) < aspk_size) .or.&
&(size(b%ia1) < ia1_size) .or.& &(size(b%ia1) < ia1_size) .or.&
&(size(b%ia2) < ia2_size) .or.& &(size(b%ia2) < ia2_size) .or.&
&(size(b%pl) < b%m) .or.& &(size(b%pl) < b%m) .or.&
&(size(b%pr) < b%k )) then &(size(b%pr) < b%k )) then
call psb_sp_reall(b,ia1_size,ia2_size,aspk_size,info) call psb_sp_reall(b,ia1_size,ia2_size,aspk_size,info)
endif endif
if (info /= no_err) then if (info /= no_err) then
info=4010 info=4010
ch_err='psb_sp_reall' ch_err='psb_sp_reall'

@ -0,0 +1,92 @@
!!$
!!$ Parallel Sparse BLAS v2.0
!!$ (C) Copyright 2006 Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari University of Rome Tor Vergata
!!$
!!$ Redistribution and use in source and binary forms, with or without
!!$ modification, are permitted provided that the following conditions
!!$ are met:
!!$ 1. Redistributions of source code must retain the above copyright
!!$ notice, this list of conditions and the following disclaimer.
!!$ 2. Redistributions in binary form must reproduce the above copyright
!!$ notice, this list of conditions, and the following disclaimer in the
!!$ documentation and/or other materials provided with the distribution.
!!$ 3. The name of the PSBLAS group or the names of its contributors may
!!$ not be used to endorse or promote products derived from this
!!$ software without specific written permission.
!!$
!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS
!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
!!$ POSSIBILITY OF SUCH DAMAGE.
!!$
!!$
! File: psb_ztransc.f90
! Subroutine:
! Parameters:
subroutine psb_ztransc(a,b,c,fmt)
use psb_spmat_type
use psb_tools_mod
use psb_string_mod
use psb_serial_mod, only : psb_ipcoo2csr, psb_ipcsr2coo, psb_fixcoo
implicit none
type(psb_zspmat_type) :: a,b
integer, optional :: c
character(len=*), optional :: fmt
character(len=5) :: fmt_
integer ::c_, info, nz, i
integer, pointer :: itmp(:)
if (present(c)) then
c_=c
else
c_=1
endif
if (present(fmt)) then
fmt_ = toupper(fmt)
else
fmt_='CSR'
endif
if (associated(b%aspk)) call psb_sp_free(b,info)
call psb_sp_clone(a,b,info)
if (b%fida=='CSR') then
call psb_ipcsr2coo(b,info)
else if (b%fida=='COO') then
! do nothing
else
write(0,*) 'Unimplemented case in TRANSC '
endif
itmp => b%ia1
b%ia1 => b%ia2
b%ia2 => itmp
b%m = a%k
b%k = a%m
do i=1, b%infoa(psb_nnz_)
b%aspk(i) = conjg(b%aspk(i))
end do
!!$ write(0,*) 'Calling IPCOO2CSR from transc90 ',b%m,b%k
if (fmt_=='CSR') then
call psb_ipcoo2csr(b,info)
b%fida='CSR'
else if (fmt_=='COO') then
call psb_fixcoo(b,info)
b%fida='COO'
else
write(0,*) 'Unknown FMT in TRANSC : "',fmt_,'"'
endif
return
end subroutine psb_ztransc

@ -45,7 +45,7 @@ subroutine psb_ztransp(a,b,c,fmt)
character(len=5) :: fmt_ character(len=5) :: fmt_
integer ::c_, info, nz integer ::c_, info, nz
integer, pointer :: itmp(:)=>null() integer, pointer :: itmp(:)
if (present(c)) then if (present(c)) then
c_=c c_=c
else else

@ -35,13 +35,11 @@
! Allocates dense matrix for PSBLAS routines ! Allocates dense matrix for PSBLAS routines
! !
! Parameters: ! Parameters:
! m - number of rows.
! n - number of columns.
! x - the matrix to be allocated. ! x - the matrix to be allocated.
! desc_a - the communication descriptor. ! desc_a - the communication descriptor.
! info - eventually returns an error code ! info - possibly returns an error code
! js - (optional) the starting column ! n - optional number of columns.
subroutine psb_dalloc(m, n, x, desc_a, info, js) subroutine psb_dalloc(x, desc_a, info, n)
!....allocate dense matrix for psblas routines..... !....allocate dense matrix for psblas routines.....
use psb_descriptor_type use psb_descriptor_type
use psb_const_mod use psb_const_mod
@ -50,18 +48,17 @@ subroutine psb_dalloc(m, n, x, desc_a, info, js)
implicit none implicit none
!....parameters... !....parameters...
integer, intent(in) :: m,n
real(kind(1.d0)), pointer :: x(:,:) real(kind(1.d0)), pointer :: x(:,:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer :: info integer :: info
integer, optional, intent(in) :: js integer, optional, intent(in) :: n
!locals !locals
integer :: nprow,npcol,myrow,mycol,err,n_col,n_row,i,j,jj,err_act integer :: nprow,npcol,myrow,mycol,err,n_col,n_row,i,j,jj,err_act
integer :: icontxt,dectype integer :: icontxt,dectype,n_
integer :: int_err(5),temp(1),exch(3) integer :: int_err(5),temp(1),exch(3)
real(kind(1.d0)) :: real_err(5) real(kind(1.d0)) :: real_err(5)
integer, allocatable:: prc_v(:)
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_dallc' name='psb_dallc'
@ -88,88 +85,56 @@ subroutine psb_dalloc(m, n, x, desc_a, info, js)
dectype=desc_a%matrix_data(psb_dec_type_) dectype=desc_a%matrix_data(psb_dec_type_)
!... check m and n parameters.... !... check m and n parameters....
if (m.lt.0) then if (.not.psb_is_ok_dec(dectype)) then
info = 10
int_err(1) = 1
int_err(2) = m
call psb_errpush(info,name,int_err)
goto 9999
else if (n.lt.0) then
info = 10
int_err(1) = 2
int_err(2) = n
call psb_errpush(info,name,int_err)
else if (.not.psb_is_ok_dec(dectype)) then
info = 3110 info = 3110
call psb_errpush(info,name) call psb_errpush(info,name)
goto 9999 goto 9999
else if (m.ne.desc_a%matrix_data(psb_n_)) then
info = 300
int_err(1) = 1
int_err(2) = m
int_err(3) = 4
int_err(4) = psb_n_
int_err(5) = desc_a%matrix_data(psb_n_)
call psb_errpush(info,name,int_err)
goto 9999
endif endif
if (present(js)) then if (present(n)) then
j=js n_ = n
else else
j=1 n_ = 1
endif endif
!global check on m and n parameters !global check on n parameters
if (myrow.eq.psb_root_) then if (myrow.eq.psb_root_) then
exch(1)=m exch(1)=n_
exch(2)=n call igebs2d(icontxt,psb_all_,psb_topdef_, ione,ione, exch, ione)
exch(3)=j
call igebs2d(icontxt,psb_all_,psb_topdef_, ithree,ione, exch, ithree)
else else
call igebr2d(icontxt,psb_all_,psb_topdef_, ithree,ione, exch, ithree, psb_root_, 0) call igebr2d(icontxt,psb_all_,psb_topdef_, ione,ione, exch, ione, psb_root_, 0)
if (exch(1).ne.m) then if (exch(1).ne.n_) then
info=550 info=550
int_err(1)=1 int_err(1)=1
call psb_errpush(info,name,int_err) call psb_errpush(info,name,int_err)
goto 9999 goto 9999
else if (exch(2).ne.n) then
info=550
int_err(1)=2
call psb_errpush(info,name,int_err)
goto 9999
else if (exch(3).ne.j) then
info=550
int_err(1)=3
call psb_errpush(info,name,int_err)
goto 9999
endif endif
endif endif
!....allocate x ..... !....allocate x .....
if (psb_is_asb_dec(dectype).or.psb_is_upd_dec(dectype)) then if (psb_is_asb_dec(dectype).or.psb_is_upd_dec(dectype)) then
n_col = max(1,desc_a%matrix_data(psb_n_col_)) n_col = max(1,desc_a%matrix_data(psb_n_col_))
allocate(x(n_col,j:j+n-1),stat=info) allocate(x(n_col,n_),stat=info)
if (info.ne.0) then if (info.ne.0) then
info=4010 info=4010
ch_err='allocate' ch_err='allocate'
call psb_errpush(info,name,a_err=ch_err) call psb_errpush(info,name,a_err=ch_err)
goto 9999 goto 9999
endif endif
do jj=j,j+n-1 do j=1,n_
do i=1,n_col do i=1,n_col
x(i,j) = 0.0d0 x(i,j) = 0.0d0
end do end do
end do end do
else if (psb_is_bld_dec(dectype)) then else if (psb_is_bld_dec(dectype)) then
n_row = max(1,desc_a%matrix_data(psb_n_row_)) n_row = max(1,desc_a%matrix_data(psb_n_row_))
allocate(x(n_row,j:j+n-1),stat=info) allocate(x(n_row,n_),stat=info)
if (info.ne.0) then if (info.ne.0) then
info=4010 info=4010
ch_err='allocate' ch_err='allocate'
call psb_errpush(info,name,a_err=ch_err) call psb_errpush(info,name,a_err=ch_err)
goto 9999 goto 9999
endif endif
do jj=j,j+n-1 do j = 1, n_
do i=1,n_row do i=1,n_row
x(i,j) = 0.0d0 x(i,j) = 0.0d0
end do end do
@ -224,11 +189,10 @@ end subroutine psb_dalloc
! Allocates dense matrix for PSBLAS routines ! Allocates dense matrix for PSBLAS routines
! !
! Parameters: ! Parameters:
! m - number of rows.
! x - the matrix to be allocated. ! x - the matrix to be allocated.
! desc_a - the communication descriptor. ! desc_a - the communication descriptor.
! info - eventually returns an error code ! info - possibly returns an error code
subroutine psb_dallocv(m, x, desc_a,info) subroutine psb_dallocv(x, desc_a,info,n)
!....allocate sparse matrix structure for psblas routines..... !....allocate sparse matrix structure for psblas routines.....
use psb_descriptor_type use psb_descriptor_type
use psb_const_mod use psb_const_mod
@ -238,14 +202,14 @@ subroutine psb_dallocv(m, x, desc_a,info)
implicit none implicit none
!....parameters... !....parameters...
integer, intent(in) :: m real(kind(1.d0)), pointer :: x(:)
real(kind(1.d0)), pointer :: x(:) type(psb_desc_type), intent(in) :: desc_a
type(psb_desc_type), intent(in):: desc_a integer :: info
integer :: info integer, optional, intent(in) :: n
!locals !locals
integer :: nprow,npcol,myrow,mycol,err,n_col,n_row,dectype,i,err_act integer :: nprow,npcol,myrow,mycol,err,n_col,n_row,dectype,i,err_act
integer :: icontxt integer :: icontxt, n_
integer :: int_err(5),temp(1),exch integer :: int_err(5),temp(1),exch
real(kind(1.d0)) :: real_err(5) real(kind(1.d0)) :: real_err(5)
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
@ -275,40 +239,13 @@ subroutine psb_dallocv(m, x, desc_a,info)
if (debug) write(0,*) 'dall: dectype',dectype if (debug) write(0,*) 'dall: dectype',dectype
if (debug) write(0,*) 'dall: is_ok? dectype',psb_is_ok_dec(dectype) if (debug) write(0,*) 'dall: is_ok? dectype',psb_is_ok_dec(dectype)
!... check m and n parameters.... !... check m and n parameters....
if (m.lt.0) then if (.not.psb_is_ok_dec(dectype)) then
info = 10
int_err(1) = 1
int_err(2) = m
call psb_errpush(info,name,int_err)
goto 9999
else if (.not.psb_is_ok_dec(dectype)) then
info = 3110 info = 3110
call psb_errpush(info,name) call psb_errpush(info,name)
goto 9999 goto 9999
else if (m.ne.desc_a%matrix_data(psb_n_)) then
info = 300
int_err(1) = 1
int_err(2) = m
int_err(3) = 4
int_err(4) = psb_n_
int_err(5) = desc_a%matrix_data(psb_n_)
call psb_errpush(info,name,int_err)
goto 9999
endif endif
!global check on m and n parameters ! As this is a rank-1 array, optional parameter N is actually ignored.
if (myrow.eq.psb_root_) then
exch = m
call igebs2d(icontxt,psb_all_,psb_topdef_, ione,ione, exch, ione)
else
call igebr2d(icontxt,psb_all_,psb_topdef_, ione,ione, exch, ione, psb_root_, 0)
if (exch .ne. m) then
info = 550
int_err(1) = 1
call psb_errpush(info,name,int_err)
goto 9999
endif
endif
!....allocate x ..... !....allocate x .....
if (psb_is_asb_dec(dectype).or.psb_is_upd_dec(dectype)) then if (psb_is_asb_dec(dectype).or.psb_is_upd_dec(dectype)) then

@ -44,7 +44,7 @@
! info - integer. Eventually returns an error code ! info - integer. Eventually returns an error code
! iblck - integer(optional). First row of submatrix belonging to blck to be inserted. ! iblck - integer(optional). First row of submatrix belonging to blck to be inserted.
! jblck - integer(optional). First col of submatrix belonging to blck to be inserted. ! jblck - integer(optional). First col of submatrix belonging to blck to be inserted.
subroutine psb_dins(m, n, x, ix, jx, blck, desc_a, info,& subroutine psb_dins(m, n, blck, x, ix, jx, desc_a, info,&
& iblck, jblck,dupl) & iblck, jblck,dupl)
!....insert dense submatrix to dense matrix ..... !....insert dense submatrix to dense matrix .....
use psb_descriptor_type use psb_descriptor_type
@ -270,7 +270,7 @@ end subroutine psb_dins
! desc_a - type(<psb_desc_type>). The communication descriptor. ! desc_a - type(<psb_desc_type>). The communication descriptor.
! info - integer. Eventually returns an error code ! info - integer. Eventually returns an error code
! iblck - integer(optional). First row of submatrix belonging to blck to be inserted. ! iblck - integer(optional). First row of submatrix belonging to blck to be inserted.
subroutine psb_dinsvm(m, x, ix, jx, blck, desc_a,info,& subroutine psb_dinsvm(m, blck, x, ix, jx, desc_a,info,&
& iblck,dupl) & iblck,dupl)
!....insert dense submatrix to dense matrix ..... !....insert dense submatrix to dense matrix .....
use psb_descriptor_type use psb_descriptor_type
@ -485,7 +485,7 @@ end subroutine psb_dinsvm
! info - integer. Eventually returns an error code ! info - integer. Eventually returns an error code
! iblck - integer(optional). First row of submatrix belonging to blck to be inserted. ! iblck - integer(optional). First row of submatrix belonging to blck to be inserted.
! insflag - integer(optional). ??? ! insflag - integer(optional). ???
subroutine psb_dinsvv(m, x, ix, blck, desc_a, info,& subroutine psb_dinsvv(m, blck, x, ix, desc_a, info,&
& iblck,insflag,dupl) & iblck,insflag,dupl)
!....insert dense submatrix to dense matrix ..... !....insert dense submatrix to dense matrix .....
use psb_descriptor_type use psb_descriptor_type

@ -34,13 +34,11 @@
! Allocates dense integer matrix for PSBLAS routines ! Allocates dense integer matrix for PSBLAS routines
! !
! Parameters: ! Parameters:
! m - integer. The number of rows. ! x - the matrix to be allocated.
! n - integer. The number of columns. ! desc_a - the communication descriptor.
! x - integer,dimension(:,:). The matrix to be allocated. ! info - possibly returns an error code
! desc_a - type(<psb_desc_type>). The communication descriptor. ! n - optional number of columns.
! info - integer. Eventually returns an error code subroutine psb_ialloc(x, desc_a, info, n)
! js - integer(optional). The starting column
subroutine psb_ialloc(m, n, x, desc_a, info,js)
!....allocate dense matrix for psblas routines..... !....allocate dense matrix for psblas routines.....
use psb_descriptor_type use psb_descriptor_type
use psb_const_mod use psb_const_mod
@ -48,19 +46,18 @@ subroutine psb_ialloc(m, n, x, desc_a, info,js)
implicit none implicit none
!....parameters... !....parameters...
integer, intent(in) :: m,n integer, pointer :: x(:,:)
integer, pointer :: x(:,:) type(psb_desc_type), intent(in) :: desc_a
type(psb_desc_type), intent(inout) :: desc_a integer, intent(out) :: info
integer, intent(out) :: info integer, optional, intent(in) :: n
integer, optional, intent(in) :: js
!locals !locals
integer :: j,nprow,npcol,myrow,mypcol,& integer :: nprow,npcol,myrow,mypcol,err,n_col,n_row,i,j,jj,err_act
& n_col,n_row, err_act integer :: icontxt,dectype,n_
integer :: icontxt,dectype
integer :: int_err(5),temp(1),exch(3) integer :: int_err(5),temp(1),exch(3)
real(kind(1.d0)) :: real_err(5) real(kind(1.d0)) :: real_err(5)
character(len=20) :: name, char_err character(len=20) :: name, ch_err
if(psb_get_errstatus().ne.0) return if(psb_get_errstatus().ne.0) return
info=0 info=0
@ -84,97 +81,70 @@ subroutine psb_ialloc(m, n, x, desc_a, info,js)
dectype=desc_a%matrix_data(psb_dec_type_) dectype=desc_a%matrix_data(psb_dec_type_)
!... check m and n parameters.... !... check m and n parameters....
if (m.lt.0) then if (.not.psb_is_ok_dec(dectype)) then
info = 10 info = 3110
int_err(1) = 1 call psb_errpush(info,name)
int_err(2) = m goto 9999
call psb_errpush(info,name,int_err)
goto 9999
else if (n.lt.0) then
info = 10
int_err(1) = 2
int_err(2) = n
call psb_errpush(info,name,int_err)
goto 9999
else if (.not.psb_is_ok_dec(dectype)) then
info = 3110
call psb_errpush(info,name)
goto 9999
else if (m.ne.desc_a%matrix_data(psb_n_)) then
info = 300
int_err(1) = 1
int_err(2) = m
int_err(3) = 4
int_err(4) = psb_n_
int_err(5) = desc_a%matrix_data(psb_n_)
call psb_errpush(info,name,int_err)
goto 9999
endif endif
if (present(js)) then if (present(n)) then
j=js n_ = n
else else
j=1 n_ = 1
endif endif
!global check on m and n parameters !global check on n parameters
if (myrow.eq.psb_root_) then if (myrow.eq.psb_root_) then
exch(1)=m exch(1)=n_
exch(2)=n call igebs2d(icontxt,psb_all_,psb_topdef_, ione,ione, exch, ione)
exch(3)=j
call igebs2d(icontxt,psb_all_,psb_topdef_, ithree,ione, exch, ithree)
else else
call igebr2d(icontxt,psb_all_,psb_topdef_, ithree,ione, exch, ithree, psb_root_, 0) call igebr2d(icontxt,psb_all_,psb_topdef_, ione,ione, exch, ione, psb_root_, 0)
if (exch(1).ne.m) then if (exch(1).ne.n_) then
info=550 info=550
int_err(1)=1 int_err(1)=1
call psb_errpush(info,name,int_err) call psb_errpush(info,name,int_err)
goto 9999 goto 9999
else if (exch(2).ne.n) then endif
info=550
int_err(1)=2
call psb_errpush(info,name,int_err)
goto 9999
else if (exch(3).ne.j) then
info=550
int_err(1)=3
call psb_errpush(info,name,int_err)
goto 9999
endif
endif endif
!....allocate x ..... !....allocate x .....
if (psb_is_asb_dec(dectype).or.psb_is_upd_dec(dectype)) then if (psb_is_asb_dec(dectype).or.psb_is_upd_dec(dectype)) then
n_col = max(1,desc_a%matrix_data(psb_n_col_)) n_col = max(1,desc_a%matrix_data(psb_n_col_))
allocate(x(n_col,j:j+n-1),stat=info) allocate(x(n_col,n_),stat=info)
if (info.ne.0) then if (info.ne.0) then
info=2025 info=4010
int_err(1)=n_col ch_err='allocate'
call psb_errpush(info,name,int_err) call psb_errpush(info,name,a_err=ch_err)
goto 9999 goto 9999
endif endif
do j=1,n_
do i=1,n_col
x(i,j) = 0
end do
end do
else if (psb_is_bld_dec(dectype)) then else if (psb_is_bld_dec(dectype)) then
n_row = max(1,desc_a%matrix_data(psb_n_row_)) n_row = max(1,desc_a%matrix_data(psb_n_row_))
allocate(x(n_row,j:j+n-1),stat=info) allocate(x(n_row,n_),stat=info)
if (info.ne.0) then if (info.ne.0) then
info=2025 info=4010
int_err(1)=n_row ch_err='allocate'
call psb_errpush(info,name,int_err) call psb_errpush(info,name,a_err=ch_err)
goto 9999 goto 9999
endif endif
do j = 1, n_
do i=1,n_row
x(i,j) = 0
end do
end do
endif endif
x = 0
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
if (err_act.eq.act_ret) then call psb_error(icontxt)
return return
else
call psb_error(icontxt)
end if end if
return return
@ -220,26 +190,28 @@ end subroutine psb_ialloc
! x - integer,dimension(:). The matrix to be allocated. ! x - integer,dimension(:). The matrix to be allocated.
! desc_a - type(<psb_desc_type>). The communication descriptor. ! desc_a - type(<psb_desc_type>). The communication descriptor.
! info - integer. Eventually returns an error code ! info - integer. Eventually returns an error code
subroutine psb_iallocv(m, x, desc_a, info) subroutine psb_iallocv(x, desc_a, info,n)
!....allocate sparse matrix structure for psblas routines..... !....allocate sparse matrix structure for psblas routines.....
use psb_descriptor_type use psb_descriptor_type
use psb_const_mod use psb_const_mod
use psb_realloc_mod
use psb_error_mod use psb_error_mod
implicit none implicit none
!....parameters... !....parameters...
integer, intent(in) :: m integer, pointer :: x(:)
integer, pointer :: x(:) type(psb_desc_type), intent(in) :: desc_a
type(psb_desc_type), intent(in) :: desc_a integer, intent(out) :: info
integer, intent(out) :: info integer, optional, intent(in) :: n
!locals !locals
integer :: nprow,npcol,myrow,mypcol,err,n_col,n_row,dectype,err_act integer :: nprow,npcol,myrow,mycol,err,n_col,n_row,dectype,i,err_act
integer :: icontxt integer :: icontxt, n_
integer :: int_err(5),temp(1),exch(2) integer :: int_err(5),temp(1),exch
real(kind(1.d0)) :: real_err(5) real(kind(1.d0)) :: real_err(5)
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
character(len=20) :: name, char_err character(len=20) :: name, ch_err
if(psb_get_errstatus().ne.0) return if(psb_get_errstatus().ne.0) return
info=0 info=0
@ -247,59 +219,31 @@ subroutine psb_iallocv(m, x, desc_a, info)
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
icontxt=desc_a%matrix_data(psb_ctxt_) icontxt=desc_a%matrix_data(psb_ctxt_)
call blacs_gridinfo(icontxt, nprow, npcol, myrow, mypcol) call blacs_gridinfo(icontxt, nprow, npcol, myrow, mycol)
! ....verify blacs grid correctness.. ! ....verify blacs grid correctness..
if (nprow.eq.-1) then if (nprow.eq.-1) then
info = 2010 info = 2010
call psb_errpush(info,name) call psb_errpush(info,name)
goto 9999 goto 9999
else if (npcol.ne.1) then else if (npcol.ne.1) then
info = 2030 info = 2030
int_err(1) = npcol int_err(1) = npcol
call psb_errpush(info,name,int_err) call psb_errpush(info,name,int_err)
goto 9999 goto 9999
endif endif
dectype=desc_a%matrix_data(psb_dec_type_) dectype=desc_a%matrix_data(psb_dec_type_)
if (debug) write(0,*) 'dall: dectype',dectype if (debug) write(0,*) 'dall: dectype',dectype
if (debug) write(0,*) 'dall: is_ok? dectype',psb_is_ok_dec(dectype) if (debug) write(0,*) 'dall: is_ok? dectype',psb_is_ok_dec(dectype)
!... check m and n parameters.... !... check m and n parameters....
if (m.lt.0) then if (.not.psb_is_ok_dec(dectype)) then
info = 10 info = 3110
int_err(1) = 1 call psb_errpush(info,name)
int_err(2) = m goto 9999
call psb_errpush(info,name,int_err)
goto 9999
else if (.not.psb_is_ok_dec(dectype)) then
info = 3110
call psb_errpush(info,name)
goto 9999
else if (m.ne.desc_a%matrix_data(psb_n_)) then
info = 300
int_err(1) = 1
int_err(2) = m
int_err(3) = 4
int_err(4) = psb_n_
int_err(5) = desc_a%matrix_data(psb_n_)
call psb_errpush(info,name,int_err)
goto 9999
endif
!global check on m and n parameters
if (myrow.eq.psb_root_) then
exch(1) = m
call igebs2d(icontxt,psb_all_,psb_topdef_, ione,ione, exch, ione)
else
call igebr2d(icontxt,psb_all_,psb_topdef_, ione,ione, exch, ione, psb_root_, 0)
if (exch(1) .ne. m) then
info = 550
int_err(1) = 1
call psb_errpush(info,name,int_err)
goto 9999
endif
endif endif
! As this is a rank-1 array, optional parameter N is actually ignored.
!....allocate x ..... !....allocate x .....
if (psb_is_asb_dec(dectype).or.psb_is_upd_dec(dectype)) then if (psb_is_asb_dec(dectype).or.psb_is_upd_dec(dectype)) then
@ -329,11 +273,9 @@ subroutine psb_iallocv(m, x, desc_a, info)
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
if (err_act.eq.act_ret) then call psb_error(icontxt)
return return
else
call psb_error(icontxt)
end if end if
return return

@ -44,7 +44,7 @@
! info - integer. Eventually returns an error code ! info - integer. Eventually returns an error code
! iblck - integer(optional). First row of submatrix belonging to blck to be inserted. ! iblck - integer(optional). First row of submatrix belonging to blck to be inserted.
! jblck - integer(optional). First col of submatrix belonging to blck to be inserted. ! jblck - integer(optional). First col of submatrix belonging to blck to be inserted.
subroutine psb_iins(m, n, x, ix, jx, blck, desc_a, info,& subroutine psb_iins(m, n, blck, x, ix, jx, desc_a, info,&
& iblck, jblck,dupl) & iblck, jblck,dupl)
!....insert dense submatrix to dense matrix ..... !....insert dense submatrix to dense matrix .....
use psb_descriptor_type use psb_descriptor_type
@ -266,7 +266,7 @@ end subroutine psb_iins
! desc_a - type(<psb_desc_type>). The communication descriptor. ! desc_a - type(<psb_desc_type>). The communication descriptor.
! info - integer. Eventually returns an error code ! info - integer. Eventually returns an error code
! iblck - integer(optional). First row of submatrix belonging to blck to be inserted. ! iblck - integer(optional). First row of submatrix belonging to blck to be inserted.
subroutine psb_iinsvm(m, x, ix, jx, blck, desc_a, info,& subroutine psb_iinsvm(m, blck, x, ix, jx, desc_a, info,&
& iblck,dupl) & iblck,dupl)
!....insert dense submatrix to dense matrix ..... !....insert dense submatrix to dense matrix .....
use psb_descriptor_type use psb_descriptor_type
@ -413,7 +413,7 @@ end subroutine psb_iinsvm
! desc_a - type(<psb_desc_type>). The communication descriptor. ! desc_a - type(<psb_desc_type>). The communication descriptor.
! info - integer. Eventually returns an error code ! info - integer. Eventually returns an error code
! iblck - integer(optional). First row of submatrix belonging to blck to be inserted. ! iblck - integer(optional). First row of submatrix belonging to blck to be inserted.
subroutine psb_iinsvv(m, x, ix, blck, desc_a, info,& subroutine psb_iinsvv(m, blck, x, ix, desc_a, info,&
& iblck,dupl) & iblck,dupl)
!....insert dense submatrix to dense matrix ..... !....insert dense submatrix to dense matrix .....
use psb_descriptor_type use psb_descriptor_type

@ -35,13 +35,11 @@
! Allocates dense matrix for PSBLAS routines ! Allocates dense matrix for PSBLAS routines
! !
! Parameters: ! Parameters:
! m - number of rows.
! n - number of columns.
! x - the matrix to be allocated. ! x - the matrix to be allocated.
! desc_a - the communication descriptor. ! desc_a - the communication descriptor.
! info - eventually returns an error code ! info - possibly returns an error code
! js - (optional) the starting column ! n - optional number of columns.
subroutine psb_zalloc(m, n, x, desc_a, info, js) subroutine psb_zalloc(x, desc_a, info, n)
!....allocate dense matrix for psblas routines..... !....allocate dense matrix for psblas routines.....
use psb_descriptor_type use psb_descriptor_type
use psb_const_mod use psb_const_mod
@ -50,18 +48,16 @@ subroutine psb_zalloc(m, n, x, desc_a, info, js)
implicit none implicit none
!....parameters... !....parameters...
integer, intent(in) :: m,n complex(kind(1.d0)), pointer :: x(:,:)
complex(kind(1.d0)), pointer :: x(:,:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer :: info integer :: info
integer, optional, intent(in) :: js integer, optional, intent(in) :: n
!locals !locals
integer :: nprow,npcol,myrow,mycol,err,n_col,n_row,i,j,jj,err_act integer :: nprow,npcol,myrow,mycol,err,n_col,n_row,i,j,jj,err_act
integer :: icontxt,dectype integer :: icontxt,dectype,n_
integer :: int_err(5),temp(1),exch(3) integer :: int_err(5),temp(1),exch(3)
real(kind(1.d0)) :: real_err(5) real(kind(1.d0)) :: real_err(5)
integer, allocatable:: prc_v(:)
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_zallc' name='psb_zallc'
@ -88,88 +84,56 @@ subroutine psb_zalloc(m, n, x, desc_a, info, js)
dectype=desc_a%matrix_data(psb_dec_type_) dectype=desc_a%matrix_data(psb_dec_type_)
!... check m and n parameters.... !... check m and n parameters....
if (m.lt.0) then if (.not.psb_is_ok_dec(dectype)) then
info = 10
int_err(1) = 1
int_err(2) = m
call psb_errpush(info,name,int_err)
goto 9999
else if (n.lt.0) then
info = 10
int_err(1) = 2
int_err(2) = n
call psb_errpush(info,name,int_err)
else if (.not.psb_is_ok_dec(dectype)) then
info = 3110 info = 3110
call psb_errpush(info,name) call psb_errpush(info,name)
goto 9999 goto 9999
else if (m.ne.desc_a%matrix_data(psb_n_)) then
info = 300
int_err(1) = 1
int_err(2) = m
int_err(3) = 4
int_err(4) = psb_n_
int_err(5) = desc_a%matrix_data(psb_n_)
call psb_errpush(info,name,int_err)
goto 9999
endif endif
if (present(js)) then if (present(n)) then
j=js n_ = n
else else
j=1 n_ = 1
endif endif
!global check on m and n parameters !global check on n parameters
if (myrow.eq.psb_root_) then if (myrow.eq.psb_root_) then
exch(1)=m exch(1)=n_
exch(2)=n call igebs2d(icontxt,psb_all_,psb_topdef_, ione,ione, exch, ione)
exch(3)=j
call igebs2d(icontxt,psb_all_,psb_topdef_, ithree,ione, exch, ithree)
else else
call igebr2d(icontxt,psb_all_,psb_topdef_, ithree,ione, exch, ithree, psb_root_, 0) call igebr2d(icontxt,psb_all_,psb_topdef_, ione,ione, exch, ione, psb_root_, 0)
if (exch(1).ne.m) then if (exch(1).ne.n_) then
info=550 info=550
int_err(1)=1 int_err(1)=1
call psb_errpush(info,name,int_err) call psb_errpush(info,name,int_err)
goto 9999 goto 9999
else if (exch(2).ne.n) then
info=550
int_err(1)=2
call psb_errpush(info,name,int_err)
goto 9999
else if (exch(3).ne.j) then
info=550
int_err(1)=3
call psb_errpush(info,name,int_err)
goto 9999
endif endif
endif endif
!....allocate x ..... !....allocate x .....
if (psb_is_asb_dec(dectype).or.psb_is_upd_dec(dectype)) then if (psb_is_asb_dec(dectype).or.psb_is_upd_dec(dectype)) then
n_col = max(1,desc_a%matrix_data(psb_n_col_)) n_col = max(1,desc_a%matrix_data(psb_n_col_))
allocate(x(n_col,j:j+n-1),stat=info) allocate(x(n_col,n_),stat=info)
if (info.ne.0) then if (info.ne.0) then
info=4010 info=4010
ch_err='allocate' ch_err='allocate'
call psb_errpush(info,name,a_err=ch_err) call psb_errpush(info,name,a_err=ch_err)
goto 9999 goto 9999
endif endif
do jj=j,j+n-1 do j=1,n_
do i=1,n_col do i=1,n_col
x(i,j) = 0.0d0 x(i,j) = 0.0d0
end do end do
end do end do
else if (psb_is_bld_dec(dectype)) then else if (psb_is_bld_dec(dectype)) then
n_row = max(1,desc_a%matrix_data(psb_n_row_)) n_row = max(1,desc_a%matrix_data(psb_n_row_))
allocate(x(n_row,j:j+n-1),stat=info) allocate(x(n_row,n_),stat=info)
if (info.ne.0) then if (info.ne.0) then
info=4010 info=4010
ch_err='allocate' ch_err='allocate'
call psb_errpush(info,name,a_err=ch_err) call psb_errpush(info,name,a_err=ch_err)
goto 9999 goto 9999
endif endif
do jj=j,j+n-1 do j = 1, n_
do i=1,n_row do i=1,n_row
x(i,j) = 0.0d0 x(i,j) = 0.0d0
end do end do
@ -224,11 +188,10 @@ end subroutine psb_zalloc
! Allocates dense matrix for PSBLAS routines ! Allocates dense matrix for PSBLAS routines
! !
! Parameters: ! Parameters:
! m - number of rows.
! x - the matrix to be allocated. ! x - the matrix to be allocated.
! desc_a - the communication descriptor. ! desc_a - the communication descriptor.
! info - eventually returns an error code ! info - possibly returns an error code
subroutine psb_zallocv(m, x, desc_a,info) subroutine psb_zallocv(x, desc_a,info,n)
!....allocate sparse matrix structure for psblas routines..... !....allocate sparse matrix structure for psblas routines.....
use psb_descriptor_type use psb_descriptor_type
use psb_const_mod use psb_const_mod
@ -238,14 +201,14 @@ subroutine psb_zallocv(m, x, desc_a,info)
implicit none implicit none
!....parameters... !....parameters...
integer, intent(in) :: m complex(kind(1.d0)), pointer :: x(:)
complex(kind(1.d0)), pointer :: x(:) type(psb_desc_type), intent(in) :: desc_a
type(psb_desc_type), intent(in):: desc_a integer :: info
integer :: info integer, optional, intent(in) :: n
!locals !locals
integer :: nprow,npcol,myrow,mycol,err,n_col,n_row,dectype,i,err_act integer :: nprow,npcol,myrow,mycol,err,n_col,n_row,dectype,i,err_act
integer :: icontxt integer :: icontxt, n_
integer :: int_err(5),temp(1),exch integer :: int_err(5),temp(1),exch
real(kind(1.d0)) :: real_err(5) real(kind(1.d0)) :: real_err(5)
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
@ -275,40 +238,13 @@ subroutine psb_zallocv(m, x, desc_a,info)
if (debug) write(0,*) 'dall: dectype',dectype if (debug) write(0,*) 'dall: dectype',dectype
if (debug) write(0,*) 'dall: is_ok? dectype',psb_is_ok_dec(dectype) if (debug) write(0,*) 'dall: is_ok? dectype',psb_is_ok_dec(dectype)
!... check m and n parameters.... !... check m and n parameters....
if (m.lt.0) then if (.not.psb_is_ok_dec(dectype)) then
info = 10
int_err(1) = 1
int_err(2) = m
call psb_errpush(info,name,int_err)
goto 9999
else if (.not.psb_is_ok_dec(dectype)) then
info = 3110 info = 3110
call psb_errpush(info,name) call psb_errpush(info,name)
goto 9999 goto 9999
else if (m.ne.desc_a%matrix_data(psb_n_)) then
info = 300
int_err(1) = 1
int_err(2) = m
int_err(3) = 4
int_err(4) = psb_n_
int_err(5) = desc_a%matrix_data(psb_n_)
call psb_errpush(info,name,int_err)
goto 9999
endif endif
!global check on m and n parameters ! As this is a rank-1 array, optional parameter N is actually ignored.
if (myrow.eq.psb_root_) then
exch = m
call igebs2d(icontxt,psb_all_,psb_topdef_, ione,ione, exch, ione)
else
call igebr2d(icontxt,psb_all_,psb_topdef_, ione,ione, exch, ione, psb_root_, 0)
if (exch .ne. m) then
info = 550
int_err(1) = 1
call psb_errpush(info,name,int_err)
goto 9999
endif
endif
!....allocate x ..... !....allocate x .....
if (psb_is_asb_dec(dectype).or.psb_is_upd_dec(dectype)) then if (psb_is_asb_dec(dectype).or.psb_is_upd_dec(dectype)) then

@ -44,7 +44,7 @@
! info - integer. Eventually returns an error code ! info - integer. Eventually returns an error code
! iblck - integer(optional). First row of submatrix belonging to blck to be inserted. ! iblck - integer(optional). First row of submatrix belonging to blck to be inserted.
! jblck - integer(optional). First col of submatrix belonging to blck to be inserted. ! jblck - integer(optional). First col of submatrix belonging to blck to be inserted.
subroutine psb_zins(m, n, x, ix, jx, blck, desc_a, info,& subroutine psb_zins(m, n, blck, x, ix, jx, desc_a, info,&
& iblck, jblck,dupl) & iblck, jblck,dupl)
!....insert dense submatrix to dense matrix ..... !....insert dense submatrix to dense matrix .....
use psb_descriptor_type use psb_descriptor_type
@ -268,7 +268,7 @@ end subroutine psb_zins
! desc_a - type(<psb_desc_type>). The communication descriptor. ! desc_a - type(<psb_desc_type>). The communication descriptor.
! info - integer. Eventually returns an error code ! info - integer. Eventually returns an error code
! iblck - integer(optional). First row of submatrix belonging to blck to be inserted. ! iblck - integer(optional). First row of submatrix belonging to blck to be inserted.
subroutine psb_zinsvm(m, x, ix, jx, blck, desc_a,info,& subroutine psb_zinsvm(m, blck, x, ix, jx, desc_a,info,&
& iblck,dupl) & iblck,dupl)
!....insert dense submatrix to dense matrix ..... !....insert dense submatrix to dense matrix .....
use psb_descriptor_type use psb_descriptor_type
@ -483,7 +483,7 @@ end subroutine psb_zinsvm
! info - integer. Eventually returns an error code ! info - integer. Eventually returns an error code
! iblck - integer(optional). First row of submatrix belonging to blck to be inserted. ! iblck - integer(optional). First row of submatrix belonging to blck to be inserted.
! insflag - integer(optional). ??? ! insflag - integer(optional). ???
subroutine psb_zinsvv(m, x, ix, blck, desc_a, info,& subroutine psb_zinsvv(m, blck, x, ix, desc_a, info,&
& iblck,insflag,dupl) & iblck,insflag,dupl)
!....insert dense submatrix to dense matrix ..... !....insert dense submatrix to dense matrix .....
use psb_descriptor_type use psb_descriptor_type

@ -162,6 +162,7 @@ subroutine psb_zspasb(a,desc_a, info, afmt, upd, dupl)
! Do the real conversion into the requested storage format ! Do the real conversion into the requested storage format
! result is put in A ! result is put in A
write(0,*) 'Calling csdp from SPASB'
call psb_csdp(atemp,a,info,ifc=2,upd=upd_,dupl=dupl_) call psb_csdp(atemp,a,info,ifc=2,upd=upd_,dupl=dupl_)
IF (debug) WRITE (*, *) myrow,' ASB: From DCSDP',info,' ',A%FIDA IF (debug) WRITE (*, *) myrow,' ASB: From DCSDP',info,' ',A%FIDA

@ -208,10 +208,10 @@ program df_sample
& desc_a,b_col_glob,b_col,info,fmt=afmt) & desc_a,b_col_glob,b_col,info,fmt=afmt)
end if end if
call psb_geall(m_problem,x_col,desc_a,info) call psb_geall(x_col,desc_a,info)
x_col(:) =0.0 x_col(:) =0.0
call psb_geasb(x_col,desc_a,info) call psb_geasb(x_col,desc_a,info)
call psb_geall(m_problem,r_col,desc_a,info) call psb_geall(r_col,desc_a,info)
r_col(:) =0.0 r_col(:) =0.0
call psb_geasb(r_col,desc_a,info) call psb_geasb(r_col,desc_a,info)
t2 = mpi_wtime() - t1 t2 = mpi_wtime() - t1

@ -1,13 +1,46 @@
!!$
!!$ Parallel Sparse BLAS v2.0
!!$ (C) Copyright 2006 Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari University of Rome Tor Vergata
!!$
!!$ Redistribution and use in source and binary forms, with or without
!!$ modification, are permitted provided that the following conditions
!!$ are met:
!!$ 1. Redistributions of source code must retain the above copyright
!!$ notice, this list of conditions and the following disclaimer.
!!$ 2. Redistributions in binary form must reproduce the above copyright
!!$ notice, this list of conditions, and the following disclaimer in the
!!$ documentation and/or other materials provided with the distribution.
!!$ 3. The name of the PSBLAS group or the names of its contributors may
!!$ not be used to endorse or promote products derived from this
!!$ software without specific written permission.
!!$
!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS
!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
!!$ POSSIBILITY OF SUCH DAMAGE.
!!$
!!$
!
! Storage conversion filter: reads from standar input a sparse matrix
! stored in Harwell-Boeing format, and writes to standard output in MatrixMarket
! format
!
program dhb2mm program dhb2mm
use psb_sparse_mod use psb_sparse_mod
use mmio use mmio
use hbio use hbio
type(psb_dspmat_type) :: a type(psb_dspmat_type) :: a
integer n, nnz,info,i,j,k integer :: info
INTEGER :: iwflag,IOUT,NCOL,NELTVL,NNZERO,NRHS,NRHSIX,NROW,& character(len=72) :: mtitle
& iter
CHARACTER :: RHSDATATYPE,DATATYPE*3,KEY*8,OUTFILE*20,MTITLE*72
call hb_read(a,info,mtitle=mtitle) call hb_read(a,info,mtitle=mtitle)

@ -1,14 +1,45 @@
!!$
!!$ Parallel Sparse BLAS v2.0
!!$ (C) Copyright 2006 Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari University of Rome Tor Vergata
!!$
!!$ Redistribution and use in source and binary forms, with or without
!!$ modification, are permitted provided that the following conditions
!!$ are met:
!!$ 1. Redistributions of source code must retain the above copyright
!!$ notice, this list of conditions and the following disclaimer.
!!$ 2. Redistributions in binary form must reproduce the above copyright
!!$ notice, this list of conditions, and the following disclaimer in the
!!$ documentation and/or other materials provided with the distribution.
!!$ 3. The name of the PSBLAS group or the names of its contributors may
!!$ not be used to endorse or promote products derived from this
!!$ software without specific written permission.
!!$
!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS
!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
!!$ POSSIBILITY OF SUCH DAMAGE.
!!$
!!$
!
! Storage conversion filter: reads from standar input a sparse matrix
! stored in MatrixMarket format, and writes to standard output in Harwell-Boeing
! format
!
program dmm2hb program dmm2hb
use psb_sparse_mod use psb_sparse_mod
use mmio use mmio
use hbio use hbio
type(psb_dspmat_type) :: a type(psb_dspmat_type) :: a
integer n, nnz,info,i,j,k integer info
nrhs = 0
nrhsix = 0
call mm_mat_read(a,info) call mm_mat_read(a,info)

@ -211,7 +211,7 @@ contains
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
call psb_geall(nrow,b,desc_a,info) call psb_geall(b,desc_a,info)
if(info/=0) then if(info/=0) then
info=4010 info=4010
ch_err='psb_psdsall' ch_err='psb_psdsall'
@ -272,7 +272,7 @@ contains
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
call psb_geins(nnr,b,i_count,b_glob(i_count:j_count-1),& call psb_geins(nnr,b_glob(i_count:j_count-1),b,i_count,&
&desc_a,info) &desc_a,info)
if(info/=0) then if(info/=0) then
info=4010 info=4010
@ -318,7 +318,7 @@ contains
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
call psb_geins(nnr,b,i_count,b_glob(i_count:i_count+nnr-1),& call psb_geins(nnr,b_glob(i_count:i_count+nnr-1),b,i_count,&
&desc_a,info) &desc_a,info)
if(info/=0) then if(info/=0) then
info=4010 info=4010
@ -354,7 +354,7 @@ contains
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
call psb_geins(1,b,i_count,b_glob(i_count:i_count),& call psb_geins(1,b_glob(i_count:i_count),b,i_count,&
&desc_a,info) &desc_a,info)
if(info/=0) then if(info/=0) then
info=4010 info=4010
@ -385,7 +385,7 @@ contains
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
call psb_geins(1,b,i_count,b_glob(i_count:i_count),& call psb_geins(1,b_glob(i_count:i_count),b,i_count,&
&desc_a,info) &desc_a,info)
if(info/=0) then if(info/=0) then
info=4010 info=4010
@ -633,7 +633,7 @@ contains
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
call psb_geall(nrow,b,desc_a,info) call psb_geall(b,desc_a,info)
if(info/=0) then if(info/=0) then
info=4010 info=4010
ch_err='psb_psdsall' ch_err='psb_psdsall'
@ -699,7 +699,7 @@ contains
goto 9999 goto 9999
end if end if
call psb_geins(nnr,b,i_count,b_glob(i_count:j_count-1),& call psb_geins(nnr,b_glob(i_count:j_count-1),b,i_count,&
&desc_a,info) &desc_a,info)
if(info/=0) then if(info/=0) then
info=4010 info=4010
@ -745,7 +745,7 @@ contains
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
call psb_geins(nnr,b,i_count,b_glob(i_count:i_count+nnr-1),& call psb_geins(nnr,b_glob(i_count:i_count+nnr-1),b,i_count,&
&desc_a,info) &desc_a,info)
if(info/=0) then if(info/=0) then
info=4010 info=4010
@ -994,7 +994,7 @@ contains
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
call psb_geall(nrow,b,desc_a,info) call psb_geall(b,desc_a,info)
if(info/=0) then if(info/=0) then
info=4010 info=4010
ch_err='psb_psdsall' ch_err='psb_psdsall'
@ -1055,7 +1055,7 @@ contains
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
call psb_geins(nnr,b,i_count,b_glob(i_count:j_count-1),& call psb_geins(nnr,b_glob(i_count:j_count-1),b,i_count,&
&desc_a,info) &desc_a,info)
if(info/=0) then if(info/=0) then
info=4010 info=4010
@ -1101,7 +1101,7 @@ contains
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
call psb_geins(nnr,b,i_count,b_glob(i_count:i_count+nnr-1),& call psb_geins(nnr,b_glob(i_count:i_count+nnr-1),b,i_count,&
&desc_a,info) &desc_a,info)
if(info/=0) then if(info/=0) then
info=4010 info=4010
@ -1137,7 +1137,7 @@ contains
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
call psb_geins(1,b,i_count,b_glob(i_count:i_count),& call psb_geins(1,b_glob(i_count:i_count),b,i_count,&
&desc_a,info) &desc_a,info)
if(info/=0) then if(info/=0) then
info=4010 info=4010
@ -1168,7 +1168,7 @@ contains
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
call psb_geins(1,b,i_count,b_glob(i_count:i_count),& call psb_geins(1,b_glob(i_count:i_count),b,i_count,&
&desc_a,info) &desc_a,info)
if(info/=0) then if(info/=0) then
info=4010 info=4010
@ -1416,7 +1416,7 @@ contains
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
call psb_geall(nrow,b,desc_a,info) call psb_geall(b,desc_a,info)
if(info/=0) then if(info/=0) then
info=4010 info=4010
ch_err='psb_psdsall' ch_err='psb_psdsall'
@ -1482,7 +1482,7 @@ contains
goto 9999 goto 9999
end if end if
call psb_geins(nnr,b,i_count,b_glob(i_count:j_count-1),& call psb_geins(nnr,b_glob(i_count:j_count-1),b,i_count,&
&desc_a,info) &desc_a,info)
if(info/=0) then if(info/=0) then
info=4010 info=4010
@ -1528,7 +1528,7 @@ contains
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
call psb_geins(nnr,b,i_count,b_glob(i_count:i_count+nnr-1),& call psb_geins(nnr,b_glob(i_count:i_count+nnr-1),b,i_count,&
&desc_a,info) &desc_a,info)
if(info/=0) then if(info/=0) then
info=4010 info=4010

@ -209,10 +209,10 @@ program zf_sample
& desc_a,b_col_glob,b_col,info,fmt=afmt) & desc_a,b_col_glob,b_col,info,fmt=afmt)
end if end if
call psb_geall(m_problem,x_col,desc_a,info) call psb_geall(x_col,desc_a,info)
x_col(:) =0.0 x_col(:) =0.0
call psb_geasb(x_col,desc_a,info) call psb_geasb(x_col,desc_a,info)
call psb_geall(m_problem,r_col,desc_a,info) call psb_geall(r_col,desc_a,info)
r_col(:) =0.0 r_col(:) =0.0
call psb_geasb(r_col,desc_a,info) call psb_geasb(r_col,desc_a,info)
t2 = mpi_wtime() - t1 t2 = mpi_wtime() - t1

@ -1,13 +1,46 @@
!!$
!!$ Parallel Sparse BLAS v2.0
!!$ (C) Copyright 2006 Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari University of Rome Tor Vergata
!!$
!!$ Redistribution and use in source and binary forms, with or without
!!$ modification, are permitted provided that the following conditions
!!$ are met:
!!$ 1. Redistributions of source code must retain the above copyright
!!$ notice, this list of conditions and the following disclaimer.
!!$ 2. Redistributions in binary form must reproduce the above copyright
!!$ notice, this list of conditions, and the following disclaimer in the
!!$ documentation and/or other materials provided with the distribution.
!!$ 3. The name of the PSBLAS group or the names of its contributors may
!!$ not be used to endorse or promote products derived from this
!!$ software without specific written permission.
!!$
!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS
!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
!!$ POSSIBILITY OF SUCH DAMAGE.
!!$
!!$
!
! Storage conversion filter: reads from standar input a sparse matrix
! stored in Harwell-Boeing format, and writes to standard output in MatrixMarket
! format
!
program zhb2mm program zhb2mm
use psb_sparse_mod use psb_sparse_mod
use mmio use mmio
use hbio use hbio
type(psb_zspmat_type) :: a type(psb_zspmat_type) :: a
integer n, nnz,info,i,j,k integer :: info
INTEGER :: iwflag,IOUT,NCOL,NELTVL,NNZERO,NRHS,NRHSIX,NROW,& character(len=72) :: mtitle
& iter
CHARACTER :: RHSDATATYPE,DATATYPE*3,KEY*8,OUTFILE*20,MTITLE*72
call hb_read(a,info,mtitle=mtitle) call hb_read(a,info,mtitle=mtitle)

@ -1,14 +1,45 @@
!!$
!!$ Parallel Sparse BLAS v2.0
!!$ (C) Copyright 2006 Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari University of Rome Tor Vergata
!!$
!!$ Redistribution and use in source and binary forms, with or without
!!$ modification, are permitted provided that the following conditions
!!$ are met:
!!$ 1. Redistributions of source code must retain the above copyright
!!$ notice, this list of conditions and the following disclaimer.
!!$ 2. Redistributions in binary form must reproduce the above copyright
!!$ notice, this list of conditions, and the following disclaimer in the
!!$ documentation and/or other materials provided with the distribution.
!!$ 3. The name of the PSBLAS group or the names of its contributors may
!!$ not be used to endorse or promote products derived from this
!!$ software without specific written permission.
!!$
!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS
!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
!!$ POSSIBILITY OF SUCH DAMAGE.
!!$
!!$
!
! Storage conversion filter: reads from standar input a sparse matrix
! stored in MatrixMarket format, and writes to standard output in Harwell-Boeing
! format
!
program zmm2hb program zmm2hb
use psb_sparse_mod use psb_sparse_mod
use mmio use mmio
use hbio use hbio
type(psb_zspmat_type) :: a type(psb_zspmat_type) :: a
integer n, nnz,info,i,j,k integer info
nrhs = 0
nrhsix = 0
call mm_mat_read(a,info) call mm_mat_read(a,info)

@ -489,8 +489,8 @@ contains
call psb_cdall(n,n,parts,icontxt,desc_a,info) call psb_cdall(n,n,parts,icontxt,desc_a,info)
call psb_spall(a,desc_a,info,nnz=nnz) call psb_spall(a,desc_a,info,nnz=nnz)
! define rhs from boundary conditions; also build initial guess ! define rhs from boundary conditions; also build initial guess
call psb_geall(n,b,desc_a,info) call psb_geall(b,desc_a,info)
call psb_geall(n,t,desc_a,info) call psb_geall(t,desc_a,info)
if(info.ne.0) then if(info.ne.0) then
info=4010 info=4010
ch_err='allocation rout.' ch_err='allocation rout.'
@ -644,10 +644,10 @@ contains
call psb_spins(element-1,irow,icol,val,a,desc_a,info) call psb_spins(element-1,irow,icol,val,a,desc_a,info)
if(info.ne.0) exit if(info.ne.0) exit
tins = tins + (mpi_wtime()-t3) tins = tins + (mpi_wtime()-t3)
call psb_geins(1,b,ia,zt(1:1),desc_a,info) call psb_geins(1,zt(1:1),b,ia,desc_a,info)
if(info.ne.0) exit if(info.ne.0) exit
zt(1)=0.d0 zt(1)=0.d0
call psb_geins(1,t,ia,zt(1:1),desc_a,info) call psb_geins(1,zt(1:1),t,ia,desc_a,info)
if(info.ne.0) exit if(info.ne.0) exit
end if end if
end do end do

Loading…
Cancel
Save