fdurastante/psblas3
1
0
Fork 0
mirror of https://github.com/sfilippone/psblas3.git synced 2026-10-19 04:12:09 +00:00
Code Issues Packages Projects Releases Wiki Activity

Modified interface to GEALL, GEINS et al.

Browse Source 
Changed ITRACE behaviour in solver routines.
Updated documentation.
This commit is contained in:
Salvatore Filippone
2006-04-24 12:02:04 +00:00
parent 41d7626b66
commit d003f55d95
48 changed files with 18464 additions and 17667 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Changelog
+5 -1
View File
@@ -1,7 +1,11 @@
Changelog. A lot less detailed than usual, at least for past
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.
2006/04/18: Changed interface to spasb and csdp: better handling of
Make.inc.gfortran → Make.inc.gcc42
+11 -11
View File
@@ -6,10 +6,10 @@
####################### Section 1 #######################
# Define your compilers and compiler flags here #
##########################################################
F90=/usr/local/gfortran/bin/gfortran
FC=/usr/local/gfortran/bin/gfortran
F90=/usr/local/gcc42/bin/gfortran
FC=/usr/local/gcc42/bin/gfortran
F77=$(FC)
CC=/usr/local/gfortran/bin/gcc
CC=/usr/local/gcc42/bin/gcc
F90COPT= -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
@@ -17,17 +17,17 @@ CCOPT=-O3 -ffast-math -march=pentium4 -msse2 -mfpmath=sse
####################### Section 2 #######################
# Define your linker and linker flags here #
##########################################################
F90LINK=/usr/local/mpich-gfortran/bin/mpif90
FLINK=/usr/local/mpich-gfortran/bin/mpif77
MPF90=/usr/local/mpich-gfortran/bin/mpif90
MPF77=/usr/local/mpich-gfortran/bin/mpif77
MPCC=/usr/local/mpich-gfortran/bin/mpicc
F90LINK=/usr/local/mpich-gcc42/bin/mpif90
FLINK=/usr/local/mpich-gcc42/bin/mpif77
MPF90=/usr/local/mpich-gcc42/bin/mpif90
MPF77=/usr/local/mpich-gcc42/bin/mpif77
MPCC=/usr/local/mpich-gcc42/bin/mpicc
####################### Section 3 #######################
# Specify paths to libraries #
##########################################################
BLAS=-lblas-gcc41 -L$(HOME)/LIB
BLACS=-lmpiblacs-gfortran -L$(HOME)/LIB
BLAS=-lblas-gcc42 -L$(HOME)/LIB
BLACS=-lmpiblacs-gcc42 -L$(HOME)/LIB
EXTRA_BLACS_ENV_OBJS=extra_env.o
@@ -35,7 +35,7 @@ EXTRA_BLACS_ENV_OBJS=extra_env.o
# Other useful tools&defines #
##########################################################
SLUDIR=/usr/local/SuperLU_3.0
SLU=-lslu_lx_gfort -L$(SLUDIR)
SLU=-lslu_lx_gcc42 -L$(SLUDIR)
SLUDEF=-DHave_SLU_ -I$(SLUDIR)
UMFDIR=$(HOME)/LIB/Umfpack_gcc41
Makefile
+1 -1
View File
@@ -1,6 +1,6 @@
include Make.inc
lib:
library:
( [ -d lib ] || mkdir lib)
(cd src; make lib)
@echo "====================================="
docs/pdf/commrout.tex
+11 -19
View File
@@ -39,7 +39,7 @@ Long Precision Complex & psb\_halo \\
\item[x] global dense matrix $x$.\\
Scope: {\bf local} \\
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
Table~\ref{tab:f90halo}.
\item[desc\_a] contains data structures for communications.\\
@@ -61,7 +61,7 @@ POINTER attribute.
\item[x] global dense result matrix $x$.\\
Scope: {\bf local} \\
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
Table~\ref{tab:f90halo}.
\item[info] the local portion of result submatrix $y$.\\
@@ -104,37 +104,29 @@ Long Precision Complex & psb\_ovrl \\
\end{table}
\syntax{CALL psb\_ovrl}{x, desc\_a, info}
\syntax*{CALL psb\_ovrl}{x, desc\_a, info, choice=choice,
update\_type=update\_type, work=work}
\syntax*{CALL psb\_ovrl}{x, desc\_a, info, update=update\_type, work=work}
\begin{description}
\item[\bf On Entry]
\item[x] global dense matrix $x$.\\
Scope: {\bf local} \\
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
Table~\ref{tab:f90ovrl}.
\item[desc\_a] contains data structures for communications.\\
Scope: {\bf local} \\
Type: {\bf required}\\
Specified as: a structured data of type \descdata.
\item[choice] specify if exchange overlap elements.
\item[update] Update operator. \\
\begin{description}
\item[choice = .true.] exchange overlap elements, i.e. apply operator
$P^{T}$;
\item[choice = .false.] don't exchange overlap elements
\item[update = psb\_none\_] Do nothing;
\item[update = psb\_add\_] Sum overlap entries;
\item[update = psb\_avg\_] Average overlap entries;
%% \item[update = psb\_square\_root\_] square root update $\sqrt{P_a}$;
\end{description}
Scope: {\bf global} \\
Type: {\bf optional} \\
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. $\\
Default: $update\_type = psb\_avg\_ $\\
Scope: {\bf global} \\
Specified as: a integer variable.
\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$.\\
Scope: {\bf local} \\
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
Table~\ref{tab:f90ovrl}.
\item[info] the local portion of result submatrix $y$.\\
docs/pdf/datastruct.tex
+93 -9
View File
@@ -21,7 +21,7 @@ Fields contained in Sparse matrix structures are:
\item[{\bf aspk}] Contains values of the local distributed sparse
matrix.\\
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
matrix. Actual information will depend on data format used.\\
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.
\item[{\bf infoa}] On entry can hold auxiliary information on distributed sparse
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.\\
Specified as: a string of length 5
\item[{\bf descra}] Describe the characteristic of the distributed sparse matrix.\\
@@ -61,7 +61,7 @@ type psb_dspmat_type
integer :: m, k
character :: fida(5)
character :: descra(10)
integer :: infoa(10)
integer :: infoa(psb_ifa_size_)
real(kind(1.d0)), pointer :: aspk(:)
integer, pointer :: ia1(:), ia2(:), pr(:), pl(:)
end type psb_dspmat_type
@@ -72,7 +72,9 @@ end type psb_dspmat_type
\begin{center}
\fbox{\TheSbox}
\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}
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.
\end{enumerate}
\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}
@@ -196,6 +228,41 @@ end type psb_desc_type
contains the communication descriptor.}
\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}
\label{sec:prec}
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
factorization) also more complex preconditioning methods are
implemented like the Additive Schwarz and Two-Level ones. A
preconditioner is held in the \hypertarget{precdata}{{\tt psb\_prec\_type}} data structure
which depends on the \verb|psb_base_prec| reported in
preconditioner is held in the \hypertarget{precdata}{{\tt
psb\_prec\_type}} data structure which depends on the
\verb|psb_base_prec| reported in
figure~\ref{fig:prectype}. The \verb|psb_base_prec|
data type may contain a simple preconditioning matrix with 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
method is specified, along with all the parameters that characterize
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
implementation of new kind of preconditioners. The values contained in
the \verb|iprcparm| and \verb|dprcparm| define tha type of
@@ -257,8 +325,24 @@ to be interpreted.
\end{center}
\caption{\label{fig:prectype}The PSBLAS defined data type that contains a preconditioner.}
\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:
docs/pdf/intro.tex
+9
View File
@@ -124,6 +124,15 @@ internally defined in the PSBLAS software package:
Interface overloading allows the usage of the same subroutine
interfaces for both real and complex data.
\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:
%%% mode: latex
docs/pdf/methods.tex
+2 -2
View File
@@ -23,7 +23,7 @@ or
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}
\item[\bf On Entry]
@@ -57,7 +57,7 @@ Scope: {\bf global} \\
Type: {\bf optional}\\
Default: $itmax = 1000$.\\
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} \\
Type: {\bf optional}\\
\item[istop] An integer specifying the stopping criterion.\\
docs/pdf/psbrout.tex
+168 -186
View File
@@ -10,14 +10,14 @@
This subroutine is an interface to the computational kernel for
dense matrix sum:
\[ y \leftarrow \alpha\> x+ \beta y \]
where:
\begin{description}
\item[$x$] represents the global dense submatrix $x_{:, jx:jx+n-1}$
\item[$y$] represents the global dense submatrix $y_{:, jy:jy+n-1}$
\end{description}
%% where:
%% \begin{description}
%% \item[$x$] represents the global dense submatrix $x_{:, :1}$
%% \item[$y$] represents the global dense submatrix $y_{:, :}$
%% \end{description}
\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 )
\begin{table}[h]
@@ -44,7 +44,7 @@ Specified as: a number of the data type indicated in Table~\ref{tab:f90axpby}.
$x$.\\
Scope: {\bf local} \\
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 Table~\ref{tab:f90axpby}. The rank of $x$ must be the same of $y$.
\item[beta] the scalar $\beta$.\\
@@ -55,30 +55,29 @@ Specified as: a number of the data type indicated in Table~\ref{tab:f90axpby}.
$y$. \\
Scope: {\bf local} \\
Type: {\bf required} \\
Specified as: a rank one or two array with the POINTER
attributecontaining numbers of the type
Specified as: a rank one or two array containing numbers of the type
indicated in Table~\ref{tab:f90axpby}. The rank of $y$ must be the same of $x$.
\item[desc\_a] contains data structures for communications.\\
Scope: {\bf local} \\
Type: {\bf required}\\
Specified as: a structured data of type \descdata.
\item[n] number of columns in dense submatrices $x$ and $y$.\\
Scope: {\bf global} \\
Type: {\bf optional}; can only be present if $x$ and $y$ are of rank 2.\\
Default: \verb|min(size(x,2),size(y,2))|.\\
Specified as: an integer variable $n\ge 0$.
\item[jx] the column index of the global dense matrix $x$,
identifying the first column of the submatrix $x$.\\
Scope: {\bf global} \\
Type: {\bf optional}; can only be present if $x$ and $y$ are of rank 2.\\
Default: $jx = 1$.\\
Specified as: an integer variable $jx\ge 1$.
\item[jy] the column index of the global dense matrix $y$,
identifying the first column of the submatrix $y$.\\
Scope: {\bf global} \\
Type: {\bf optional}; can only be present if $x$ and $y$ are of rank 2.\\
Default: $jy = 1$.\\
Specified as: an integer variable $jy\ge 1$.
%% \item[n] number of columns in dense submatrices $x$ and $y$.\\
%% Scope: {\bf global} \\
%% Type: {\bf optional}; can only be present if $x$ and $y$ are of rank 2.\\
%% Default: \verb|min(size(x,2),size(y,2))|.\\
%% Specified as: an integer variable $n\ge 0$.
%% \item[jx] the column index of the global dense matrix $x$,
%% identifying the first column of the submatrix $x$.\\
%% Scope: {\bf global} \\
%% Type: {\bf optional}; can only be present if $x$ and $y$ are of rank 2.\\
%% Default: $jx = 1$.\\
%% Specified as: an integer variable $jx\ge 1$.
%% \item[jy] the column index of the global dense matrix $y$,
%% identifying the first column of the submatrix $y$.\\
%% Scope: {\bf global} \\
%% Type: {\bf optional}; can only be present if $x$ and $y$ are of rank 2.\\
%% Default: $jy = 1$.\\
%% Specified as: an integer variable $jy\ge 1$.
\end{description}
@@ -111,14 +110,14 @@ computes dot-product as:
\[dot \leftarrow x^T y\]
Else if $x$ and $y$ are double precision complex vectors then computes dot-product as:
\[dot \leftarrow x^H y\]
where:
\begin{description}
\item[$x$] represents the global subvector $x_{:,jx}$
\item[$y$] represents the global subvector $y_{:,jy}$
\end{description}
%% where:
%% \begin{description}
%% \item[$x$] represents the global subvector $x_{:,jx}$
%% \item[$y$] represents the global subvector $y_{:,jy}$
%% \end{description}
\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{center}
\begin{tabular}{ll}
@@ -136,37 +135,39 @@ Long Precision Complex & psb\_gedot \\
\begin{description}
\item[\bf On Entry]
\item[x] the local portion of global dense matrix
$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$ . \\
$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$ . \\
Scope: {\bf local} \\
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
Table~\ref{tab:f90dot}. The rank of $x$ must be the same of $y$.
\item[y] the local portion of global dense matrix
$y$. 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$ . \\
$y$. \\
%% 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} \\
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
Table~\ref{tab:f90dot}. The rank of $y$ must be the same of $x$.
\item[desc\_a] contains data structures for communications.\\
Scope: {\bf local} \\
Type: {\bf required}\\
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$ and $y$ are of rank 2.\\
Default: $jx = 1$.\\
%% \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$ and $y$ are of rank 2.\\
%% Default: $jx = 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 $x$ and $y$ are of rank 2.\\
Default: $jy = 1$.\\
Specified as: an integer variable $jy\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 $x$ and $y$ are of rank 2.\\
%% Default: $jy = 1$.\\
%% Specified as: an integer variable $jy\ge 1$.
\item[\bf On Return]
\item[Function value] is the dot product of subvectors $x$ and $y$.\\
Scope: {\bf global} \\
@@ -213,14 +214,14 @@ Long Precision Complex & psb\_gedot \\
$x$. \\
Scope: {\bf local} \\
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
Table~\ref{tab:f90mdot}. The rank of $x$ must be the same of $y$.
\item[y] the local portion of global dense matrix
$y$. \\
Scope: {\bf local} \\
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
Table~\ref{tab:f90mdot}. The rank of $y$ must be the same of $x$.
\item[desc\_a] contains data structures for communications.\\
@@ -232,7 +233,7 @@ Specified as: a structured data of type \descdata.
Scope: {\bf global} \\
Specified as: a number or a rank-one array of the data type indicated
in Table~\ref{tab:f90dot}.
\item[info] the local portion of result submatrix $y$.\\
\item[info]
Scope: {\bf local} \\
Type: {\bf required} \\
An integer value that contains an error code.
@@ -254,13 +255,13 @@ computes infinity norm as:
\[ amax \leftarrow \max_i |x_i|\]
else if $x$ is a double precision complex vector then computes infinity-norm as:
\[ amax \leftarrow \max_i {(|re(x_i)| + |im(x_i)|)}\]
where:
\begin{description}
\item[$x$] represents the global subvector $x_{:,jx}$
\end{description}
%% where:
%% \begin{description}
%% \item[$x$] represents the global subvector $x_{:,jx}$
%% \end{description}
\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{center}
@@ -280,30 +281,31 @@ Long Precision Real&Long Precision Complex & psb\_geamax \\
\begin{description}
\item[\bf On Entry]
\item[x] the local portion of global dense matrix
$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$ . \\
$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$ .
\\
Scope: {\bf local} \\
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
Table~\ref{tab:f90amax}.
\item[desc\_a] contains data structures for communications.\\
Scope: {\bf local} \\
Type: {\bf required}\\
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[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[Function value] is the infinity norm of subvector $x$.\\
Scope: {\bf global} \\
Specified as: a number of the data type indicated in Table~\ref{tab:f90amax}.
\item[info] the local portion of result submatrix $y$.\\
Scope: {\bf local} \\
Specified as: a long precision real number.
\item[info]
Scope: {\bf global} \\
Type: {\bf required} \\
An integer value that contains an error code.
\end{description}
@@ -340,7 +342,7 @@ Long Precision Real &Long Precision Complex & psb\_geamax\\
$x$. \\
Scope: {\bf local} \\
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
Table~\ref{tab:f90mamax}.
\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[res] is the infinity norm of the columns of $x$.\\
Scope: {\bf global} \\
Specified as: a number or a rank-one array of the data type indicated
in Table~\ref{tab:f90amax}.
\item[info] the local portion of result submatrix $y$.\\
Specified as: a number or a rank-one array of long precision real numbers.
\item[info]
Scope: {\bf local} \\
Type: {\bf required} \\
An integer value that contains an error code.
@@ -373,22 +374,18 @@ computes 1-norm as:
\[ asum \leftarrow \|x_i\|\]
else if $x$ ic double precision complex vector then computes 1-norm as:
\[ 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, jx}
\begin{table}[h]
\begin{center}
\begin{tabular}{ll}
\begin{tabular}{lll}
\hline
$dot$, $x$, $y$ & {\bf Function}\\
$asum$ & $x$ & {\bf Function}\\
\hline
Long Precision Real & psb\_geasum \\
Long Precision Complex & psb\_geasum \\
Long Precision Real&Long Precision Real & psb\_geasum \\
Long Precision Real&Long Precision Complex & psb\_geasum \\
\hline
\end{tabular}
\end{center}
@@ -398,29 +395,24 @@ Long Precision Complex & psb\_geasum \\
\begin{description}
\item[\bf On Entry]
\item[x] the local portion of global dense matrix
$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$ . \\
$x$. %% This function computes the location of the first element of
%% local subarray used, based on the field $matrix\_data$ of $desc\_a$ .
\\
Scope: {\bf local} \\
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
Table~\ref{tab:f90asum}.
\item[desc\_a] contains data structures for communications.\\
Scope: {\bf local} \\
Type: {\bf required}\\
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[Function value] is the 1-norm of subvector $x$.\\
\item[Function value] is the 1-norm of vector $x$.\\
Scope: {\bf global} \\
Specified as: a number of the data type indicated in Table~\ref{tab:f90asum}.
\item[info] the local portion of result submatrix $y$.\\
Specified as: a long precision real number.
\item[info]
Scope: {\bf local} \\
Type: {\bf required} \\
An integer value that contains an error code.
@@ -442,19 +434,19 @@ computes 2-norm as:
\[ nrm2 \leftarrow \sqrt{x^T x}\]
else if $x$ is double precision complex vector then computes 2-norm as:
\[ nrm2 \leftarrow \sqrt{x^H x}\]
where:
\begin{description}
\item[$x$] represents the global subvector $x_{:,jx}$
\end{description}
%% where:
%% \begin{description}
%% \item[$x$] represents the global subvector $x_{:,jx}$
%% \end{description}
\begin{table}[h]
\begin{center}
\begin{tabular}{ll}
\begin{tabular}{lll}
\hline
$nrm2$, $x$ & {\bf Function}\\
$nrm2$ & $x$ & {\bf Function}\\
\hline
Long Precision Real & psb\_genrm2 \\
Long Precision Complex & psb\_genrm2 \\
Long Precision Real&Long Precision Real & psb\_genrm2 \\
Long Precision Real&Long Precision Complex & psb\_genrm2 \\
\hline
\end{tabular}
\end{center}
@@ -462,34 +454,35 @@ Long Precision Complex & psb\_genrm2 \\
\end{table}
\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}
\item[\bf On Entry]
\item[x] the local portion of global dense matrix
$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$ . \\
$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$ .
\\
Scope: {\bf local} \\
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
Table~\ref{tab:f90nrm2}.
\item[desc\_a] contains data structures for communications.\\
Scope: {\bf local} \\
Type: {\bf required}\\
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[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[Function Value] is the 2-norm of subvector $x$.\\
Scope: {\bf global} \\
Type: {\bf required} \\
Specified as: a number of the data type indicated in Table~\ref{tab:f90nrm2}.
\item[info] the local portion of result submatrix $y$.\\
Specified as: a long precision real number.
\item[info]
Scope: {\bf local} \\
Type: {\bf required} \\
An integer value that contains an error code.
@@ -516,7 +509,7 @@ where:
\begin{center}
\begin{tabular}{ll}
\hline
$nrmi$, $A$ & {\bf Function}\\
$A$ & {\bf Function}\\
\hline
Long Precision Real & psb\_spnrmi \\
Long Precision Complex & psb\_spnrmi \\
@@ -542,8 +535,8 @@ Specified as: a structured data of type \descdata.
\item[\bf On Return]
\item[Function value] is the infinity-norm of sparse submatrix $A$.\\
Scope: {\bf global} \\
Specified as: a number of the data type indicated in Table~\ref{tab:f90nrmi}.
\item[info] the local portion of result submatrix $y$.\\
Specified as: a long precision real number.
\item[info]
Scope: {\bf local} \\
Type: {\bf required} \\
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:
\begin{description}
\item[$x$] is the global dense submatrix $x_{:, jx:jx+k-1}$
\item[$y$] is the global dense submatrix $y_{:, jy:jy+k-1}$
\item[$x$] is the global dense submatrix $x_{:, :}$
\item[$y$] is the global dense submatrix $y_{:, :}$
\item[$A$] is the global sparse submatrix $A$
\item[$P_r, P_c$] are the permutation matrices.
\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,
trans, k, jx, jy, work}
trans, work}
\begin{description}
\item[\bf On Entry]
@@ -613,11 +606,12 @@ Scope: {\bf local} \\
Type: {\bf required}\\
Specified as: a structured data of type \spdata.
\item[x] the local portion of global dense matrix
$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$ . \\
$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$ .
\\
Scope: {\bf local} \\
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
Table~\ref{tab:f90spmm}. The rank of $x$ must be the same of $y$.
\item[beta] the scalar $\beta$.\\
@@ -625,11 +619,12 @@ Scope: {\bf global} \\
Type: {\bf required} \\
Specified as: a number of the data type indicated in Table~\ref{tab:f90spmm}.
\item[y] the local portion of global dense matrix
$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$ . \\
$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$ .
\\
Scope: {\bf local} \\
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
Table~\ref{tab:f90spmm}. The rank of $y$ must be the same of $x$.
\item[desc\_a] contains data structures for communications.\\
@@ -648,37 +643,38 @@ Scope: {\bf global} \\
Type: {\bf optional}\\
Default: $trans = N$\\
Specified as: a character variable.
\item[k] number of columns in dense submatrices $x$ and $y$. \\
Scope: {\bf global} \\
Type: {\bf optional}\\
Default: \verb|min(size(x,2)-jx+1,size(y,2)-jy+1)|\\
Specified as: an integer variable $ k \ge 1$.
\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: $iy = 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$.
%% \item[k] number of columns in dense submatrices $x$ and $y$. \\
%% Scope: {\bf global} \\
%% Type: {\bf optional}\\
%% Default: \verb|min(size(x,2)-jx+1,size(y,2)-jy+1)|\\
%% Specified as: an integer variable $ k \ge 1$.
%% \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: $iy = 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$.
\item[work] the work array.\\
\item[work] work array.\\
Scope: {\bf local} \\
Type: {\bf optional}\\
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[y] the local portion of result submatrix $y$.\\
Scope: {\bf local} \\
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
Table~\ref{tab:f90spmm}.
\item[info] the local portion of result submatrix $y$.\\
\item[info]
Scope: {\bf local} \\
Type: {\bf required} \\
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:
\begin{description}
\item[$x$] is the global dense submatrix $x_{:, jx:jx+n-1}$
\item[$y$] is the global dense submatrix $y_{:, jy:jy+n-1}$
\item[$x$] is the global dense submatrix $x_{:, :}$
\item[$y$] is the global dense submatrix $y_{:, :}$
\item[$T$] is the global sparse block triangular submatrix $T$
\item[$D$] is the scaling diagonal matrix.
\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,
trans, unit, choice, diag, n, jx, jy, work}
trans, unit, choice, diag, work}
\begin{table}[h]
\begin{center}
@@ -751,11 +747,12 @@ Type: {\bf required}\\
Specified as: a structured data type specified in
\S~\ref{sec:datastruct}.
\item[x] the local portion of global dense matrix
$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$ . \\
$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$ .
\\
Scope: {\bf local} \\
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
Table~\ref{tab:f90spsm}. The rank of $x$ must be the same of $y$.
\item[beta] the scalar $\beta$.\\
@@ -763,11 +760,12 @@ Scope: {\bf global} \\
Type: {\bf required} \\
Specified as: a number of the data type indicated in Table~\ref{tab:f90spsm}.
\item[y] the local portion of global dense matrix
$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$ . \\
$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$ .
\\
Scope: {\bf local} \\
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
Table~\ref{tab:f90spsm}. The rank of $y$ must be the same of $x$.
\item[desc\_a] contains data structures for communications.\\
@@ -794,57 +792,41 @@ Scope: {\bf global} \\
Type: {\bf optional}\\
Default: $unitd = U$\\
Specified as: a character variable.
\item[choice] specify whether a cleanup of the overlapped elements is
required on exit.
\item[choice] specifies the update of overlap elements to be performed
on exit:
\begin{description}
\item[choice = .false.] no cleanup on exit
\item[choice = .true.] cleanup on exit.\\
\item \verb|psb_none_|
\item \verb|psb_sum_|
\item \verb|psb_avg_|
\item \verb|psb_square_root_|
\end{description}
Scope: {\bf global} \\
Type: {\bf optional}\\
Default: $choice = .true.$\\
Specified as: a logical variable.
Default: \verb|psb_avg_|\\
Specified as: an integer variable.
\item[diag] the diagonal scaling matrix.\\
Scope: {\bf local} \\
Type: {\bf optional}\\
Default: $diag(1) = 1 (no scaling)$\\
Specified as: a rank one array containing numbers of the type
indicated in Table~\ref{tab:f90spsm}.
\item[n] number of columns in dense submatrices $x$ and $y$. \\
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. \\
\item[work] a work array. \\
Scope: {\bf local} \\
Type: {\bf optional}\\
Specified as: a rank one array of the same type of $x$ with the
POINTER attribute.
TARGET attribute.
\item[\bf On Return]
\item[y] the local portion of global dense matrix
$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$ . \\
$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$ .
\\
Scope: {\bf local} \\
Type: {\bf required} \\
Specified as: a pointer to array of rank one or two
containing numbers of type specified in
Table~\ref{tab:f90spsm}.
\item[info] the local portion of result submatrix $y$.\\
\item[info]
Scope: {\bf local} \\
Type: {\bf required} \\
An integer value that contains an error code.
docs/pdf/toolsrout.tex
+430 -402
View File
@@ -1,248 +1,5 @@
\section{Data management and initialization routines}
\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 %%
%
\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}
\syntax{call psb\_gelp}{trans, iperm, x, 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[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}
%
%% 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}
\item[\bf On Entry]
\item[nz] the number of elements to be inserted.\\
Scope:{\bf local}.\\
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}.\\
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}
\begin{description}
\item[\bf On Return]
\item[a] the matrix into which elements will be inserted.\\
Scope:{\bf local}\\
Type:{\bf required}\\
Specified as: a structured data of type \spdata.
\item[info] Error code.\\
Scope: {\bf local} \\
Type: {\bf required}\\
\end{description}
%
@@ -253,8 +10,11 @@ Type: {\bf required}\\
\syntax{call psb\_cdall}{m, n, parts, icontxt, desc\_a, info}
\syntax*{call psb\_cdall}{m, v, icontxt, desc\_a, info, flag}
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}
\item[\bf On Entry]
\item[\bf First Form: On Entry ]
\item[m] the number of rows of the problem.\\
Scope:{\bf global}.\\
Type:{\bf required}.\\
@@ -262,16 +22,36 @@ 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.
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 as described in ???
Specified as: a subroutine.
\item[icontxt] the communication context.\\
Scope:{\bf global}.\\
Type:{\bf required}.\\
Specified as: an integer value.
\end{description}
\begin{description}
\item[\bf Second Form: On Entry ]
\item[m] the size of the index space.\\
Scope:{\bf global}.\\
Type:{\bf required}.\\
Specified as: an integer value $m>0$.
\item[v] Data allocation: each index $i\in \{1\dots m\}$ is allocated
to process $v(i)$.
Scope:{\bf global}.\\
Type:{\bf required}.\\
Specified as: an integer array of size $m$.
\item[icontxt] the communication context.\\
Scope:{\bf global}.\\
Type:{\bf required}.\\
Specified as: an integer value.
\item[flag] Specifies whether entries in $v$ are zero- or one-based.
Scope:{\bf global}.\\
Type:{\bf optional}.\\
Specified as: an integer value $0,1$, default $0$.
\end{description}
\begin{description}
\item[\bf On Return]
@@ -286,6 +66,51 @@ Specified as: an integer variable.\\
\end{description}
%
%% psb_cdins %%
%
\subroutine{psb\_cdins}{Communication descriptor insert routine}
\syntax{call psb\_cdins}{nz, ia, ja, desc\_a, info}
\begin{description}
\item[\bf On Entry]
\item[nz] the number of points being inserted.\\
Scope: {\bf local}.\\
Type: {\bf required}.\\
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}
\begin{description}
\item[\bf On Return]
\item[desc\_a] the communication descriptor to be freed.\\
Scope:{\bf local}.\\
Type:{\bf required}.\\
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_cdasb %%
%
@@ -307,7 +132,7 @@ Specified as: a structured data of type \descdata.
Scope: {\bf local} \\
Type: {\bf required}\\
Specified as: an integer variable.
\item[arg]
%\item[arg]
\end{description}
@@ -365,81 +190,65 @@ Specified as: an integer variable.
\end{description}
%
%% psb_cdins %%
%
\subroutine{psb\_cdins}{Comunnication descriptor insert routine}
%% %
%% %% psb_cdren %%
%% %
%% \subroutine{psb\_cdren}{Applies a renumeration to a communication descriptor}
\syntax{call psb\_cdins}{nz, ia, ja, desc\_a, info, is, js}
%% \syntax{call psb\_cdren}{trans, iperm, desc\_a, info}
\begin{description}
\item[\bf On Entry]
\item[nz] the number of points being inserted.\\
Scope: {\bf local}.\\
Type: {\bf required}.\\
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}
%% \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}
\begin{description}
\item[\bf On Return]
\item[desc\_a] the communication descriptor to be freed.\\
Scope:{\bf local}.\\
Type:{\bf required}.\\
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_descprt %%
%
\subroutine{psb\_cdren}{Applies a renumeration to a communication descriptor}
%% \subroutine{psb\_cdprt}{Prints a descriptor}
\syntax{call psb\_cdren}{trans, iperm, desc\_a, info}
%% \syntax{call psb\_cdprt}{iout, desc\_a, glob, short}
\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 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[info] Error code.
Scope: {\bf local} \\
Type: {\bf required}\\
Specified as: an integer variable.
\end{description}
%% \begin{description}
%% \item[\bf On Return]
%% \item[glob] ??????
%% \item[short] ??????
%% \end{description}
@@ -456,10 +265,13 @@ Specified as: an integer variable.
Scope:{\bf local}.\\
Type:{\bf required}.\\
Specified as: a structured data of type \descdata.
\item[nnz] the number of nonzeroes in the matrix.\\
\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.
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}
\begin{description}
@@ -476,12 +288,67 @@ Specified as: an integer variable.
%
%% 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}
\begin{description}
\item[\bf On Entry]
\item[nz] the number of elements to be inserted.\\
Scope:{\bf local}.\\
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}.\\
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}
\begin{description}
\item[\bf On Return]
\item[a] the matrix into which elements will be inserted.\\
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 variable of type \descdata.\\
\item[info] Error code.\\
Scope: {\bf local} \\
Type: {\bf required}\\
\end{description}
%
%% psb_spasb %%
%
\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}
\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.\\
Scope: {\bf global}.\\
Type: {\bf optional}.\\
Specified as: an array of characters. If not specified 'CSR' will be assumed.
\item[up] ???.\\
Specified as: an array of characters. Defalt: 'CSR'.
\item[upd] Provide for updates to the matrix coefficients.\\
Scope: {\bf global}.\\
Type: {\bf optional}.\\
Specified as: .
\item[dup] ???.\\
Specified as: integer, possible values: \verb|psb_upd_srch_|, \verb|psb_upd_perm_|
\item[dupl] How to handle duplicate coefficients.\\
Scope: {\bf global}.\\
Type: {\bf optional}.\\
Specified as:
Specified as: integer, possible values: \verb|psb_dupl_ovwrt_|,
\verb|psb_dupl_add_|, \verb|psb_dupl_err_|.
\end{description}
\begin{description}
@@ -517,36 +385,36 @@ Specified as: an integer variable.
%
%% psb_spcnv %%
%
\subroutine{psb\_spcnv}{Converts a sparse matrix storage format}
%% %
%% %% psb_spcnv %%
%% %
%% \subroutine{psb\_spcnv}{Converts a sparse matrix storage format}
\syntax{call psb\_spcnv}{a, b, desc\_a, info}
%% \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 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}
%% \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}
@@ -579,62 +447,6 @@ Specified as: an integer variable.
%
%% psb_ins %%
%
\subroutine{psb\_geins}{Dense matrix insertion routine}
\syntax{call psb\_geins}{m, n, x, ix, jx, blck, desc\_a, info, iblck, jblck}
\begin{description}
\item[\bf On Entry]
\item[m] rows number of submatrix belonging to blck to be inserted..\\
Scope:{\bf local}.\\
Type:{\bf required}.\\
Specified as: an integer value.
\item[n] columns number of submatrix belonging to blck to be inserted.\\
Scope:{\bf local}.\\
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}.\\
Type:{\bf required}.\\
Specified as: an integer value.
\item[blck] the dense submatrix to be inserted.\\
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 structured data of type \descdata.
\item[iblck] first row of submatrix belonging to blck to be inserted.\\
Scope:{\bf local}.\\
Type:{\bf required}.\\
Specified as: an integer value.
\item[jblck] first column of submatrix belonging to blck to be inserted.\\
Scope:{\bf local}.\\
Type:{\bf required}.\\
Specified as: an integer value.
\end{description}
\begin{description}
\item[\bf On Return]
\item[x] the output dense matrix.\\
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: an integer variable.
\end{description}
%
%% psb_sprn %%
@@ -677,7 +489,223 @@ Specified as: an integer variable.
%% \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}
%
%% psb_ins %%
%
\subroutine{psb\_geins}{Dense matrix insertion routine}
\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}
\item[\bf On Entry]
\item[m] rows number of submatrix belonging to blck to be inserted..\\
Scope:{\bf local}.\\
Type:{\bf required}.\\
Specified as: an integer value.
\item[n] columns number of submatrix belonging to blck to be inserted
(only when $x$ is of rank 2).\\
Scope:{\bf local}.\\
Type:{\bf required}.\\
Specified as: an integer value.
\item[blck] the dense submatrix to be inserted.\\
Scope:{\bf local}.\\
Type:{\bf required}.\\
Specified as: a one or two dimensional array.
\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 (only when $x$ is of rank 2).\\
Scope:{\bf local}.\\
Type:{\bf required}.\\
Specified as: an integer value.
\item[desc\_a] the communication descriptor.\\
Scope:{\bf local}.\\
Type:{\bf required}.\\
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}
\begin{description}
\item[\bf On Return]
\item[x] the output dense matrix.\\
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: an integer variable.
\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_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 rank one or two array with the POINTER
attribute, of type real, complex or integer.\\
\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}
\syntax{call psb\_gelp}{trans, iperm, x, 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[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}
%
docs/userguide.pdf
+16960 -16267
View File
File diff suppressed because one or more lines are too long
src/comm/psb_dovrl.f90
+18 -30
View File
@@ -40,10 +40,9 @@
! jx - integer(optional). The starting column of the global matrix.
! ik - integer(optional). The number of columns to gather.
! work - real(optional). A working area.
! choice - logical(optional). ???.
! update_type - integer(optional). ???.
! update - 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_const_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
integer, intent(out) :: info
real(kind(1.d0)), optional, target :: work(:)
logical, intent(in), optional :: choice
integer, intent(in), optional :: update_type,jx,ik
integer, intent(in), optional :: update,jx,ik
! locals
integer :: int_err(5), icontxt, nprow, npcol, myrow, mycol,&
& err_act, m, n, iix, jjx, temp(2), ix, ijx, nrow, ncol, k, maxk, iupdate,&
& imode, err, liwork, i
real(kind(1.d0)),pointer :: iwork(:), xp(:,:)
logical :: ichoice
logical :: do_update
character(len=20) :: name, ch_err
name='psb_dovrlm'
@@ -111,17 +109,13 @@ subroutine psb_dovrlm(x,desc_a,info,jx,ik,work,choice,update_type)
k = maxk
end if
if (present(choice)) then
ichoice = choice
if (present(update)) then
iupdate = update
else
ichoice = .true.
endif
if (present(update_type)) then
iupdate = update_type
else
iupdate = psb_none_
iupdate = psb_avg_
endif
do_update = (iupdate /= psb_none_)
imode = IOR(psb_swap_send_,psb_swap_recv_)
! check vector correctness
@@ -166,7 +160,7 @@ subroutine psb_dovrlm(x,desc_a,info,jx,ik,work,choice,update_type)
end if
! exchange overlap elements
if(ichoice) then
if(do_update) then
xp => x(iix:size(x,1),jjx:jjx+k-1)
call psi_swapdata(imode,k,1.d0,xp,&
& 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.
! info - integer. Eventually returns an error code.
! work - real(optional). A working area.
! choice - logical(optional). ???.
! update_type - integer(optional). ???.
! update - 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 psi_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
integer, intent(out) :: info
real(kind(1.d0)), optional, target :: work(:)
logical, intent(in), optional :: choice
integer, intent(in), optional :: update_type
integer, intent(in), optional :: update
! locals
integer :: int_err(5), icontxt, nprow, npcol, myrow, mycol,&
& err_act, m, n, iix, jjx, temp(2), ix, ijx, nrow, ncol, k, maxk, iupdate,&
& imode, err, liwork, i
real(kind(1.d0)),pointer :: iwork(:)
logical :: ichoice
logical :: do_update
character(len=20) :: name, ch_err
name='psb_dovrlv'
@@ -320,17 +312,13 @@ subroutine psb_dovrlv(x,desc_a,info,work,choice,update_type)
k = 1
if (present(choice)) then
ichoice = choice
if (present(update)) then
iupdate = update
else
ichoice = .true.
endif
if (present(update_type)) then
iupdate = update_type
else
iupdate = psb_none_
iupdate = psb_avg_
endif
do_update = (iupdate /= psb_none_)
imode = IOR(psb_swap_send_,psb_swap_recv_)
! check vector correctness
@@ -375,7 +363,7 @@ subroutine psb_dovrlv(x,desc_a,info,work,choice,update_type)
end if
! exchange overlap elements
if(ichoice) then
if(do_update) then
call psi_swapdata(imode,1.d0,x(iix:size(x)),&
& desc_a,iwork,info,data=psb_comm_ovr_)
end if
src/comm/psb_zovrl.f90
+17 -29
View File
@@ -40,10 +40,9 @@
! jx - integer(optional). The starting column of the global matrix.
! ik - integer(optional). The number of columns to gather.
! work - real(optional). A working area.
! choice - logical(optional). ???.
! update_type - integer(optional). ???.
! update - 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_const_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
integer, intent(out) :: info
complex(kind(1.d0)), optional, target :: work(:)
logical, intent(in), optional :: choice
integer, intent(in), optional :: update_type,jx,ik
integer, intent(in), optional :: update,jx,ik
! locals
integer :: int_err(5), icontxt, nprow, npcol, myrow, mycol,&
& err_act, m, n, iix, jjx, temp(2), ix, ijx, nrow, ncol, k, maxk, iupdate,&
& imode, err, liwork, i
complex(kind(1.d0)),pointer :: iwork(:), xp(:,:)
logical :: ichoice
logical :: do_update
character(len=20) :: name, ch_err
name='psb_zovrlm'
@@ -111,17 +109,13 @@ subroutine psb_zovrlm(x,desc_a,info,jx,ik,work,choice,update_type)
k = maxk
end if
if (present(choice)) then
ichoice = choice
if (present(update)) then
iupdate = update
else
ichoice = .true.
endif
if (present(update_type)) then
iupdate = update_type
else
iupdate = psb_none_
iupdate = psb_avg_
endif
do_update = (iupdate /= psb_none_)
imode = IOR(psb_swap_send_,psb_swap_recv_)
! check vector correctness
@@ -166,7 +160,7 @@ subroutine psb_zovrlm(x,desc_a,info,jx,ik,work,choice,update_type)
end if
! exchange overlap elements
if(ichoice) then
if(do_update) then
xp => x(iix:size(x,1),jjx:jjx+k-1)
call psi_swapdata(imode,k,zone,xp,&
& 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.
! info - integer. Eventually returns an error code.
! work - real(optional). A working area.
! choice - logical(optional). ???.
! update_type - integer(optional). ???.
! update - 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 psi_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
integer, intent(out) :: info
complex(kind(1.d0)), optional, target :: work(:)
logical, intent(in), optional :: choice
integer, intent(in), optional :: update_type
integer, intent(in), optional :: update
! locals
integer :: int_err(5), icontxt, nprow, npcol, myrow, mycol,&
& err_act, m, n, iix, jjx, temp(2), ix, ijx, nrow, ncol, k, maxk, iupdate,&
& imode, err, liwork, i
complex(kind(1.d0)),pointer :: iwork(:)
logical :: ichoice
logical :: do_update
character(len=20) :: name, ch_err
name='psb_zovrlv'
@@ -320,17 +312,13 @@ subroutine psb_zovrlv(x,desc_a,info,work,choice,update_type)
k = 1
if (present(choice)) then
ichoice = choice
else
ichoice = .true.
endif
if (present(update_type)) then
iupdate = update_type
if (present(update)) then
iupdate = update
else
iupdate = psb_none_
endif
do_update = (iupdate /= psb_none_)
imode = IOR(psb_swap_send_,psb_swap_recv_)
! check vector correctness
@@ -376,7 +364,7 @@ subroutine psb_zovrlv(x,desc_a,info,work,choice,update_type)
! exchange overlap elements
if(ichoice) then
if(do_update) then
call psi_swapdata(imode,zone,x(iix:size(x)),&
& desc_a,iwork,info,data=psb_comm_ovr_)
end if
src/methd/psb_dbicg.f90
+19 -19
View File
@@ -102,7 +102,7 @@ subroutine psb_dbicg(a,prec,b,x,eps,desc_a,info,&
& r(:), p(:), zt(:), pt(:), z(:), rt(:),qt(:)
integer, pointer :: iperm(:), ipnull(:), ipsave(:), int_err(:)
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
character ::diagl, diagu
logical, parameter :: debug = .false.
@@ -159,7 +159,7 @@ subroutine psb_dbicg(a,prec,b,x,eps,desc_a,info,&
naux=4*n_col
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)
if(info.ne.0) then
info=4011
@@ -186,9 +186,9 @@ subroutine psb_dbicg(a,prec,b,x,eps,desc_a,info,&
endif
if (present(itrace)) then
itrac = itrace
itrace_ = itrace
else
itrac = -1
itrace_ = 0
end if
diagl = 'u'
@@ -241,15 +241,8 @@ subroutine psb_dbicg(a,prec,b,x,eps,desc_a,info,&
if (istop_ == 1) then
xni = psb_geamax(x,desc_a,info)
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
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
if(info.ne.0) then
@@ -261,6 +254,11 @@ subroutine psb_dbicg(a,prec,b,x,eps,desc_a,info,&
if (rerr<=eps) then
exit restart
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
it = it + 1
@@ -315,23 +313,25 @@ subroutine psb_dbicg(a,prec,b,x,eps,desc_a,info,&
if (istop_ == 1) then
xni = psb_geamax(x,desc_a,info)
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
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
if (rerr<=eps) then
exit restart
end if
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 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(iter)) iter = itx
if (rerr>eps) then
src/methd/psb_dcg.f90
+13 -12
View File
@@ -102,7 +102,7 @@ Subroutine psb_dcg(a,prec,b,x,eps,desc_a,info,&
real(kind(1.d0)) ::rerr
real(kind(1.d0)) ::alpha, beta, rho, rho_old, rni, xni, bni, ani,bn2,&
& 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)
character ::diagl, diagu
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
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)
if (info.ne.0) then
info=4011
@@ -170,9 +170,9 @@ Subroutine psb_dcg(a,prec,b,x,eps,desc_a,info,&
endif
if (present(itrace)) then
itrac = itrace
itrace_ = itrace
else
itrac = -1
itrace_ = 0
end if
itx=0
@@ -243,23 +243,24 @@ Subroutine psb_dcg(a,prec,b,x,eps,desc_a,info,&
rni = psb_geamax(r,desc_a,info)
xni = psb_geamax(x,desc_a,info)
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
rni = psb_genrm2(r,desc_a,info)
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
if (rerr<=eps) 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 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(iter)) iter = itx
src/methd/psb_dcgs.f90
+23 -23
View File
@@ -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(:)
Integer, Pointer :: iperm(:), ipnull(:), ipsave(:)
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
Character ::diagl, diagu
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
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)
if (info.ne.0) Then
info=4011
@@ -181,9 +181,9 @@ Subroutine psb_dcgs(a,prec,b,x,eps,desc_a,info,&
Endif
If (Present(itrace)) Then
itrac = itrace
itrace_ = itrace
Else
itrac = -1
itrace_ = 0
End If
! 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)
xni = psb_geamax(x,desc_a,info)
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
rni = psb_genrm2(r,desc_a,info)
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
if(info/=0)then
info=4011
call psb_errpush(info,name)
goto 9999
end if
end if
If (rerr<=eps) Then
Exit restart
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
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)
xni = psb_geamax(x,desc_a,info)
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
rni = psb_genrm2(r,desc_a,info)
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
If (rerr<=eps) Then
Exit restart
End If
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 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(iter)) iter = itx
If (rerr>eps) Then
src/methd/psb_dcgstab.f90
+24 -25
View File
@@ -100,7 +100,7 @@ Subroutine psb_dcgstab(a,prec,b,x,eps,desc_a,info,&
& r(:), p(:), v(:), s(:), t(:), z(:), f(:)
Integer, Pointer :: iperm(:), ipnull(:), ipsave(:)
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
Character ::diagl, diagu
Logical, Parameter :: debug = .false.
@@ -158,7 +158,7 @@ Subroutine psb_dcgstab(a,prec,b,x,eps,desc_a,info,&
naux=6*n_col
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) then
info=4011
@@ -182,9 +182,9 @@ Subroutine psb_dcgstab(a,prec,b,x,eps,desc_a,info,&
Endif
If (Present(itrace)) Then
itrac = itrace
itrace_ = itrace
Else
itrac = -1
itrace_ = 0
End If
diagl = 'U'
@@ -245,8 +245,8 @@ Subroutine psb_dcgstab(a,prec,b,x,eps,desc_a,info,&
rn0 = rni
End If
If (rn0 == 0.d0 ) Then
If (itrac /= -1) Then
If (myrow == 0) Write(itrac,*) 'BiCGSTAB: ',itx,rn0
If (itrace_ > 0 ) Then
If (myrow == 0) Write(*,*) 'BiCGSTAB: ',itx,rn0
Endif
Exit restart
End If
@@ -254,15 +254,8 @@ Subroutine psb_dcgstab(a,prec,b,x,eps,desc_a,info,&
If (istop_ == 1) Then
xni = psb_geamax(x,desc_a,info)
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
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
if (info /= 0) Then
info=4011
@@ -270,10 +263,14 @@ Subroutine psb_dcgstab(a,prec,b,x,eps,desc_a,info,&
goto 9999
End If
If (rerr<=eps) Then
Exit restart
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
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)
xni = psb_geamax(x,desc_a,info)
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
rni = psb_genrm2(r,desc_a,info)
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
If (rerr<=eps) Then
Exit restart
End If
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 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(iter)) iter = itx
If (rerr>eps) Then
Write(0,*) 'BI-CGSTAB FAILED TO CONVERGE TO ',EPS,&
& ' IN ',ITX,' ITERATIONS '
Write(0,*) 'BI-CGSTAB failed to converge to ',EPS,&
& ' in ',ITX,' iterations. '
End If
Deallocate(aux)
src/methd/psb_dcgstabl.f90
+19 -25
View File
@@ -109,7 +109,7 @@ Subroutine psb_dcgstabl(a,prec,b,x,eps,desc_a,info,&
&pv1(:), pv2(:), pm1(:,:), pm2(:,:)
Integer, Pointer :: iperm(:), ipnull(:), ipsave(:)
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
Character ::diagl, diagu
Logical, Parameter :: exchange=.True., noexchange=.False.
@@ -161,9 +161,9 @@ Subroutine psb_dcgstabl(a,prec,b,x,eps,desc_a,info,&
Endif
If (Present(itrace)) Then
itrac = itrace
itrace_ = itrace
Else
itrac = -1
itrace_ = 0
End If
If (Present(irst)) Then
@@ -183,9 +183,9 @@ Subroutine psb_dcgstabl(a,prec,b,x,eps,desc_a,info,&
call psb_errpush(info,name)
goto 9999
End If
Call psb_geall(mglob,10,wwrk,desc_a,info)
Call psb_geall(mglob,nl+1,uh,desc_a,info,js=0)
Call psb_geall(mglob,nl+1,rh,desc_a,info,js=0)
Call psb_geall(wwrk,desc_a,info,n=10)
Call psb_geall(uh,desc_a,info,n=nl+1)
Call psb_geall(rh,desc_a,info,n=nl+1)
Call psb_geasb(wwrk,desc_a,info)
Call psb_geasb(uh,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)
xni = psb_geamax(x,desc_a,info)
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
rni = psb_genrm2(r,desc_a,info)
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
if (info.ne.0) Then
info=4011
@@ -276,6 +268,10 @@ Subroutine psb_dcgstabl(a,prec,b,x,eps,desc_a,info,&
If (rerr<=eps) Then
Exit restart
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
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)
xni = psb_geamax(x,desc_a,info)
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
rni = psb_genrm2(rh(:,0),desc_a,info)
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
If (rerr<=eps) Then
Exit restart
End If
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 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(iter)) iter = itx
If (rerr>eps) Then
src/methd/psb_dgmresr.f90
+16 -21
View File
@@ -111,7 +111,7 @@ Subroutine psb_dgmresr(a,prec,b,x,eps,desc_a,info,&
&pv1(:), pv2(:), pm1(:,:), rr(:,:)
Integer, Pointer :: iperm(:), ipnull(:), ipsave(:), ierrv(:)
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)
Character ::diagl, diagu
Logical, Parameter :: exchange=.True., noexchange=.False.
@@ -164,9 +164,9 @@ Subroutine psb_dgmresr(a,prec,b,x,eps,desc_a,info,&
Endif
If (Present(itrace)) Then
itrac = itrace
itrace_ = itrace
Else
itrac = -1
itrace_ = 0
End If
If (Present(irst)) Then
@@ -188,8 +188,8 @@ Subroutine psb_dgmresr(a,prec,b,x,eps,desc_a,info,&
goto 9999
End If
Call psb_geall(mglob,nl+1,v,desc_a,info)
Call psb_geall(mglob,w,desc_a,info)
Call psb_geall(v,desc_a,info,n=nl+1)
Call psb_geall(w,desc_a,info)
Call psb_geasb(v,desc_a,info)
Call psb_geasb(w,desc_a,info)
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)
xni = psb_geamax(x,desc_a,info)
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
rni = psb_genrm2(v(:,1),desc_a,info)
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
if (info.ne.0) Then
info=4011
@@ -268,6 +260,10 @@ Subroutine psb_dgmresr(a,prec,b,x,eps,desc_a,info,&
If (rerr<=eps) Then
Exit restart
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
@@ -304,17 +300,9 @@ Subroutine psb_dgmresr(a,prec,b,x,eps,desc_a,info,&
rni = abs(rs(i+1))
xni = psb_geamax(x,desc_a,info)
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
rni = abs(rs(i+1))
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
if (rerr < eps ) then
@@ -325,6 +313,10 @@ Subroutine psb_dgmresr(a,prec,b,x,eps,desc_a,info,&
end do
exit restart
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
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 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(iter)) iter = itx
src/methd/psb_zcgs.f90
+17 -21
View File
@@ -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(:)
Integer, Pointer :: iperm(:), ipnull(:), ipsave(:)
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
Character ::diagl, diagu
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
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)
if (info.ne.0) Then
info=4011
@@ -181,9 +181,9 @@ Subroutine psb_zcgs(a,prec,b,x,eps,desc_a,info,&
Endif
If (Present(itrace)) Then
itrac = itrace
itrace_ = itrace
Else
itrac = -1
itrace_ = 0
End If
! 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)
xni = psb_geamax(x,desc_a,info)
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
rni = psb_genrm2(r,desc_a,info)
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
if(info/=0)then
info=4011
@@ -247,6 +240,10 @@ Subroutine psb_zcgs(a,prec,b,x,eps,desc_a,info,&
If (rerr<=eps) Then
Exit restart
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
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)
xni = psb_geamax(x,desc_a,info)
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
rni = psb_genrm2(r,desc_a,info)
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
If (rerr<=eps) Then
Exit restart
End If
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 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(iter)) iter = itx
src/methd/psb_zcgstab.f90
+19 -26
View File
@@ -100,7 +100,7 @@ Subroutine psb_zcgstab(a,prec,b,x,eps,desc_a,info,&
& r(:), p(:), v(:), s(:), t(:), z(:), f(:)
Integer, Pointer :: iperm(:), ipnull(:), ipsave(:)
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
Character ::diagl, diagu
Logical, Parameter :: debug = .false.
@@ -158,7 +158,7 @@ Subroutine psb_zcgstab(a,prec,b,x,eps,desc_a,info,&
naux=6*n_col
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)
if (info /= 0) then
info=4011
@@ -182,9 +182,9 @@ Subroutine psb_zcgstab(a,prec,b,x,eps,desc_a,info,&
Endif
If (Present(itrace)) Then
itrac = itrace
itrace_ = itrace
Else
itrac = -1
itrace_ = 0
End If
diagl = 'U'
@@ -245,24 +245,14 @@ Subroutine psb_zcgstab(a,prec,b,x,eps,desc_a,info,&
rn0 = rni
End If
If (rn0 == 0.d0 ) Then
If (itrac /= -1) Then
If (myrow == 0) Write(itrac,*) 'BiCGSTAB: ',itx,rn0
Endif
Exit restart
End If
If (istop_ == 1) Then
xni = psb_geamax(x,desc_a,info)
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
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
if (info /= 0) Then
info=4011
@@ -270,11 +260,15 @@ Subroutine psb_zcgstab(a,prec,b,x,eps,desc_a,info,&
goto 9999
End If
If (rerr<=eps) Then
Exit restart
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
it = it + 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)
xni = psb_geamax(x,desc_a,info)
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
rni = psb_genrm2(r,desc_a,info)
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
If (rerr<=eps) Then
@@ -375,14 +360,22 @@ Subroutine psb_zcgstab(a,prec,b,x,eps,desc_a,info,&
End If
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 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(iter)) iter = itx
If (rerr>eps) Then
Write(0,*) 'BI-CGSTAB FAILED TO CONVERGE TO ',EPS,&
& ' IN ',ITX,' ITERATIONS '
Write(0,*) 'BI-cgstab failed to converge to ',eps,&
& ' in ',itx,' iterations. '
End If
Deallocate(aux)
src/prec/psb_dbaseprc_aply.f90
+2 -2
View File
@@ -234,11 +234,11 @@ subroutine psb_dbaseprc_aply(prec,x,beta,y,desc_data,trans,work,info)
case(psb_none_)
! 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_)
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
info=4010
ch_err='psb_ovrl'
src/prec/psb_dslu_bld.f90
+1 -1
View File
@@ -89,7 +89,7 @@ subroutine psb_dslu_bld(a,desc_a,p,info)
call blacs_barrier(icontxt,'All')
endif
call psb_dcsdp(a,atmp,info)
call psb_csdp(a,atmp,info)
if(info /= 0) then
info=4010
ch_err='psb_dcsdp'
src/prec/psb_zbaseprc_aply.f90
+2 -2
View File
@@ -234,11 +234,11 @@ subroutine psb_zbaseprc_aply(prec,x,beta,y,desc_data,trans,work,info)
case(psb_none_)
! 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_)
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
info=4010
ch_err='psb_ovrl'
src/prec/psb_zbldaggrmat.f90
+2 -2
View File
@@ -624,7 +624,7 @@ contains
if (debug) write(0,*) me,'Done NUMBMM 2'
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_)
i=0
!
@@ -643,7 +643,7 @@ contains
am2%infoa(psb_nnz_) = i
call psb_ipcoo2csr(am2,info)
else
call psb_transp(am1,am2)
call psb_transc(am1,am2)
endif
if (debug) write(0,*) me,'starting sphalo/ rwxtd'
src/prec/psb_zslu_bld.f90
+4 -4
View File
@@ -51,7 +51,7 @@ subroutine psb_zslu_bld(a,desc_a,p,info)
character(len=5) :: fmt
character :: upd='F'
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
interface psb_asmatbld
@@ -85,14 +85,14 @@ subroutine psb_zslu_bld(a,desc_a,p,info)
atmp%fida='COO'
if (Debug) then
write(0,*) me, 'SPLUBLD: Calling csdp'
write(0,*) me, 'ZSLUBLD: Calling csdp'
call blacs_barrier(icontxt,'All')
endif
call psb_zcsdp(a,atmp,info)
call psb_csdp(a,atmp,info)
if(info /= 0) then
info=4010
ch_err='psb_zcsdp'
ch_err='psb_csdp'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
src/psblas/psb_dspmm.f90
+12 -12
View File
@@ -188,26 +188,26 @@ subroutine psb_dspmm(alpha,a,x,beta,y,desc_a,info,&
liwork= 2*ncol
if (a%pr(1) /= 0) liwork = liwork + n * ik
if (a%pl(1) /= 0) liwork = liwork + m * ik
if (present(work)) then
if (present(work)) then
if (size(work) >= liwork) then
aliw =.false.
aliw =.false.
else
aliw=.true.
aliw=.true.
endif
else
aliw=.true.
aliw=.true.
end if
if (aliw) then
call psb_realloc(liwork,iwork,info)
if(info.ne.0) then
info=4010
ch_err='psb_realloc'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
call psb_realloc(liwork,iwork,info)
if(info.ne.0) then
info=4010
ch_err='psb_realloc'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
else
iwork => work
iwork => work
endif
iwork(1)=dzero
src/psblas/psb_dspsm.f90
+26 -26
View File
@@ -196,26 +196,26 @@ subroutine psb_dspsm(alpha,a,x,beta,y,desc_a,info,&
liwork= 2*ncol
if (a%pr(1) /= 0) llwork = liwork + m * ik
if (a%pl(1) /= 0) llwork = llwork + m * ik
if (present(work)) then
if (present(work)) then
if (size(work) >= liwork) then
aliw =.false.
aliw =.false.
else
aliw=.true.
aliw=.true.
endif
else
aliw=.true.
aliw=.true.
end if
if (aliw) then
call psb_realloc(liwork,iwork,info)
if(info.ne.0) then
info=4010
ch_err='psb_realloc'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
call psb_realloc(liwork,iwork,info)
if(info.ne.0) then
info=4010
ch_err='psb_realloc'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
else
iwork => work
iwork => work
endif
iwork(1)=0.d0
@@ -490,27 +490,27 @@ subroutine psb_dspsv(alpha,a,x,beta,y,desc_a,info,&
liwork= 2*ncol
if (a%pr(1) /= 0) llwork = liwork + m * ik
if (a%pl(1) /= 0) llwork = llwork + m * ik
if (present(work)) then
if (size(work) >= liwork) then
aliw =.false.
aliw =.false.
else
aliw=.true.
aliw=.true.
endif
else
aliw=.true.
aliw=.true.
end if
if (aliw) then
call psb_realloc(liwork,iwork,info)
if(info.ne.0) then
info=4010
ch_err='psb_realloc'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
call psb_realloc(liwork,iwork,info)
if(info.ne.0) then
info=4010
ch_err='psb_realloc'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
else
iwork => work
iwork => work
endif
iwork(1)=0.d0
@@ -596,7 +596,7 @@ subroutine psb_dspsv(alpha,a,x,beta,y,desc_a,info,&
end select
end if
if (aliw) deallocate(iwork)
if (aliw) deallocate(iwork)
if(.not.present(d)) deallocate(id)
call psb_erractionrestore(err_act)
src/psblas/psb_zspmm.f90
+13 -13
View File
@@ -183,26 +183,26 @@ subroutine psb_zspmm(alpha,a,x,beta,y,desc_a,info,&
liwork= 2*ncol
if (a%pr(1) /= 0) liwork = liwork + n * ik
if (a%pl(1) /= 0) liwork = liwork + m * ik
if (present(work)) then
if (present(work)) then
if (size(work) >= liwork) then
aliw =.false.
aliw =.false.
else
aliw=.true.
aliw=.true.
endif
else
aliw=.true.
aliw=.true.
end if
if (aliw) then
call psb_realloc(liwork,iwork,info)
if(info.ne.0) then
info=4010
ch_err='psb_realloc'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
call psb_realloc(liwork,iwork,info)
if(info.ne.0) then
info=4010
ch_err='psb_realloc'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
else
iwork => work
iwork => work
endif
iwork(1)=zzero
@@ -315,7 +315,7 @@ if (present(work)) then
y(iiy+nrow+1-1:iiy+ncol,1:ik)=zzero
! local Matrix-vector product
call psb_csmm(alpha,a,x(iix:lldx,jjx:jjx+ik-1),&
& beta,y(iiy:lldy,jjy:jjy+ik-1),info,trans=itrans)
src/psblas/psb_zspsm.f90
+86 -86
View File
@@ -199,26 +199,26 @@ subroutine psb_zspsm(alpha,a,x,beta,y,desc_a,info,&
liwork= 2*ncol
if (a%pr(1) /= 0) llwork = liwork + m * ik
if (a%pl(1) /= 0) llwork = llwork + m * ik
if (present(work)) then
if (present(work)) then
if (size(work) >= liwork) then
aliw =.false.
aliw =.false.
else
aliw=.true.
aliw=.true.
endif
else
aliw=.true.
aliw=.true.
end if
if (aliw) then
call psb_realloc(liwork,iwork,info)
if(info.ne.0) then
info=4010
ch_err='psb_realloc'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
call psb_realloc(liwork,iwork,info)
if(info.ne.0) then
info=4010
ch_err='psb_realloc'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
else
iwork => work
iwork => work
endif
iwork(1)=0.d0
@@ -428,14 +428,14 @@ subroutine psb_zspsv(alpha,a,x,beta,y,desc_a,info,&
! check on blacs grid
call blacs_gridinfo(icontxt, nprow, npcol, myrow, mycol)
if (nprow == -1) then
info = 2010
call psb_errpush(info,name)
goto 9999
info = 2010
call psb_errpush(info,name)
goto 9999
else if (npcol /= 1) then
info = 2030
int_err(1) = npcol
call psb_errpush(info,name)
goto 9999
info = 2030
int_err(1) = npcol
call psb_errpush(info,name)
goto 9999
endif
! just this case right now
@@ -469,7 +469,7 @@ subroutine psb_zspsv(alpha,a,x,beta,y,desc_a,info,&
goto 9999
end if
else
itrans = 'N'
itrans = 'N'
endif
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)
if((lldx.lt.ncol).or.(lldy.lt.ncol)) then
info=3010
call psb_errpush(info,name)
goto 9999
info=3010
call psb_errpush(info,name)
goto 9999
end if
iwork => null()
@@ -489,38 +489,38 @@ subroutine psb_zspsv(alpha,a,x,beta,y,desc_a,info,&
liwork= 2*ncol
if (a%pr(1) /= 0) llwork = liwork + m * ik
if (a%pl(1) /= 0) llwork = llwork + m * ik
if (present(work)) then
if (size(work) >= liwork) then
aliw =.false.
aliw =.false.
else
aliw=.true.
aliw=.true.
endif
else
aliw=.true.
aliw=.true.
end if
if (aliw) then
call psb_realloc(liwork,iwork,info)
if(info.ne.0) then
info=4010
ch_err='psb_realloc'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
call psb_realloc(liwork,iwork,info)
if(info.ne.0) then
info=4010
ch_err='psb_realloc'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
else
iwork => work
iwork => work
endif
iwork(1)=0.d0
if(present(d)) then
lld = size(d)
id => d
lld = size(d)
id => d
else
lld=1
allocate(id(1))
id=1.d0
lld=1
allocate(id(1))
id=1.d0
end if
! 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(y),iy,jy,desc_a%matrix_data,info,iiy,jjy)
if(info.ne.0) then
info=4010
ch_err='psb_chkvect/mat'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
info=4010
ch_err='psb_chkvect/mat'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
if(ja.ne.ix) then
! this case is not yet implemented
info = 3030
! this case is not yet implemented
info = 3030
end if
if((iix.ne.1).or.(iiy.ne.1)) then
! this case is not yet implemented
info = 3040
! this case is not yet implemented
info = 3040
end if
if(info.ne.0) then
call psb_errpush(info,name)
goto 9999
call psb_errpush(info,name)
goto 9999
end if
! 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)
if(info.ne.0) then
info = 4010
ch_err='dcssm'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
info = 4010
ch_err='dcssm'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
! update overlap elements
if(lchoice.gt.0) then
call psi_swapdata(ior(psb_swap_send_,psb_swap_recv_),&
& zone,yp,desc_a,iwork,info)
call psi_swapdata(ior(psb_swap_send_,psb_swap_recv_),&
& zone,yp,desc_a,iwork,info)
i=0
! switch on update type
select case (lchoice)
case(psb_square_root_)
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_))/&
& sqrt(real(desc_a%ovrlap_elem(i+psb_n_dom_ovr_)))
i = i+2
end do
case(psb_avg_)
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_))/&
& real(desc_a%ovrlap_elem(i+psb_n_dom_ovr_))
i = i+2
end do
case(psb_sum_)
! do nothing
case default
! wrong value for choice argument
info = 70
int_err=(/10,lchoice,0,0,0/)
call psb_errpush(info,name,i_err=int_err)
goto 9999
end select
i=0
! switch on update type
select case (lchoice)
case(psb_square_root_)
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_))/&
& sqrt(real(desc_a%ovrlap_elem(i+psb_n_dom_ovr_)))
i = i+2
end do
case(psb_avg_)
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_))/&
& real(desc_a%ovrlap_elem(i+psb_n_dom_ovr_))
i = i+2
end do
case(psb_sum_)
! do nothing
case default
! wrong value for choice argument
info = 70
int_err=(/10,lchoice,0,0,0/)
call psb_errpush(info,name,i_err=int_err)
goto 9999
end select
end if
if (aliw) deallocate(iwork)
if (aliw) deallocate(iwork)
if(.not.present(d)) deallocate(id)
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)
if (err_act.eq.act_abort) then
call psb_error(icontxt)
return
call psb_error(icontxt)
return
end if
return
end subroutine psb_zspsv
src/serial/psb_dcsdp.f90
+9 -3
View File
@@ -118,8 +118,7 @@ subroutine psb_dcsdp(a, b,info,ifc,check,trans,unitd,upd,dupl)
if (check_=='R') then
allocate(work(max(size(a%aspk),size(b%aspk))+1000),stat=info)
else
allocate(work(max(size(a%ia1),size(b%ia1),&
& size(a%ia2),size(b%ia2))+max(a%m,b%m)+1000),stat=info)
allocate(work(max(size(a%ia1),size(a%ia2))+max(a%m,b%m)+1000),stat=info)
endif
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)
goto 9999
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%ia2) < ia2_size) .or.&
&(size(b%pl) < b%m) .or.&
&(size(b%pr) < b%k )) then
call psb_sp_reall(b,ia1_size,ia2_size,aspk_size,info)
endif
if (info /= no_err) then
info=4010
ch_err='psb_sp_reall'
src/serial/psb_zcsdp.f90
+15 -6
View File
@@ -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
character :: check_,trans_,unitd_, up
Integer, Parameter :: maxtry=8
logical, parameter :: debug=.false.
logical, parameter :: debug=.true.
character(len=20) :: name, ch_err
interface psb_cest
@@ -114,11 +114,11 @@ subroutine psb_zcsdp(a, b,info,ifc,check,trans,unitd,upd,dupl)
unitd_ = 'U'
endif
if (check_=='R') then
allocate(work(max(size(a%aspk),size(b%aspk))+1000),stat=info)
else
allocate(work(max(size(a%ia1),size(b%ia1),&
& size(a%ia2),size(b%ia2))+max(a%m,b%m)+1000),stat=info)
allocate(work(max(size(a%ia1),size(a%ia2))+max(a%m,b%m)+1000),stat=info)
endif
if (info /= 0) then
@@ -127,7 +127,7 @@ subroutine psb_zcsdp(a, b,info,ifc,check,trans,unitd,upd,dupl)
goto 9999
end if
if (ifc_<1) then
write(0,*) 'dcsdp90 Error: invalid ifc ',ifc_
write(0,*) 'csdp90 Error: invalid ifc ',ifc_
info = -4
call psb_errpush(info,name)
goto 9999
@@ -181,13 +181,15 @@ subroutine psb_zcsdp(a, b,info,ifc,check,trans,unitd,upd,dupl)
b%m=a%m
b%k=a%k
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_col=b%k
call psb_cest(b%fida, n_row,n_col,size_req,&
& 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
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)
goto 9999
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%ia2) < ia2_size) .or.&
&(size(b%pl) < b%m) .or.&
&(size(b%pr) < b%k )) then
call psb_sp_reall(b,ia1_size,ia2_size,aspk_size,info)
endif
if (info /= no_err) then
info=4010
ch_err='psb_sp_reall'
src/serial/psb_ztransc.f90
+92
View File
@@ -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
src/serial/psb_ztransp.f90
+1 -1
View File
@@ -45,7 +45,7 @@ subroutine psb_ztransp(a,b,c,fmt)
character(len=5) :: fmt_
integer ::c_, info, nz
integer, pointer :: itmp(:)=>null()
integer, pointer :: itmp(:)
if (present(c)) then
c_=c
else
src/tools/psb_dallc.f90
+28 -91
View File
@@ -35,13 +35,11 @@
! Allocates dense matrix for PSBLAS routines
!
! Parameters:
! m - number of rows.
! n - number of columns.
! x - the matrix to be allocated.
! desc_a - the communication descriptor.
! info - eventually returns an error code
! js - (optional) the starting column
subroutine psb_dalloc(m, n, x, desc_a, info, js)
! info - possibly returns an error code
! n - optional number of columns.
subroutine psb_dalloc(x, desc_a, info, n)
!....allocate dense matrix for psblas routines.....
use psb_descriptor_type
use psb_const_mod
@@ -50,18 +48,17 @@ subroutine psb_dalloc(m, n, x, desc_a, info, js)
implicit none
!....parameters...
integer, intent(in) :: m,n
real(kind(1.d0)), pointer :: x(:,:)
type(psb_desc_type), intent(in) :: desc_a
integer :: info
integer, optional, intent(in) :: js
integer, optional, intent(in) :: n
!locals
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)
real(kind(1.d0)) :: real_err(5)
integer, allocatable:: prc_v(:)
character(len=20) :: name, ch_err
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_)
!... check m and n parameters....
if (m.lt.0) 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
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
if (present(js)) then
j=js
if (present(n)) then
n_ = n
else
j=1
n_ = 1
endif
!global check on m and n parameters
!global check on n parameters
if (myrow.eq.psb_root_) then
exch(1)=m
exch(2)=n
exch(3)=j
call igebs2d(icontxt,psb_all_,psb_topdef_, ithree,ione, exch, ithree)
exch(1)=n_
call igebs2d(icontxt,psb_all_,psb_topdef_, ione,ione, exch, ione)
else
call igebr2d(icontxt,psb_all_,psb_topdef_, ithree,ione, exch, ithree, psb_root_, 0)
if (exch(1).ne.m) then
call igebr2d(icontxt,psb_all_,psb_topdef_, ione,ione, exch, ione, psb_root_, 0)
if (exch(1).ne.n_) then
info=550
int_err(1)=1
call psb_errpush(info,name,int_err)
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
!....allocate x .....
if (psb_is_asb_dec(dectype).or.psb_is_upd_dec(dectype)) then
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
info=4010
ch_err='allocate'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
endif
do jj=j,j+n-1
do j=1,n_
do i=1,n_col
x(i,j) = 0.0d0
end do
end do
else if (psb_is_bld_dec(dectype)) then
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
info=4010
ch_err='allocate'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
endif
do jj=j,j+n-1
do j = 1, n_
do i=1,n_row
x(i,j) = 0.0d0
end do
@@ -224,11 +189,10 @@ end subroutine psb_dalloc
! Allocates dense matrix for PSBLAS routines
!
! Parameters:
! m - number of rows.
! x - the matrix to be allocated.
! desc_a - the communication descriptor.
! info - eventually returns an error code
subroutine psb_dallocv(m, x, desc_a,info)
! info - possibly returns an error code
subroutine psb_dallocv(x, desc_a,info,n)
!....allocate sparse matrix structure for psblas routines.....
use psb_descriptor_type
use psb_const_mod
@@ -238,14 +202,14 @@ subroutine psb_dallocv(m, x, desc_a,info)
implicit none
!....parameters...
integer, intent(in) :: m
real(kind(1.d0)), pointer :: x(:)
type(psb_desc_type), intent(in):: desc_a
integer :: info
real(kind(1.d0)), pointer :: x(:)
type(psb_desc_type), intent(in) :: desc_a
integer :: info
integer, optional, intent(in) :: n
!locals
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
real(kind(1.d0)) :: real_err(5)
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: is_ok? dectype',psb_is_ok_dec(dectype)
!... check m and n parameters....
if (m.lt.0) 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
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 = 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
! As this is a rank-1 array, optional parameter N is actually ignored.
!....allocate x .....
if (psb_is_asb_dec(dectype).or.psb_is_upd_dec(dectype)) then
src/tools/psb_dins.f90
+3 -3
View File
@@ -44,7 +44,7 @@
! info - integer. Eventually returns an error code
! 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.
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)
!....insert dense submatrix to dense matrix .....
use psb_descriptor_type
@@ -270,7 +270,7 @@ end subroutine psb_dins
! desc_a - type(<psb_desc_type>). The communication descriptor.
! info - integer. Eventually returns an error code
! 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)
!....insert dense submatrix to dense matrix .....
use psb_descriptor_type
@@ -485,7 +485,7 @@ end subroutine psb_dinsvm
! info - integer. Eventually returns an error code
! iblck - integer(optional). First row of submatrix belonging to blck to be inserted.
! 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)
!....insert dense submatrix to dense matrix .....
use psb_descriptor_type
src/tools/psb_ialloc.f90
+88 -146
View File
@@ -34,13 +34,11 @@
! Allocates dense integer matrix for PSBLAS routines
!
! Parameters:
! m - integer. The number of rows.
! n - integer. The number of columns.
! x - integer,dimension(:,:). The matrix to be allocated.
! desc_a - type(<psb_desc_type>). The communication descriptor.
! info - integer. Eventually returns an error code
! js - integer(optional). The starting column
subroutine psb_ialloc(m, n, x, desc_a, info,js)
! x - the matrix to be allocated.
! desc_a - the communication descriptor.
! info - possibly returns an error code
! n - optional number of columns.
subroutine psb_ialloc(x, desc_a, info, n)
!....allocate dense matrix for psblas routines.....
use psb_descriptor_type
use psb_const_mod
@@ -48,19 +46,18 @@ subroutine psb_ialloc(m, n, x, desc_a, info,js)
implicit none
!....parameters...
integer, intent(in) :: m,n
integer, pointer :: x(:,:)
type(psb_desc_type), intent(inout) :: desc_a
integer, intent(out) :: info
integer, optional, intent(in) :: js
integer, pointer :: x(:,:)
type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info
integer, optional, intent(in) :: n
!locals
integer :: j,nprow,npcol,myrow,mypcol,&
& n_col,n_row, err_act
integer :: icontxt,dectype
integer :: nprow,npcol,myrow,mypcol,err,n_col,n_row,i,j,jj,err_act
integer :: icontxt,dectype,n_
integer :: int_err(5),temp(1),exch(3)
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
info=0
@@ -84,97 +81,70 @@ subroutine psb_ialloc(m, n, x, desc_a, info,js)
dectype=desc_a%matrix_data(psb_dec_type_)
!... check m and n parameters....
if (m.lt.0) 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)
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
if (.not.psb_is_ok_dec(dectype)) then
info = 3110
call psb_errpush(info,name)
goto 9999
endif
if (present(js)) then
j=js
if (present(n)) then
n_ = n
else
j=1
n_ = 1
endif
!global check on m and n parameters
!global check on n parameters
if (myrow.eq.psb_root_) then
exch(1)=m
exch(2)=n
exch(3)=j
call igebs2d(icontxt,psb_all_,psb_topdef_, ithree,ione, exch, ithree)
exch(1)=n_
call igebs2d(icontxt,psb_all_,psb_topdef_, ione,ione, exch, ione)
else
call igebr2d(icontxt,psb_all_,psb_topdef_, ithree,ione, exch, ithree, psb_root_, 0)
if (exch(1).ne.m) then
info=550
int_err(1)=1
call psb_errpush(info,name,int_err)
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
call igebr2d(icontxt,psb_all_,psb_topdef_, ione,ione, exch, ione, psb_root_, 0)
if (exch(1).ne.n_) then
info=550
int_err(1)=1
call psb_errpush(info,name,int_err)
goto 9999
endif
endif
!....allocate x .....
if (psb_is_asb_dec(dectype).or.psb_is_upd_dec(dectype)) then
n_col = max(1,desc_a%matrix_data(psb_n_col_))
allocate(x(n_col,j:j+n-1),stat=info)
if (info.ne.0) then
info=2025
int_err(1)=n_col
call psb_errpush(info,name,int_err)
goto 9999
endif
n_col = max(1,desc_a%matrix_data(psb_n_col_))
allocate(x(n_col,n_),stat=info)
if (info.ne.0) then
info=4010
ch_err='allocate'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
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
n_row = max(1,desc_a%matrix_data(psb_n_row_))
allocate(x(n_row,j:j+n-1),stat=info)
if (info.ne.0) then
info=2025
int_err(1)=n_row
call psb_errpush(info,name,int_err)
goto 9999
endif
n_row = max(1,desc_a%matrix_data(psb_n_row_))
allocate(x(n_row,n_),stat=info)
if (info.ne.0) then
info=4010
ch_err='allocate'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
endif
do j = 1, n_
do i=1,n_row
x(i,j) = 0
end do
end do
endif
x = 0
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_ret) then
return
else
call psb_error(icontxt)
if (err_act.eq.act_abort) then
call psb_error(icontxt)
return
end if
return
@@ -220,26 +190,28 @@ end subroutine psb_ialloc
! x - integer,dimension(:). The matrix to be allocated.
! desc_a - type(<psb_desc_type>). The communication descriptor.
! 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.....
use psb_descriptor_type
use psb_const_mod
use psb_realloc_mod
use psb_error_mod
implicit none
!....parameters...
integer, intent(in) :: m
integer, pointer :: x(:)
type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info
integer, pointer :: x(:)
type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info
integer, optional, intent(in) :: n
!locals
integer :: nprow,npcol,myrow,mypcol,err,n_col,n_row,dectype,err_act
integer :: icontxt
integer :: int_err(5),temp(1),exch(2)
integer :: nprow,npcol,myrow,mycol,err,n_col,n_row,dectype,i,err_act
integer :: icontxt, n_
integer :: int_err(5),temp(1),exch
real(kind(1.d0)) :: real_err(5)
logical, parameter :: debug=.false.
character(len=20) :: name, char_err
character(len=20) :: name, ch_err
if(psb_get_errstatus().ne.0) return
info=0
@@ -247,59 +219,31 @@ subroutine psb_iallocv(m, x, desc_a, info)
call psb_erractionsave(err_act)
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..
if (nprow.eq.-1) then
info = 2010
call psb_errpush(info,name)
goto 9999
info = 2010
call psb_errpush(info,name)
goto 9999
else if (npcol.ne.1) then
info = 2030
int_err(1) = npcol
call psb_errpush(info,name,int_err)
goto 9999
info = 2030
int_err(1) = npcol
call psb_errpush(info,name,int_err)
goto 9999
endif
dectype=desc_a%matrix_data(psb_dec_type_)
if (debug) write(0,*) 'dall: dectype',dectype
if (debug) write(0,*) 'dall: is_ok? dectype',psb_is_ok_dec(dectype)
!... check m and n parameters....
if (m.lt.0) 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
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
if (.not.psb_is_ok_dec(dectype)) then
info = 3110
call psb_errpush(info,name)
goto 9999
endif
! As this is a rank-1 array, optional parameter N is actually ignored.
!....allocate x .....
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
call psb_erractionrestore(err_act)
if (err_act.eq.act_ret) then
return
else
call psb_error(icontxt)
if (err_act.eq.act_abort) then
call psb_error(icontxt)
return
end if
return
src/tools/psb_iins.f90
+3 -3
View File
@@ -44,7 +44,7 @@
! info - integer. Eventually returns an error code
! 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.
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)
!....insert dense submatrix to dense matrix .....
use psb_descriptor_type
@@ -266,7 +266,7 @@ end subroutine psb_iins
! desc_a - type(<psb_desc_type>). The communication descriptor.
! info - integer. Eventually returns an error code
! 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)
!....insert dense submatrix to dense matrix .....
use psb_descriptor_type
@@ -413,7 +413,7 @@ end subroutine psb_iinsvm
! desc_a - type(<psb_desc_type>). The communication descriptor.
! info - integer. Eventually returns an error code
! 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)
!....insert dense submatrix to dense matrix .....
use psb_descriptor_type
src/tools/psb_zallc.f90
+28 -92
View File
@@ -35,13 +35,11 @@
! Allocates dense matrix for PSBLAS routines
!
! Parameters:
! m - number of rows.
! n - number of columns.
! x - the matrix to be allocated.
! desc_a - the communication descriptor.
! info - eventually returns an error code
! js - (optional) the starting column
subroutine psb_zalloc(m, n, x, desc_a, info, js)
! info - possibly returns an error code
! n - optional number of columns.
subroutine psb_zalloc(x, desc_a, info, n)
!....allocate dense matrix for psblas routines.....
use psb_descriptor_type
use psb_const_mod
@@ -50,18 +48,16 @@ subroutine psb_zalloc(m, n, x, desc_a, info, js)
implicit none
!....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
integer :: info
integer, optional, intent(in) :: js
integer, optional, intent(in) :: n
!locals
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)
real(kind(1.d0)) :: real_err(5)
integer, allocatable:: prc_v(:)
character(len=20) :: name, ch_err
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_)
!... check m and n parameters....
if (m.lt.0) 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
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
if (present(js)) then
j=js
if (present(n)) then
n_ = n
else
j=1
n_ = 1
endif
!global check on m and n parameters
!global check on n parameters
if (myrow.eq.psb_root_) then
exch(1)=m
exch(2)=n
exch(3)=j
call igebs2d(icontxt,psb_all_,psb_topdef_, ithree,ione, exch, ithree)
exch(1)=n_
call igebs2d(icontxt,psb_all_,psb_topdef_, ione,ione, exch, ione)
else
call igebr2d(icontxt,psb_all_,psb_topdef_, ithree,ione, exch, ithree, psb_root_, 0)
if (exch(1).ne.m) then
call igebr2d(icontxt,psb_all_,psb_topdef_, ione,ione, exch, ione, psb_root_, 0)
if (exch(1).ne.n_) then
info=550
int_err(1)=1
call psb_errpush(info,name,int_err)
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
!....allocate x .....
if (psb_is_asb_dec(dectype).or.psb_is_upd_dec(dectype)) then
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
info=4010
ch_err='allocate'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
endif
do jj=j,j+n-1
do j=1,n_
do i=1,n_col
x(i,j) = 0.0d0
end do
end do
else if (psb_is_bld_dec(dectype)) then
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
info=4010
ch_err='allocate'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
endif
do jj=j,j+n-1
do j = 1, n_
do i=1,n_row
x(i,j) = 0.0d0
end do
@@ -224,11 +188,10 @@ end subroutine psb_zalloc
! Allocates dense matrix for PSBLAS routines
!
! Parameters:
! m - number of rows.
! x - the matrix to be allocated.
! desc_a - the communication descriptor.
! info - eventually returns an error code
subroutine psb_zallocv(m, x, desc_a,info)
! info - possibly returns an error code
subroutine psb_zallocv(x, desc_a,info,n)
!....allocate sparse matrix structure for psblas routines.....
use psb_descriptor_type
use psb_const_mod
@@ -238,14 +201,14 @@ subroutine psb_zallocv(m, x, desc_a,info)
implicit none
!....parameters...
integer, intent(in) :: m
complex(kind(1.d0)), pointer :: x(:)
type(psb_desc_type), intent(in):: desc_a
integer :: info
complex(kind(1.d0)), pointer :: x(:)
type(psb_desc_type), intent(in) :: desc_a
integer :: info
integer, optional, intent(in) :: n
!locals
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
real(kind(1.d0)) :: real_err(5)
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: is_ok? dectype',psb_is_ok_dec(dectype)
!... check m and n parameters....
if (m.lt.0) 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
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 = 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
! As this is a rank-1 array, optional parameter N is actually ignored.
!....allocate x .....
if (psb_is_asb_dec(dectype).or.psb_is_upd_dec(dectype)) then
src/tools/psb_zins.f90
+3 -3
View File
@@ -44,7 +44,7 @@
! info - integer. Eventually returns an error code
! 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.
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)
!....insert dense submatrix to dense matrix .....
use psb_descriptor_type
@@ -268,7 +268,7 @@ end subroutine psb_zins
! desc_a - type(<psb_desc_type>). The communication descriptor.
! info - integer. Eventually returns an error code
! 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)
!....insert dense submatrix to dense matrix .....
use psb_descriptor_type
@@ -483,7 +483,7 @@ end subroutine psb_zinsvm
! info - integer. Eventually returns an error code
! iblck - integer(optional). First row of submatrix belonging to blck to be inserted.
! 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)
!....insert dense submatrix to dense matrix .....
use psb_descriptor_type
src/tools/psb_zspasb.f90
+1
View File
@@ -162,6 +162,7 @@ subroutine psb_zspasb(a,desc_a, info, afmt, upd, dupl)
! Do the real conversion into the requested storage format
! result is put in A
write(0,*) 'Calling csdp from SPASB'
call psb_csdp(atemp,a,info,ifc=2,upd=upd_,dupl=dupl_)
IF (debug) WRITE (*, *) myrow,' ASB: From DCSDP',info,' ',A%FIDA
test/Fileread/df_sample.f90
+2 -2
View File
@@ -208,10 +208,10 @@ program df_sample
& desc_a,b_col_glob,b_col,info,fmt=afmt)
end if
call psb_geall(m_problem,x_col,desc_a,info)
call psb_geall(x_col,desc_a,info)
x_col(:) =0.0
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
call psb_geasb(r_col,desc_a,info)
t2 = mpi_wtime() - t1
test/Fileread/dhb2mm.f90
+37 -4
View File
@@ -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
use psb_sparse_mod
use mmio
use hbio
type(psb_dspmat_type) :: a
integer n, nnz,info,i,j,k
INTEGER :: iwflag,IOUT,NCOL,NELTVL,NNZERO,NRHS,NRHSIX,NROW,&
& iter
CHARACTER :: RHSDATATYPE,DATATYPE*3,KEY*8,OUTFILE*20,MTITLE*72
integer :: info
character(len=72) :: mtitle
call hb_read(a,info,mtitle=mtitle)
test/Fileread/dmm2hb.f90
+36 -5
View File
@@ -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
use psb_sparse_mod
use mmio
use hbio
type(psb_dspmat_type) :: a
integer n, nnz,info,i,j,k
nrhs = 0
nrhsix = 0
integer info
call mm_mat_read(a,info)
test/Fileread/mat_dist.f90
+16 -16
View File
@@ -211,7 +211,7 @@ contains
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
call psb_geall(nrow,b,desc_a,info)
call psb_geall(b,desc_a,info)
if(info/=0) then
info=4010
ch_err='psb_psdsall'
@@ -272,7 +272,7 @@ contains
call psb_errpush(info,name,a_err=ch_err)
goto 9999
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)
if(info/=0) then
info=4010
@@ -318,7 +318,7 @@ contains
call psb_errpush(info,name,a_err=ch_err)
goto 9999
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)
if(info/=0) then
info=4010
@@ -354,7 +354,7 @@ contains
call psb_errpush(info,name,a_err=ch_err)
goto 9999
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)
if(info/=0) then
info=4010
@@ -385,7 +385,7 @@ contains
call psb_errpush(info,name,a_err=ch_err)
goto 9999
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)
if(info/=0) then
info=4010
@@ -633,7 +633,7 @@ contains
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
call psb_geall(nrow,b,desc_a,info)
call psb_geall(b,desc_a,info)
if(info/=0) then
info=4010
ch_err='psb_psdsall'
@@ -699,7 +699,7 @@ contains
goto 9999
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)
if(info/=0) then
info=4010
@@ -745,7 +745,7 @@ contains
call psb_errpush(info,name,a_err=ch_err)
goto 9999
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)
if(info/=0) then
info=4010
@@ -994,7 +994,7 @@ contains
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
call psb_geall(nrow,b,desc_a,info)
call psb_geall(b,desc_a,info)
if(info/=0) then
info=4010
ch_err='psb_psdsall'
@@ -1055,7 +1055,7 @@ contains
call psb_errpush(info,name,a_err=ch_err)
goto 9999
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)
if(info/=0) then
info=4010
@@ -1101,7 +1101,7 @@ contains
call psb_errpush(info,name,a_err=ch_err)
goto 9999
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)
if(info/=0) then
info=4010
@@ -1137,7 +1137,7 @@ contains
call psb_errpush(info,name,a_err=ch_err)
goto 9999
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)
if(info/=0) then
info=4010
@@ -1168,7 +1168,7 @@ contains
call psb_errpush(info,name,a_err=ch_err)
goto 9999
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)
if(info/=0) then
info=4010
@@ -1416,7 +1416,7 @@ contains
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
call psb_geall(nrow,b,desc_a,info)
call psb_geall(b,desc_a,info)
if(info/=0) then
info=4010
ch_err='psb_psdsall'
@@ -1482,7 +1482,7 @@ contains
goto 9999
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)
if(info/=0) then
info=4010
@@ -1528,7 +1528,7 @@ contains
call psb_errpush(info,name,a_err=ch_err)
goto 9999
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)
if(info/=0) then
info=4010
test/Fileread/zf_sample.f90
+2 -2
View File
@@ -209,10 +209,10 @@ program zf_sample
& desc_a,b_col_glob,b_col,info,fmt=afmt)
end if
call psb_geall(m_problem,x_col,desc_a,info)
call psb_geall(x_col,desc_a,info)
x_col(:) =0.0
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
call psb_geasb(r_col,desc_a,info)
t2 = mpi_wtime() - t1
test/Fileread/zhb2mm.f90
+37 -4
View File
@@ -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
use psb_sparse_mod
use mmio
use hbio
type(psb_zspmat_type) :: a
integer n, nnz,info,i,j,k
INTEGER :: iwflag,IOUT,NCOL,NELTVL,NNZERO,NRHS,NRHSIX,NROW,&
& iter
CHARACTER :: RHSDATATYPE,DATATYPE*3,KEY*8,OUTFILE*20,MTITLE*72
integer :: info
character(len=72) :: mtitle
call hb_read(a,info,mtitle=mtitle)
test/Fileread/zmm2hb.f90
+36 -5
View File
@@ -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
use psb_sparse_mod
use mmio
use hbio
type(psb_zspmat_type) :: a
integer n, nnz,info,i,j,k
nrhs = 0
nrhsix = 0
integer info
call mm_mat_read(a,info)
test/pargen/ppde90.f90
+4 -4
View File
@@ -489,8 +489,8 @@ contains
call psb_cdall(n,n,parts,icontxt,desc_a,info)
call psb_spall(a,desc_a,info,nnz=nnz)
! define rhs from boundary conditions; also build initial guess
call psb_geall(n,b,desc_a,info)
call psb_geall(n,t,desc_a,info)
call psb_geall(b,desc_a,info)
call psb_geall(t,desc_a,info)
if(info.ne.0) then
info=4010
ch_err='allocation rout.'
@@ -644,10 +644,10 @@ contains
call psb_spins(element-1,irow,icol,val,a,desc_a,info)
if(info.ne.0) exit
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
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
end if
end do