diff --git a/README b/README index a465a4e0..6c2b4342 100644 --- a/README +++ b/README @@ -1,4 +1,30 @@ -This directory contains the PSBLAS library, version 3.0 +This directory contains the PSBLAS library, version 3.0-pre-release. + +WARNING: This is higly experimental, unstable, and almost undocumented. + Do not count on anything to remain unchanged by the time 3.0 + really comes out. + +This version requires a working Fortran 2003 compiler; we do not use +all of the language features (specifically, so far we did not employ +FINAL subroutines), but the features we use were sufficient in +identifying bugs in ALL compilers we tried (all the bugs have been +reported and mostly fixed by the respective vendors). + +Notes: This code is confirmed to work with NAGware 5.2 and XLF 13.1. + It does NOT work with GNU Fortran 4.5; it is one of the + testbeds for GNU Fortran 4.6, the active development version + (as of May 2010), but does not work yet. + If you find it working with other compilers, please let us + know. + + The "undocumented" in the warning above refers to the + internals; the new internals have been completely overhauled, + and in many cases rewritten; they are supposed to enable much + better interfacing with user-defined storage formats. If the + user is only interested in the predefined formats, then the + user's guide should be sufficient; what is lacking is + documentation on how to add to the library. This will come. + Version 1.0 of the library was described in: @@ -8,10 +34,11 @@ ACM Trans. on Math. Software, 26(4), Dec. 2000, pp. 527-550. PLATFORMS: -The compilation process relies on the choice of an appropriate -Make.inc file; we have tested with AIX XLF, Intel ifort/Linux, Nag -f95/Linux, GNU Fortran/Linux, Sun Forte 6.2. If you succeed in -compiling with other compiler/operating systems please let us know. +obsolete... +--The compilation process relies on the choice of an appropriate +--Make.inc file; we have tested with AIX XLF, Intel ifort/Linux, Nag +--f95/Linux, GNU Fortran/Linux, Sun Forte 6.2. If you succeed in +--compiling with other compiler/operating systems please let us know. LINUX: @@ -50,15 +77,11 @@ prerequisites (see also SERIAL below): 1. A working version of MPI -2. The MPI version of the BLACS; some systems (e.g. IBM SP) provide - a specific version, otherwise you can find it at - http://www.netlib.org/blacs/index.html - -3. A version of the BLAS; if you don't have a specific version for +2. A version of the BLAS; if you don't have a specific version for your platform you may try ATLAS available from http://math-atlas.sourceforge.net/ -4. We have had good results with the METIS library, from +3. We have had good results with the METIS library, from http://www-users.cs.umn.edu/~karypis/metis/metis/main.html This is optional; it is used in the util and test/fileread directories but only if you define the HAVE_METIS directive. @@ -67,8 +90,7 @@ The configure script will generate a Make.inc file suitable for building the library. The script is capable of recognizing the needed libraries with their default names; if they are in unusual places consider adding the paths -with --with-lib, or explicitly specifying the names in --with-blas, ---with-blacs etc. +with --with-lib, or explicitly specifying the names in --with-blas, etc. Please note that a common way for the configure script to fail is to specify inconsistent MPI vs. plain compilers, either directly or indirectly via environment variables; e.g. specifying the Intel @@ -139,4 +161,3 @@ Dario Pascucci -k \ No newline at end of file diff --git a/base/serial/f03/psb_s_mat_impl.f03 b/base/serial/f03/psb_s_mat_impl.f03 index 71d3d2e8..9a7e2847 100644 --- a/base/serial/f03/psb_s_mat_impl.f03 +++ b/base/serial/f03/psb_s_mat_impl.f03 @@ -619,6 +619,7 @@ subroutine psb_s_free(a) implicit none class(psb_s_sparse_mat), intent(inout) :: a + write(*,*) 'On entry to PSB_S_FREE: ',allocated(a%a) if (allocated(a%a)) then call a%a%free() deallocate(a%a) diff --git a/docs/html/contents.png b/docs/html/contents.png new file mode 100644 index 00000000..0c752c66 Binary files /dev/null and b/docs/html/contents.png differ diff --git a/docs/html/footnode.html b/docs/html/footnode.html index 1ccfc330..c056e778 100644 --- a/docs/html/footnode.html +++ b/docs/html/footnode.html @@ -1,6 +1,6 @@ - -next -up -previous +next +up +previous -contents +contents
Next: Contents @@ -60,9 +56,9 @@ University of Rome ``Tor Vergata'', Italy


-Software version: 2.3.1 +Software version: 3.0-beta
-September 30th, 2008 +May 15th, 2010
diff --git a/docs/html/next.png b/docs/html/next.png new file mode 100644 index 00000000..1628652a Binary files /dev/null and b/docs/html/next.png differ diff --git a/docs/html/next_g.png b/docs/html/next_g.png new file mode 100644 index 00000000..9d3f5912 Binary files /dev/null and b/docs/html/next_g.png differ diff --git a/docs/html/node1.html b/docs/html/node1.html index 2fb61f70..83bed67a 100644 --- a/docs/html/node1.html +++ b/docs/html/node1.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous
Next: Introduction diff --git a/docs/html/node10.html b/docs/html/node10.html index 5f2793b4..19339b1a 100644 --- a/docs/html/node10.html +++ b/docs/html/node10.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
Next: Sparse Matrix data structure diff --git a/docs/html/node100.html b/docs/html/node100.html index afc224e2..254ca301 100644 --- a/docs/html/node100.html +++ b/docs/html/node100.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
Next: psb_precaply Preconditioner diff --git a/docs/html/node101.html b/docs/html/node101.html index e40daf30..0b032746 100644 --- a/docs/html/node101.html +++ b/docs/html/node101.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
Next: psb_precdescr Prints diff --git a/docs/html/node102.html b/docs/html/node102.html index 7c673380..d02eb580 100644 --- a/docs/html/node102.html +++ b/docs/html/node102.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
Next: Iterative Methods diff --git a/docs/html/node103.html b/docs/html/node103.html index 2f98f091..cb70feef 100644 --- a/docs/html/node103.html +++ b/docs/html/node103.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
Next: psb_krylov Krylov diff --git a/docs/html/node104.html b/docs/html/node104.html index 03e58bfd..568e801c 100644 --- a/docs/html/node104.html +++ b/docs/html/node104.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
Next: Bibliography @@ -107,7 +103,7 @@ later). In the above formulae, $r_i=b-Ax_i$ the corresponding residual at the $i$-th iteration. @@ -366,20 +362,16 @@ An integer value; 0 means no error has been detected. -next +next -up +up -previous +previous -contents +contents
Next: Bibliography diff --git a/docs/html/node105.html b/docs/html/node105.html index c8ca0740..a4aaa0a6 100644 --- a/docs/html/node105.html +++ b/docs/html/node105.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
Next: About this document ... diff --git a/docs/html/node106.html b/docs/html/node106.html index 676efa80..71873b22 100644 --- a/docs/html/node106.html +++ b/docs/html/node106.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
Up: userhtml @@ -54,7 +50,7 @@ About this document ...

This document was generated using the -LaTeX2HTML translator Version 2002-2-1 (1.71) +LaTeX2HTML translator Version 2008 (1.71)

Copyright © 1993, 1994, 1995, 1996, Nikos Drakos, @@ -65,9 +61,9 @@ Copyright © 1997, 1998, 1999, Mathematics Department, Macquarie University, Sydney.

The command line arguments were:
- latex2html -noaddress -dir ../../html userhtml.tex + latex2html -local_icons -noaddress -dir ../../html userhtml.tex

-The translation was initiated by Salvatore Filippone on 2008-09-19 +The translation was initiated by on 2010-05-13

diff --git a/docs/html/node11.html b/docs/html/node11.html index 85896c57..ded00ea9 100644 --- a/docs/html/node11.html +++ b/docs/html/node11.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
Next: Named Constants @@ -235,20 +231,16 @@ values: -next +next -up +up -previous +previous -contents +contents
Next: Named Constants diff --git a/docs/html/node12.html b/docs/html/node12.html index b3f23414..1adee702 100644 --- a/docs/html/node12.html +++ b/docs/html/node12.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
Next: Preconditioner data structure diff --git a/docs/html/node13.html b/docs/html/node13.html index a049bee7..bb1d56b8 100644 --- a/docs/html/node13.html +++ b/docs/html/node13.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
Next: Data structure query routines diff --git a/docs/html/node14.html b/docs/html/node14.html index 3dcdf50d..d53a0be1 100644 --- a/docs/html/node14.html +++ b/docs/html/node14.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
Next: psb_cd_get_local_rows Get diff --git a/docs/html/node15.html b/docs/html/node15.html index 20cedbb7..84b84610 100644 --- a/docs/html/node15.html +++ b/docs/html/node15.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
Next: psb_cd_get_local_cols Get @@ -97,7 +93,7 @@ Specified as: a structured data of type descdatapsb_desc_type. $|{\cal I}_i| + |{\cal B}_i|$ --> $\vert{\cal I}_i\vert + \vert{\cal B}_i\vert$. The returned value is specific to the calling process. diff --git a/docs/html/node16.html b/docs/html/node16.html index 2e3d38f2..2deec276 100644 --- a/docs/html/node16.html +++ b/docs/html/node16.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
Next: psb_cd_get_global_rows Get @@ -98,7 +94,7 @@ Specified as: a structured data of type descdatapsb_desc_type. $|{\cal I}_i| + |{\cal B}_i| +|{\cal H}_i|$ --> $\vert{\cal I}_i\vert + \vert{\cal B}_i\vert +\vert{\cal H}_i\vert$. The returned value is specific to the calling process. diff --git a/docs/html/node17.html b/docs/html/node17.html index 79c5050a..7b0a9445 100644 --- a/docs/html/node17.html +++ b/docs/html/node17.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
Next: psb_cd_get_global_cols Get diff --git a/docs/html/node18.html b/docs/html/node18.html index 0751b583..d5a3fee4 100644 --- a/docs/html/node18.html +++ b/docs/html/node18.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
Next: psb_cd_get_context Get communication context diff --git a/docs/html/node19.html b/docs/html/node19.html index 0627d65d..0e23472d 100644 --- a/docs/html/node19.html +++ b/docs/html/node19.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
Next: psb_cd_get_large_threshold Get diff --git a/docs/html/node2.html b/docs/html/node2.html index d0574a21..baa47b32 100644 --- a/docs/html/node2.html +++ b/docs/html/node2.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
Next: General overview @@ -136,20 +132,16 @@ computational fluid dynamics applications. -next +next -up +up -previous +previous -contents +contents
Next: General overview diff --git a/docs/html/node20.html b/docs/html/node20.html index e8438e25..66b382f1 100644 --- a/docs/html/node20.html +++ b/docs/html/node20.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
Next: psb_cd_set_large_threshold Set diff --git a/docs/html/node21.html b/docs/html/node21.html index ab809f1b..ae0f7a7e 100644 --- a/docs/html/node21.html +++ b/docs/html/node21.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
Next: psb_sp_get_nrows Get diff --git a/docs/html/node22.html b/docs/html/node22.html index cad71b10..6c53e8f2 100644 --- a/docs/html/node22.html +++ b/docs/html/node22.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
Next: psb_sp_get_ncols Get diff --git a/docs/html/node23.html b/docs/html/node23.html index 2e0ba3ef..98fbbec5 100644 --- a/docs/html/node23.html +++ b/docs/html/node23.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
Next: psb_sp_get_nnzeros Get diff --git a/docs/html/node24.html b/docs/html/node24.html index efb8e79f..bf671eca 100644 --- a/docs/html/node24.html +++ b/docs/html/node24.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
Next: Computational routines diff --git a/docs/html/node25.html b/docs/html/node25.html index 42ff464e..0a72eb37 100644 --- a/docs/html/node25.html +++ b/docs/html/node25.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
Next: psb_geaxpby General diff --git a/docs/html/node26.html b/docs/html/node26.html index 39fe2a17..7b6e0f58 100644 --- a/docs/html/node26.html +++ b/docs/html/node26.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
Next: psb_gedot Dot @@ -260,20 +256,16 @@ An integer value; 0 means no error has been detected. -next +next -up +up -previous +previous -contents +contents
Next: psb_gedot Dot diff --git a/docs/html/node27.html b/docs/html/node27.html index 3bee5f3d..3b4d27a4 100644 --- a/docs/html/node27.html +++ b/docs/html/node27.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
Next: psb_gedots Generalized @@ -259,20 +255,16 @@ An integer value; 0 means no error has been detected. -next +next -up +up -previous +previous -contents +contents
Next: psb_gedots Generalized diff --git a/docs/html/node28.html b/docs/html/node28.html index 3d89f711..605db5c1 100644 --- a/docs/html/node28.html +++ b/docs/html/node28.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
Next: psb_geamax Infinity-Norm @@ -245,20 +241,16 @@ An integer value; 0 means no error has been detected. -next +next -up +up -previous +previous -contents +contents
Next: psb_geamax Infinity-Norm diff --git a/docs/html/node29.html b/docs/html/node29.html index c9f3306f..a21f2fd1 100644 --- a/docs/html/node29.html +++ b/docs/html/node29.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
Next: psb_geamaxs Generalized @@ -223,20 +219,16 @@ An integer value; 0 means no error has been detected. -next +next -up +up -previous +previous -contents +contents
Next: psb_geamaxs Generalized diff --git a/docs/html/node3.html b/docs/html/node3.html index 81c3b0eb..067d5ed1 100644 --- a/docs/html/node3.html +++ b/docs/html/node3.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
Next: Basic Nomenclature @@ -179,20 +175,16 @@ bottleneck would make this option unattractive in most cases. -next +next -up +up -previous +previous -contents +contents
Next: Basic Nomenclature diff --git a/docs/html/node30.html b/docs/html/node30.html index 36a36823..27a411ae 100644 --- a/docs/html/node30.html +++ b/docs/html/node30.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
Next: psb_geasum 1-Norm @@ -197,20 +193,16 @@ An integer value; 0 means no error has been detected. -next +next -up +up -previous +previous -contents +contents
Next: psb_geasum 1-Norm diff --git a/docs/html/node31.html b/docs/html/node31.html index 4ddd6762..5bf61024 100644 --- a/docs/html/node31.html +++ b/docs/html/node31.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
Next: psb_geasums Generalized @@ -222,20 +218,16 @@ An integer value; 0 means no error has been detected. -next +next -up +up -previous +previous -contents +contents
Next: psb_geasums Generalized diff --git a/docs/html/node32.html b/docs/html/node32.html index bf9cd8cb..9e7b2c20 100644 --- a/docs/html/node32.html +++ b/docs/html/node32.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
Next: psb_genrm2s Generalized @@ -407,20 +403,16 @@ An integer value; 0 means no error has been detected. -next +next -up +up -previous +previous -contents +contents
Next: psb_genrm2s Generalized diff --git a/docs/html/node33.html b/docs/html/node33.html index 5274f0bf..bc8cb6ce 100644 --- a/docs/html/node33.html +++ b/docs/html/node33.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
Next: psb_spnrmi Infinity @@ -99,7 +95,7 @@ res(i) \leftarrow \sqrt{x^T x} --> \begin{displaymath}res(i) \leftarrow \sqrt{x^T x}\end{displaymath} @@ -118,7 +114,7 @@ res(i) \leftarrow \sqrt{x^H x} --> \begin{displaymath}res(i) \leftarrow \sqrt{x^H x}\end{displaymath} @@ -244,20 +240,16 @@ An integer value; 0 means no error has been detected. -next +next -up +up -previous +previous -contents +contents
Next: psb_spnrmi Infinity diff --git a/docs/html/node34.html b/docs/html/node34.html index d82add0e..8fd0a8d3 100644 --- a/docs/html/node34.html +++ b/docs/html/node34.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
Next: psb_spmm Sparse @@ -198,20 +194,16 @@ An integer value; 0 means no error has been detected. -next +next -up +up -previous +previous -contents +contents
Next: psb_spmm Sparse diff --git a/docs/html/node35.html b/docs/html/node35.html index a709c950..6f93c590 100644 --- a/docs/html/node35.html +++ b/docs/html/node35.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
Next: psb_spsm Triangular @@ -410,20 +406,16 @@ An integer value; 0 means no error has been detected. -next +next -up +up -previous +previous -contents +contents
Next: psb_spsm Triangular diff --git a/docs/html/node36.html b/docs/html/node36.html index d11283f4..a1bfb7b2 100644 --- a/docs/html/node36.html +++ b/docs/html/node36.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
Next: Communication routines @@ -455,20 +451,16 @@ An integer value; 0 means no error has been detected. -next +next -up +up -previous +previous -contents +contents
Next: Communication routines diff --git a/docs/html/node37.html b/docs/html/node37.html index 9132d4d4..3841acf1 100644 --- a/docs/html/node37.html +++ b/docs/html/node37.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
Next: psb_halo Halo diff --git a/docs/html/node38.html b/docs/html/node38.html index 1a1c5b77..24e71341 100644 --- a/docs/html/node38.html +++ b/docs/html/node38.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
Next: psb_ovrl Overlap @@ -632,20 +628,16 @@ Process 1 -next +next -up +up -previous +previous -contents +contents
Next: psb_ovrl Overlap diff --git a/docs/html/node39.html b/docs/html/node39.html index 39877f9c..e5af0087 100644 --- a/docs/html/node39.html +++ b/docs/html/node39.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
Next: psb_gather Gather @@ -90,7 +86,7 @@ where: ALT="$x$">
$Q$
is the overlap operator; it is the composition of two @@ -98,7 +94,7 @@ operators $ P_a$ and $ P^{T}$.
@@ -187,13 +183,13 @@ Specified as: a structured data of type descdatapsb_desc_type.
update = psb_add_
Sum overlap entries, i.e. apply $P^T$;
update = psb_avg_
Average overlap entries, i.e. apply $P_aP^T$;
@@ -270,11 +266,11 @@ An integer value; 0 means no error has been detected. the descriptor, no operations are performed;
  • The operator $ P^{T}$ performs the reduction sum of overlap elements; it is a ``prolongation'' operator $P^T$ that replicates overlap elements, accounting for the physical replication @@ -740,20 +736,16 @@ Process 1 -next +next -up +up -previous +previous -contents +contents
    Next: psb_gather Gather diff --git a/docs/html/node4.html b/docs/html/node4.html index e49d5e5c..a2dec0bf 100644 --- a/docs/html/node4.html +++ b/docs/html/node4.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
    Next: Library contents @@ -69,21 +65,21 @@ PDE. Each point of the discretization mesh will have (at least) one associated equation/variable, and therefore one index. We say that point $i$ depends on point $j$ if the equation for a variable associated with $i$ contains a term in $j$, or equivalently if $a_{ij} \ne0$. After the partition of the discretization mesh into sub-domains @@ -136,19 +132,19 @@ work [ We denote the sets of internal, boundary and halo points for a given subdomain by $\cal I$, $\cal B$ and $\cal H$. Each subdomain is assigned to one process; each process usually owns one subdomain, although the user may choose to assign more than one subdomain to a process. If each process $i$ owns one subdomain, the number of rows in the local sparse matrix is @@ -156,7 +152,7 @@ subdomain, the number of rows in the local sparse matrix is $|{\cal I}_i| + |{\cal B}_i|$ --> $\vert{\cal I}_i\vert + \vert{\cal B}_i\vert$, and the number of local columns (i.e. those for which there exists at least one non-zero entry in the @@ -164,7 +160,7 @@ local rows) is $\vert{\cal I}_i\vert + \vert{\cal B}_i\vert +\vert{\cal H}_i\vert$. @@ -203,20 +199,16 @@ points in the literature. -next +next -up +up -previous +previous -contents +contents
    Next: Library contents diff --git a/docs/html/node40.html b/docs/html/node40.html index 96b95879..7b7049a2 100644 --- a/docs/html/node40.html +++ b/docs/html/node40.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
    Next: psb_scatter Scatter @@ -100,7 +96,7 @@ where: ALT="$loc\_x_i$">
    is the local portion of global dense matrix on process $i$.
    @@ -246,20 +242,16 @@ An integer value; 0 means no error has been detected. -next +next -up +up -previous +previous -contents +contents
    Next: psb_scatter Scatter diff --git a/docs/html/node41.html b/docs/html/node41.html index 04a39ed8..e7ad35e1 100644 --- a/docs/html/node41.html +++ b/docs/html/node41.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
    Next: Data management routines @@ -98,7 +94,7 @@ where: ALT="$loc\_x_i$">
    is the local portion of global dense matrix on process $i$.
    @@ -244,20 +240,16 @@ An integer value; 0 means no error has been detected. -next +next -up +up -previous +previous -contents +contents
    Next: Data management routines diff --git a/docs/html/node42.html b/docs/html/node42.html index 80440136..135b8c15 100644 --- a/docs/html/node42.html +++ b/docs/html/node42.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
    Next: psb_cdall Allocates diff --git a/docs/html/node43.html b/docs/html/node43.html index f1c1fc1c..aea56fc6 100644 --- a/docs/html/node43.html +++ b/docs/html/node43.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
    Next: psb_cdins Communication @@ -129,7 +125,7 @@ Specified as: an integer value $0,1$, default $0$. @@ -285,7 +281,7 @@ An integer value; 0 means no error has been detected. $0\le pv(i) < np$ --> $0\le pv(i) < np$; if In this case the association between an index and a process is specified via an integer vector; the size of the index space is equal to the size of vg, and each index $i$ is assigned to the process $I$ gets assigned a consecutive chunk of $N_I=nl$ global indices. @@ -392,20 +388,16 @@ An integer value; 0 means no error has been detected. -next +next -up +up -previous +previous -contents +contents
    Next: psb_cdins Communication diff --git a/docs/html/node44.html b/docs/html/node44.html index 734d8588..f601b82c 100644 --- a/docs/html/node44.html +++ b/docs/html/node44.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
    Next: psb_cdasb Communication @@ -164,20 +160,16 @@ nor the end vertex belong to the current process. -next +next -up +up -previous +previous -contents +contents
    Next: psb_cdasb Communication diff --git a/docs/html/node45.html b/docs/html/node45.html index 433fe050..992a2a25 100644 --- a/docs/html/node45.html +++ b/docs/html/node45.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
    Next: psb_cdcpy Copies diff --git a/docs/html/node46.html b/docs/html/node46.html index 88524e07..bf6b5952 100644 --- a/docs/html/node46.html +++ b/docs/html/node46.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
    Next: psb_cdfree Frees diff --git a/docs/html/node47.html b/docs/html/node47.html index dc24d737..db4e6125 100644 --- a/docs/html/node47.html +++ b/docs/html/node47.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
    Next: psb_cdbldext Build diff --git a/docs/html/node48.html b/docs/html/node48.html index 462e9540..833b3d18 100644 --- a/docs/html/node48.html +++ b/docs/html/node48.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
    Next: psb_spall Allocates @@ -179,20 +175,16 @@ An integer value; 0 means no error has been detected. -next +next -up +up -previous +previous -contents +contents
    Next: psb_spall Allocates diff --git a/docs/html/node49.html b/docs/html/node49.html index 99aa9629..a545ac96 100644 --- a/docs/html/node49.html +++ b/docs/html/node49.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
    Next: psb_spins Insert @@ -148,20 +144,16 @@ An integer value; 0 means no error has been detected. -next +next -up +up -previous +previous -contents +contents
    Next: psb_spins Insert diff --git a/docs/html/node5.html b/docs/html/node5.html index 26903f7d..644f0180 100644 --- a/docs/html/node5.html +++ b/docs/html/node5.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
    Next: Application structure @@ -157,20 +153,16 @@ are classified as: -next +next -up +up -previous +previous -contents +contents
    Next: Application structure diff --git a/docs/html/node50.html b/docs/html/node50.html index 9a133b7a..63c12826 100644 --- a/docs/html/node50.html +++ b/docs/html/node50.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
    Next: psb_spasb Sparse @@ -217,20 +213,16 @@ An integer value; 0 means no error has been detected. -next +next -up +up -previous +previous -contents +contents
    Next: psb_spasb Sparse diff --git a/docs/html/node51.html b/docs/html/node51.html index f989b8c0..6652f26e 100644 --- a/docs/html/node51.html +++ b/docs/html/node51.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
    Next: psb_spfree Frees @@ -176,20 +172,16 @@ An integer value; 0 means no error has been detected. -next +next -up +up -previous +previous -contents +contents
    Next: psb_spfree Frees diff --git a/docs/html/node52.html b/docs/html/node52.html index 0b74fa30..8503bc0c 100644 --- a/docs/html/node52.html +++ b/docs/html/node52.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
    Next: psb_sprn Reinit diff --git a/docs/html/node53.html b/docs/html/node53.html index e26e9cd2..c3a77fe3 100644 --- a/docs/html/node53.html +++ b/docs/html/node53.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
    Next: psb_geall Allocates diff --git a/docs/html/node54.html b/docs/html/node54.html index 92b37ddb..bbde845c 100644 --- a/docs/html/node54.html +++ b/docs/html/node54.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
    Next: psb_geins Dense diff --git a/docs/html/node55.html b/docs/html/node55.html index b2427509..a7a4baa5 100644 --- a/docs/html/node55.html +++ b/docs/html/node55.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
    Next: psb_geasb Assembly @@ -88,7 +84,7 @@ Specified as: an integer value.
    irw
    Indices of the rows to be inserted. Specifically, row $i$ of -next +next -up +up -previous +previous -contents +contents
    Next: psb_geasb Assembly diff --git a/docs/html/node56.html b/docs/html/node56.html index 7dcbad13..405a3474 100644 --- a/docs/html/node56.html +++ b/docs/html/node56.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
    Next: psb_gefree Frees diff --git a/docs/html/node57.html b/docs/html/node57.html index 3efa7b4f..d5e8fb35 100644 --- a/docs/html/node57.html +++ b/docs/html/node57.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
    Next: psb_gelp Applies diff --git a/docs/html/node58.html b/docs/html/node58.html index b5959c9a..77dd7eae 100644 --- a/docs/html/node58.html +++ b/docs/html/node58.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
    Next: psb_glob_to_loc Global @@ -78,7 +74,7 @@ call psb_gelp(trans, iperm, x, info) WIDTH="16" HEIGHT="14" ALIGN="BOTTOM" BORDER="0" SRC="img1.png" ALT="$A$"> or $A^T$.
    @@ -92,7 +88,7 @@ Specified as: a single character with value 'N' for $A$ or 'T' for $A^T$.
    diff --git a/docs/html/node59.html b/docs/html/node59.html index 4d08709b..a314e4f7 100644 --- a/docs/html/node59.html +++ b/docs/html/node59.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
    Next: psb_loc_to_glob Local @@ -194,20 +190,16 @@ An integer value; 0 means no error has been detected. -next +next -up +up -previous +previous -contents +contents
    Next: psb_loc_to_glob Local diff --git a/docs/html/node6.html b/docs/html/node6.html index c5ae83ed..7ca89b2d 100644 --- a/docs/html/node6.html +++ b/docs/html/node6.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
    Next: Programming model @@ -90,7 +86,7 @@ mapping from the ``global'' numbering $1\dots n$ to a numbering ``local'' to each process; each process $i$ will own a certain subset -next +next -up +up -previous +previous -contents +contents
    Next: Programming model diff --git a/docs/html/node60.html b/docs/html/node60.html index 27ebf814..2e81edab 100644 --- a/docs/html/node60.html +++ b/docs/html/node60.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
    Next: psb_is_owned @@ -170,20 +166,16 @@ An integer value; 0 means no error has been detected. -next +next -up +up -previous +previous -contents +contents
    Next: psb_is_owned diff --git a/docs/html/node61.html b/docs/html/node61.html index 64ce9b3c..ec6fbfd0 100644 --- a/docs/html/node61.html +++ b/docs/html/node61.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
    Next: psb_owned_index diff --git a/docs/html/node62.html b/docs/html/node62.html index f59af73f..5f5f5240 100644 --- a/docs/html/node62.html +++ b/docs/html/node62.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
    Next: psb_is_local diff --git a/docs/html/node63.html b/docs/html/node63.html index 201acca2..9308ef31 100644 --- a/docs/html/node63.html +++ b/docs/html/node63.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
    Next: psb_local_index diff --git a/docs/html/node64.html b/docs/html/node64.html index de7e9dc8..2fb96dd0 100644 --- a/docs/html/node64.html +++ b/docs/html/node64.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
    Next: psb_get_boundary Extract diff --git a/docs/html/node65.html b/docs/html/node65.html index 6af8fb33..72dd15af 100644 --- a/docs/html/node65.html +++ b/docs/html/node65.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
    Next: psb_get_overlap Extract diff --git a/docs/html/node66.html b/docs/html/node66.html index aae8df71..605cdf81 100644 --- a/docs/html/node66.html +++ b/docs/html/node66.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
    Next: psb_sp_getrow Extract diff --git a/docs/html/node67.html b/docs/html/node67.html index 757de491..f930e3a1 100644 --- a/docs/html/node67.html +++ b/docs/html/node67.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
    Next: psb_sizeof Memory @@ -236,20 +232,16 @@ An integer value; 0 means no error has been detected. -next +next -up +up -previous +previous -contents +contents
    Next: psb_sizeof Memory diff --git a/docs/html/node68.html b/docs/html/node68.html index 0deb929d..e21f8847 100644 --- a/docs/html/node68.html +++ b/docs/html/node68.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
    Next: Sorting utilities diff --git a/docs/html/node69.html b/docs/html/node69.html index 0bb41877..73980b76 100644 --- a/docs/html/node69.html +++ b/docs/html/node69.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
    Next: Parallel environment routines @@ -210,7 +206,7 @@ position as the corresponding entries in $ix(i) \leftarrow i$; thus, upon return from the subroutine, for each index $i$ we have in ; thus, upon return from the subroutine, for each -next +next -up +up -previous +previous -contents +contents
    Next: Parallel environment routines diff --git a/docs/html/node7.html b/docs/html/node7.html index 7a65b85d..6f91e4e6 100644 --- a/docs/html/node7.html +++ b/docs/html/node7.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
    Next: Data Structures @@ -102,20 +98,16 @@ as: -next +next -up +up -previous +previous -contents +contents
    Next: Data Structures diff --git a/docs/html/node70.html b/docs/html/node70.html index 9f57dfdd..7215ab78 100644 --- a/docs/html/node70.html +++ b/docs/html/node70.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
    Next: psb_init Initializes diff --git a/docs/html/node71.html b/docs/html/node71.html index 1cc1eccb..f0640c2f 100644 --- a/docs/html/node71.html +++ b/docs/html/node71.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
    Next: psb_info Return @@ -61,7 +57,7 @@ psb_init -- Initializes PSBLAS parallel environment 

    -call psb_init(icontxt, np)
+call psb_init(icontxt, np, basectxt, ids)

    @@ -83,8 +79,36 @@ Type: optional.
    Intent: in.
    -Specified as: an integer value. Default: use all available processes provided by the underlying -parallel environment. +Specified as: an integer value. Default: use all available processes. + +

    basectxt
    +
    the initial communication context. The new context + will be defined from the processes participating in the initial one. +
    +Scope: global. +
    +Type: optional. +
    +Intent: in. +
    +Specified as: an integer value. Default: use MPI_COMM_WORLD. +
    +
    ids
    +
    Identities of the processes to use for the new context; the + argument is ignored when np is not specified. This allows the + processes in the new environment to be in an order different from the + original one. +
    +Scope: global. +
    +Type: optional. +
    +Intent: in. +
    +Specified as: an integer array. Default: use the indices $(0\dots np-1)$.
    @@ -95,7 +119,9 @@ parallel environment.
    icontxt
    the communication context identifying the virtual - parallel machine. + parallel machine. Note that this is always a duplicate of + basectxt, so that library communications are completely + separated from other communication operations.
    Scope: global.
    @@ -117,13 +143,36 @@ Specified as: an integer variable. WIDTH="22" HEIGHT="30" ALIGN="MIDDLE" BORDER="0" SRC="img121.png" ALT="$np$"> greater than the - number of processes available in the underlying parallel execution + number of processes available in the underlying base parallel environment.

    • -

    +
    + + +next + +up + +previous + +contents +
    + Next: psb_info Return + Up: Parallel environment routines + Previous: Parallel environment routines +   Contents + diff --git a/docs/html/node72.html b/docs/html/node72.html index cfc0bfa5..fc493c83 100644 --- a/docs/html/node72.html +++ b/docs/html/node72.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
    Next: psb_exit Exit @@ -151,20 +147,16 @@ Specified as: an integer variable. -next +next -up +up -previous +previous -contents +contents
    Next: psb_exit Exit diff --git a/docs/html/node73.html b/docs/html/node73.html index 42ca2f0d..905ff576 100644 --- a/docs/html/node73.html +++ b/docs/html/node73.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
    Next: psb_get_mpicomm Get @@ -129,20 +125,16 @@ Specified as: a logical variable, default value: true. -next +next -up +up -previous +previous -contents +contents
    Next: psb_get_mpicomm Get diff --git a/docs/html/node74.html b/docs/html/node74.html index c017a53a..0ac3547a 100644 --- a/docs/html/node74.html +++ b/docs/html/node74.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
    Next: psb_get_rank Get diff --git a/docs/html/node75.html b/docs/html/node75.html index 6d2dbad5..e93495ea 100644 --- a/docs/html/node75.html +++ b/docs/html/node75.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
    Next: psb_wtime Wall diff --git a/docs/html/node76.html b/docs/html/node76.html index 57cf95df..f8154cb4 100644 --- a/docs/html/node76.html +++ b/docs/html/node76.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
    Next: psb_barrier Sinchronization diff --git a/docs/html/node77.html b/docs/html/node77.html index b7b312b7..35ef3802 100644 --- a/docs/html/node77.html +++ b/docs/html/node77.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
    Next: psb_abort Abort diff --git a/docs/html/node78.html b/docs/html/node78.html index d49e3020..6f69dc6b 100644 --- a/docs/html/node78.html +++ b/docs/html/node78.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
    Next: psb_bcast Broadcast diff --git a/docs/html/node79.html b/docs/html/node79.html index 1e871967..d67ccf53 100644 --- a/docs/html/node79.html +++ b/docs/html/node79.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
    Next: psb_sum Global @@ -141,20 +137,16 @@ scalar, or a rank 1 or 2 array, or a character or logical scalar. Type, kind, r -next +next -up +up -previous +previous -contents +contents
    Next: psb_sum Global diff --git a/docs/html/node8.html b/docs/html/node8.html index 9cb6ad01..1820479d 100644 --- a/docs/html/node8.html +++ b/docs/html/node8.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
    Next: Descriptor data structure diff --git a/docs/html/node80.html b/docs/html/node80.html index 02e84653..48c84234 100644 --- a/docs/html/node80.html +++ b/docs/html/node80.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
    Next: psb_max Global @@ -158,20 +154,16 @@ Type, kind, rank and size must agree on all processes. -next +next -up +up -previous +previous -contents +contents
    Next: psb_max Global diff --git a/docs/html/node81.html b/docs/html/node81.html index 03e6c055..165c57b0 100644 --- a/docs/html/node81.html +++ b/docs/html/node81.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
    Next: psb_min Global @@ -157,20 +153,16 @@ scalar, or a rank 1 or 2 array. Type, kind, rank and size must agree on all pro -next +next -up +up -previous +previous -contents +contents
    Next: psb_min Global diff --git a/docs/html/node82.html b/docs/html/node82.html index 0b8237e1..1a196f0d 100644 --- a/docs/html/node82.html +++ b/docs/html/node82.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
    Next: psb_amx Global @@ -159,20 +155,16 @@ Type, kind, rank and size must agree on all processes. -next +next -up +up -previous +previous -contents +contents
    Next: psb_amx Global diff --git a/docs/html/node83.html b/docs/html/node83.html index c671a145..aa8add23 100644 --- a/docs/html/node83.html +++ b/docs/html/node83.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
    Next: psb_amn Global @@ -157,20 +153,16 @@ scalar, or a rank 1 or 2 array. Type, kind, rank and size must agree on all pro -next +next -up +up -previous +previous -contents +contents
    Next: psb_amn Global diff --git a/docs/html/node84.html b/docs/html/node84.html index 5fd83006..5969e226 100644 --- a/docs/html/node84.html +++ b/docs/html/node84.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
    Next: psb_snd Send @@ -159,20 +155,16 @@ Type, kind, rank and size must agree on all processes. -next +next -up +up -previous +previous -contents +contents
    Next: psb_snd Send diff --git a/docs/html/node85.html b/docs/html/node85.html index b8295b14..91b83702 100644 --- a/docs/html/node85.html +++ b/docs/html/node85.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
    Next: psb_rcv Receive @@ -171,20 +167,16 @@ same value on sending and receiving processes. -next +next -up +up -previous +previous -contents +contents
    Next: psb_rcv Receive diff --git a/docs/html/node86.html b/docs/html/node86.html index 092de153..ef14fc22 100644 --- a/docs/html/node86.html +++ b/docs/html/node86.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
    Next: Error handling @@ -97,7 +93,7 @@ Specified as: an integer value $0<= src <= np-1$.
    @@ -170,20 +166,16 @@ not specified, size must agree as well. -next +next -up +up -previous +previous -contents +contents
    Next: Error handling diff --git a/docs/html/node87.html b/docs/html/node87.html index e1dd384d..21925c06 100644 --- a/docs/html/node87.html +++ b/docs/html/node87.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
    Next: psb_errpush Pushes @@ -98,7 +94,7 @@ explicitly.

    -

    +
    Figure 8: The layout of a generic psb_foo @@ -128,7 +124,7 @@ called by psb_spasb ... by process 0 (i.e. the root process).

    -

    +
    Figure 9: A sample PSBLAS-2.0 error @@ -172,20 +168,16 @@ A sample PSBLAS-2.0 error -next +next -up +up -previous +previous -contents +contents
    Next: psb_errpush Pushes diff --git a/docs/html/node88.html b/docs/html/node88.html index 243eb5de..6351283e 100644 --- a/docs/html/node88.html +++ b/docs/html/node88.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
    Next: psb_error Prints diff --git a/docs/html/node89.html b/docs/html/node89.html index 40f05367..1d5e0913 100644 --- a/docs/html/node89.html +++ b/docs/html/node89.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
    Next: psb_set_errverbosity Sets diff --git a/docs/html/node9.html b/docs/html/node9.html index cd05f733..2821666d 100644 --- a/docs/html/node9.html +++ b/docs/html/node9.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
    Next: Named Constants @@ -152,11 +148,11 @@ Specified as: an allocatable integer array of rank two.
    loc_to_glob
    each element $i$ of this array contains global identifier of the local variable $i$.
    @@ -228,20 +224,16 @@ sec. 3.4. -next +next -up +up -previous +previous -contents +contents
    Next: Named Constants diff --git a/docs/html/node90.html b/docs/html/node90.html index b77a2d7f..034dde07 100644 --- a/docs/html/node90.html +++ b/docs/html/node90.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
    Next: psb_set_erraction Set diff --git a/docs/html/node91.html b/docs/html/node91.html index 1dfb1024..77d45de9 100644 --- a/docs/html/node91.html +++ b/docs/html/node91.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
    Next: Utilities diff --git a/docs/html/node92.html b/docs/html/node92.html index 7631306f..6e3c0a8f 100644 --- a/docs/html/node92.html +++ b/docs/html/node92.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
    Next: hb_read Read diff --git a/docs/html/node93.html b/docs/html/node93.html index a9872f18..0cfb6e89 100644 --- a/docs/html/node93.html +++ b/docs/html/node93.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
    Next: hb_write Write @@ -135,20 +131,16 @@ An integer value; 0 means no error has been detected. -next +next -up +up -previous +previous -contents +contents
    Next: hb_write Write diff --git a/docs/html/node94.html b/docs/html/node94.html index a70ad484..f8da52ad 100644 --- a/docs/html/node94.html +++ b/docs/html/node94.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
    Next: mm_mat_read Read @@ -144,20 +140,16 @@ An integer value; 0 means no error has been detected. -next +next -up +up -previous +previous -contents +contents
    Next: mm_mat_read Read diff --git a/docs/html/node95.html b/docs/html/node95.html index e8773cfe..eff77f9b 100644 --- a/docs/html/node95.html +++ b/docs/html/node95.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
    Next: mm_vet_read Read diff --git a/docs/html/node96.html b/docs/html/node96.html index 9f7b7513..42f2f7d2 100644 --- a/docs/html/node96.html +++ b/docs/html/node96.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
    Next: mm_mat_write Write diff --git a/docs/html/node97.html b/docs/html/node97.html index d834c807..97ac0b44 100644 --- a/docs/html/node97.html +++ b/docs/html/node97.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
    Next: Preconditioner routines diff --git a/docs/html/node98.html b/docs/html/node98.html index 60801ac6..4e972b8f 100644 --- a/docs/html/node98.html +++ b/docs/html/node98.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
    Next: psb_precinit Initialize diff --git a/docs/html/node99.html b/docs/html/node99.html index 6eb83e90..1a4e4cd6 100644 --- a/docs/html/node99.html +++ b/docs/html/node99.html @@ -1,6 +1,6 @@ - -next +next -up +up -previous +previous -contents +contents
    Next: psb_precbld Builds @@ -110,7 +106,7 @@ Legal inputs to this subroutine are interpreted depending on the WIDTH="42" HEIGHT="30" ALIGN="MIDDLE" BORDER="0" SRC="img139.png" ALT="$ptype$"> string as follows3: + HREF="footnode.html#foot6737">3:
    NONE
    No preconditioning, i.e. the preconditioner is just a copy diff --git a/docs/html/prev.png b/docs/html/prev.png new file mode 100644 index 00000000..e60b8b40 Binary files /dev/null and b/docs/html/prev.png differ diff --git a/docs/html/prev_g.png b/docs/html/prev_g.png new file mode 100644 index 00000000..476d9568 Binary files /dev/null and b/docs/html/prev_g.png differ diff --git a/docs/html/up.png b/docs/html/up.png new file mode 100644 index 00000000..3937e168 Binary files /dev/null and b/docs/html/up.png differ diff --git a/docs/html/up_g.png b/docs/html/up_g.png new file mode 100644 index 00000000..54ceb683 Binary files /dev/null and b/docs/html/up_g.png differ diff --git a/docs/html/userhtml.html b/docs/html/userhtml.html index 2c7b7716..4616d839 100644 --- a/docs/html/userhtml.html +++ b/docs/html/userhtml.html @@ -1,6 +1,6 @@ - -next -up -previous +next +up +previous -contents +contents
    Next: Contents @@ -60,9 +56,9 @@ University of Rome ``Tor Vergata'', Italy


    -Software version: 2.3.1 +Software version: 3.0-beta
    -September 30th, 2008 +May 15th, 2010
    diff --git a/docs/psblas-2.3.1.pdf b/docs/psblas-3.0.pdf similarity index 95% rename from docs/psblas-2.3.1.pdf rename to docs/psblas-3.0.pdf index 154d14d2..2779c009 100644 --- a/docs/psblas-2.3.1.pdf +++ b/docs/psblas-3.0.pdf @@ -4,7 +4,7 @@ << /S /GoTo /D (title.0) >> endobj 8 0 obj -(PSBLAS-v2.3.1 User's Guide) +(PSBLAS-v3.0-beta User's Guide) endobj 9 0 obj << /S /GoTo /D (section.1) >> @@ -634,7 +634,7 @@ endobj << /S /GoTo /D [426 0 R /Fit ] >> endobj 428 0 obj << -/Length 699 +/Length 715 >> stream 0 g 0 G @@ -643,17 +643,17 @@ stream 0 g 0 G 0 g 0 G BT -/F16 24.7871 Tf 135.453 570.847 Td [(PSBLAS)-375(2.3.1)-375(User's)-375(guide)]TJ +/F16 24.7871 Tf 169.148 575.399 Td [(PSBLAS)-375(3.0-b)-31(eta)-375(User's)]TJ 234.467 -18.21 Td [(guide)]TJ ET q -1 0 0 1 125.3 554.602 cm +1 0 0 1 125.3 540.945 cm 0 0 343.711 4.981 re f Q BT -/F18 14.3462 Tf 132.314 532.919 Td [(A)-350(r)50(efer)50(enc)50(e)-350(guide)-350(for)-350(the)-350(Par)50(al)-50(lel)-350(Sp)50(arse)-350(BLAS)-350(libr)50(ary)]TJ +/F18 14.3462 Tf 132.314 519.262 Td [(A)-350(r)50(efer)50(enc)50(e)-350(guide)-350(for)-350(the)-350(Par)50(al)-50(lel)-350(Sp)50(arse)-350(BLAS)-350(libr)50(ary)]TJ 0 g 0 G 0 g 0 G -/F27 9.9626 Tf 223.567 -127.777 Td [(b)32(y)-383(Salv)63(atore)-383(Filipp)-32(one)]TJ 12.889 -11.955 Td [(and)-383(Alfredo)-384(Buttari)]TJ/F8 9.9626 Tf -52.52 -11.955 Td [(Univ)28(ersit)28(y)-334(of)-333(Rome)-333(\134T)83(or)-333(V)83(ergata".)]TJ 55.321 -24.824 Td [(Septem)28(b)-28(er)-333(30th,)-334(2008.)]TJ +/F27 9.9626 Tf 223.567 -123.224 Td [(b)32(y)-383(Salv)63(atore)-383(Filipp)-32(one)]TJ 12.889 -11.956 Td [(and)-383(Alfredo)-384(Buttari)]TJ/F8 9.9626 Tf -52.52 -11.955 Td [(Univ)28(ersit)28(y)-334(of)-333(Rome)-333(\134T)83(or)-333(V)83(ergata".)]TJ 82.192 -24.823 Td [(Ma)28(y)-334(15th,)-333(2010.)]TJ 0 g 0 G 0 g 0 G ET @@ -4159,7 +4159,7 @@ endobj /ProcSet [ /PDF /Text ] >> endobj 680 0 obj << -/Length 6162 +/Length 6169 >> stream 0 g 0 G @@ -4283,21 +4283,23 @@ BT 0 g 0 G 0 g 0 G 0 g 0 G -0 g 0 G -0 g 0 G -/F30 9.9626 Tf -185.248 -38.856 Td [(type)-525(psb_desc_type)]TJ 15.691 -11.956 Td [(integer,)-525(allocatable)-525(::)-525(matrix_data\050:\051,)-525(halo_index\050:\051)]TJ 0 -11.955 Td [(integer,)-525(allocatable)-525(::)-525(ext_index\050:\051)]TJ 0 -11.955 Td [(integer,)-525(allocatable)-525(::)-525(ovrlap_elem\050:,:\051)]TJ 0 -11.955 Td [(integer,)-525(allocatable)-525(::)-525(ovrlap_index\050:\051)]TJ 0 -11.955 Td [(integer,)-525(allocatable)-525(::)-525(ovr_mst_idx\050:\051)]TJ 0 -11.955 Td [(integer,)-525(allocatable)-525(::)-525(loc_to_glob\050:\051,)-525(glob_to_loc\050:\051)]TJ 0 -11.956 Td [(integer,)-525(allocatable)-525(::)-525(hashv\050:\051,)-525(glb_lc\050:,:\051)]TJ -15.691 -11.955 Td [(end)-525(type)-525(psb_desc_type)]TJ ET q 1 0 0 1 157.862 316.592 cm []0 d 0 J 0.398 w 0 0 m 329.396 0 l S Q q -1 0 0 1 158.062 196.31 cm -[]0 d 0 J 0.398 w 0 0 m 0 120.282 l S +1 0 0 1 158.062 196.509 cm +[]0 d 0 J 0.398 w 0 0 m 0 119.884 l S Q +0 g 0 G +0 g 0 G +BT +/F30 9.9626 Tf 166.231 302.335 Td [(type)-525(psb_desc_type)]TJ 15.691 -11.956 Td [(integer,)-525(allocatable)-525(::)-525(matrix_data\050:\051,)-525(halo_index\050:\051)]TJ 0 -11.955 Td [(integer,)-525(allocatable)-525(::)-525(ext_index\050:\051)]TJ 0 -11.955 Td [(integer,)-525(allocatable)-525(::)-525(ovrlap_elem\050:,:\051)]TJ 0 -11.955 Td [(integer,)-525(allocatable)-525(::)-525(ovrlap_index\050:\051)]TJ 0 -11.955 Td [(integer,)-525(allocatable)-525(::)-525(ovr_mst_idx\050:\051)]TJ 0 -11.956 Td [(integer,)-525(allocatable)-525(::)-525(loc_to_glob\050:\051,)-525(glob_to_loc\050:\051)]TJ 0 -11.955 Td [(integer,)-525(allocatable)-525(::)-525(hashv\050:\051,)-525(glb_lc\050:,:\051)]TJ -15.691 -11.955 Td [(end)-525(type)-525(psb_desc_type)]TJ +ET q -1 0 0 1 487.059 196.31 cm -[]0 d 0 J 0.398 w 0 0 m 0 120.282 l S +1 0 0 1 487.059 196.509 cm +[]0 d 0 J 0.398 w 0 0 m 0 119.884 l S Q q 1 0 0 1 157.862 196.31 cm @@ -4777,7 +4779,7 @@ endobj /ProcSet [ /PDF /Text ] >> endobj 709 0 obj << -/Length 3649 +/Length 3645 >> stream 0 g 0 G @@ -4785,22 +4787,22 @@ stream 0 g 0 G 0 g 0 G 0 g 0 G -0 g 0 G -0 g 0 G -BT -/F30 9.9626 Tf 124.012 691.672 Td [(type)-525(psb_sspmat_type)]TJ 15.691 -11.955 Td [(integer)-2625(::)-525(m,)-525(k)]TJ 0 -11.955 Td [(character)-1575(::)-525(fida\0505\051)]TJ 0 -11.956 Td [(character)-1575(::)-525(descra\05010\051)]TJ 0 -11.955 Td [(integer)-2625(::)-525(infoa\050psb_ifa_size_\051)]TJ 0 -11.955 Td [(real\050psb_spk_\051,)-525(allocatable)-525(::)-525(aspk\050:\051)]TJ 0 -11.955 Td [(integer,)-525(allocatable)-525(::)-525(ia1\050:\051,)-525(ia2\050:\051)]TJ 0 -11.955 Td [(integer,)-525(allocatable)-525(::)-525(pr\050:\051,)-525(pl\050:\051)]TJ -15.691 -11.955 Td [(end)-525(type)-525(psb_sspmat_type)]TJ 0 -23.911 Td [(type)-525(psb_dspmat_type)]TJ 15.691 -11.955 Td [(integer)-2625(::)-525(m,)-525(k)]TJ 0 -11.955 Td [(character)-1575(::)-525(fida\0505\051)]TJ 0 -11.955 Td [(character)-1575(::)-525(descra\05010\051)]TJ 0 -11.955 Td [(integer)-2625(::)-525(infoa\050psb_ifa_size_\051)]TJ 0 -11.956 Td [(real\050psb_dpk_\051,)-525(allocatable)-525(::)-525(aspk\050:\051)]TJ 0 -11.955 Td [(integer,)-525(allocatable)-525(::)-525(ia1\050:\051,)-525(ia2\050:\051)]TJ 0 -11.955 Td [(integer,)-525(allocatable)-525(::)-525(pr\050:\051,)-525(pl\050:\051)]TJ -15.691 -11.955 Td [(end)-525(type)-525(psb_dspmat_type)]TJ 0 -23.91 Td [(type)-525(psb_cspmat_type)]TJ 15.691 -11.956 Td [(integer)-2625(::)-525(m,)-525(k)]TJ 0 -11.955 Td [(character)-1575(::)-525(fida\0505\051)]TJ 0 -11.955 Td [(character)-1575(::)-525(descra\05010\051)]TJ 0 -11.955 Td [(integer)-2625(::)-525(infoa\050psb_ifa_size_\051)]TJ 0 -11.955 Td [(complex\050psb_spk_\051,)-525(allocatable)-525(::)-525(aspk\050:\051)]TJ 0 -11.956 Td [(integer,)-525(allocatable)-525(::)-525(ia1\050:\051,)-525(ia2\050:\051)]TJ 0 -11.955 Td [(integer,)-525(allocatable)-525(::)-525(pr\050:\051,)-525(pl\050:\051)]TJ -15.691 -11.955 Td [(end)-525(type)-525(psb_cspmat_type)]TJ 0 -23.91 Td [(type)-525(psb_zspmat_type)]TJ 15.691 -11.955 Td [(integer)-2625(::)-525(m,)-525(k)]TJ 0 -11.956 Td [(character)-1575(::)-525(fida\0505\051)]TJ 0 -11.955 Td [(character)-1575(::)-525(descra\05010\051)]TJ 0 -11.955 Td [(integer)-2625(::)-525(infoa\050psb_ifa_size_\051)]TJ 0 -11.955 Td [(complex\050psb_dpk_\051,)-525(allocatable)-525(::)-525(aspk\050:\051)]TJ 0 -11.955 Td [(integer,)-525(allocatable)-525(::)-525(ia1\050:\051,)-525(ia2\050:\051)]TJ 0 -11.955 Td [(integer,)-525(allocatable)-525(::)-525(pr\050:\051,)-525(pl\050:\051)]TJ -15.691 -11.956 Td [(end)-525(type)-525(psb_zspmat_type)]TJ -ET q 1 0 0 1 115.644 705.93 cm []0 d 0 J 0.398 w 0 0 m 312.215 0 l S Q q -1 0 0 1 115.843 217.251 cm -[]0 d 0 J 0.398 w 0 0 m 0 488.679 l S +1 0 0 1 115.843 217.45 cm +[]0 d 0 J 0.398 w 0 0 m 0 488.28 l S Q +0 g 0 G +0 g 0 G +BT +/F30 9.9626 Tf 124.012 691.672 Td [(type)-525(psb_sspmat_type)]TJ 15.691 -11.955 Td [(integer)-2625(::)-525(m,)-525(k)]TJ 0 -11.955 Td [(character)-1575(::)-525(fida\0505\051)]TJ 0 -11.956 Td [(character)-1575(::)-525(descra\05010\051)]TJ 0 -11.955 Td [(integer)-2625(::)-525(infoa\050psb_ifa_size_\051)]TJ 0 -11.955 Td [(real\050psb_spk_\051,)-525(allocatable)-525(::)-525(aspk\050:\051)]TJ 0 -11.955 Td [(integer,)-525(allocatable)-525(::)-525(ia1\050:\051,)-525(ia2\050:\051)]TJ 0 -11.955 Td [(integer,)-525(allocatable)-525(::)-525(pr\050:\051,)-525(pl\050:\051)]TJ -15.691 -11.955 Td [(end)-525(type)-525(psb_sspmat_type)]TJ 0 -23.911 Td [(type)-525(psb_dspmat_type)]TJ 15.691 -11.955 Td [(integer)-2625(::)-525(m,)-525(k)]TJ 0 -11.955 Td [(character)-1575(::)-525(fida\0505\051)]TJ 0 -11.955 Td [(character)-1575(::)-525(descra\05010\051)]TJ 0 -11.955 Td [(integer)-2625(::)-525(infoa\050psb_ifa_size_\051)]TJ 0 -11.956 Td [(real\050psb_dpk_\051,)-525(allocatable)-525(::)-525(aspk\050:\051)]TJ 0 -11.955 Td [(integer,)-525(allocatable)-525(::)-525(ia1\050:\051,)-525(ia2\050:\051)]TJ 0 -11.955 Td [(integer,)-525(allocatable)-525(::)-525(pr\050:\051,)-525(pl\050:\051)]TJ -15.691 -11.955 Td [(end)-525(type)-525(psb_dspmat_type)]TJ 0 -23.91 Td [(type)-525(psb_cspmat_type)]TJ 15.691 -11.956 Td [(integer)-2625(::)-525(m,)-525(k)]TJ 0 -11.955 Td [(character)-1575(::)-525(fida\0505\051)]TJ 0 -11.955 Td [(character)-1575(::)-525(descra\05010\051)]TJ 0 -11.955 Td [(integer)-2625(::)-525(infoa\050psb_ifa_size_\051)]TJ 0 -11.955 Td [(complex\050psb_spk_\051,)-525(allocatable)-525(::)-525(aspk\050:\051)]TJ 0 -11.956 Td [(integer,)-525(allocatable)-525(::)-525(ia1\050:\051,)-525(ia2\050:\051)]TJ 0 -11.955 Td [(integer,)-525(allocatable)-525(::)-525(pr\050:\051,)-525(pl\050:\051)]TJ -15.691 -11.955 Td [(end)-525(type)-525(psb_cspmat_type)]TJ 0 -23.91 Td [(type)-525(psb_zspmat_type)]TJ 15.691 -11.955 Td [(integer)-2625(::)-525(m,)-525(k)]TJ 0 -11.956 Td [(character)-1575(::)-525(fida\0505\051)]TJ 0 -11.955 Td [(character)-1575(::)-525(descra\05010\051)]TJ 0 -11.955 Td [(integer)-2625(::)-525(infoa\050psb_ifa_size_\051)]TJ 0 -11.955 Td [(complex\050psb_dpk_\051,)-525(allocatable)-525(::)-525(aspk\050:\051)]TJ 0 -11.955 Td [(integer,)-525(allocatable)-525(::)-525(ia1\050:\051,)-525(ia2\050:\051)]TJ 0 -11.955 Td [(integer,)-525(allocatable)-525(::)-525(pr\050:\051,)-525(pl\050:\051)]TJ -15.691 -11.956 Td [(end)-525(type)-525(psb_zspmat_type)]TJ +ET q -1 0 0 1 427.659 217.251 cm -[]0 d 0 J 0.398 w 0 0 m 0 488.679 l S +1 0 0 1 427.659 217.45 cm +[]0 d 0 J 0.398 w 0 0 m 0 488.28 l S Q q 1 0 0 1 115.644 217.251 cm @@ -5153,22 +5155,22 @@ stream 0 g 0 G 0 g 0 G 0 g 0 G -0 g 0 G -0 g 0 G -BT -/F46 8.9664 Tf 124.961 686.801 Td [(type)-525(psb_sprec_type)]TJ 9.414 -10.959 Td [(type\050psb_sspmat_type\051,)-525(allocatable)-525(::)-525(av\050:\051)]TJ 0 -10.958 Td [(real\050psb_spk_\051,)-525(allocatable)-4200(::)-525(d\050:\051)]TJ 0 -10.959 Td [(type\050psb_desc_type\051)-8400(::)-525(desc_data)]TJ 0 -10.959 Td [(integer,)-525(allocatable)-7875(::)-525(iprcparm\050:\051)]TJ 0 -10.959 Td [(real\050psb_spk_\051,)-525(allocatable)-4200(::)-525(rprcparm\050:\051)]TJ 0 -10.959 Td [(integer,)-525(allocatable)-7875(::)-525(perm\050:\051,)-1050(invperm\050:\051)]TJ 0 -10.959 Td [(integer)-14700(::)-525(prec,)-525(base_prec)]TJ -9.414 -10.959 Td [(end)-525(type)-525(psb_sprec_type)]TJ 0 -21.918 Td [(type)-525(psb_dprec_type)]TJ 9.414 -10.959 Td [(type\050psb_dspmat_type\051,)-525(allocatable)-525(::)-525(av\050:\051)]TJ 0 -10.958 Td [(real\050psb_dpk_\051,)-525(allocatable)-4200(::)-525(d\050:\051)]TJ 0 -10.959 Td [(type\050psb_desc_type\051)-8400(::)-525(desc_data)]TJ 0 -10.959 Td [(integer,)-525(allocatable)-7875(::)-525(iprcparm\050:\051)]TJ 0 -10.959 Td [(real\050psb_dpk_\051,)-525(allocatable)-4200(::)-525(rprcparm\050:\051)]TJ 0 -10.959 Td [(integer,)-525(allocatable)-7875(::)-525(perm\050:\051,)-1050(invperm\050:\051)]TJ 0 -10.959 Td [(integer)-14700(::)-525(prec,)-525(base_prec)]TJ -9.414 -10.959 Td [(end)-525(type)-525(psb_dprec_type)]TJ 0 -21.918 Td [(type)-525(psb_cprec_type)]TJ 9.414 -10.959 Td [(type\050psb_cspmat_type\051,)-525(allocatable)-525(::)-525(av\050:\051)]TJ 0 -10.958 Td [(complex\050psb_spk_\051,)-525(allocatable)-2625(::)-525(d\050:\051)]TJ 0 -10.959 Td [(type\050psb_desc_type\051)-8400(::)-525(desc_data)]TJ 0 -10.959 Td [(integer,)-525(allocatable)-7875(::)-525(iprcparm\050:\051)]TJ 0 -10.959 Td [(real\050psb_spk_\051,)-525(allocatable)-4200(::)-525(rprcparm\050:\051)]TJ 0 -10.959 Td [(integer,)-525(allocatable)-7875(::)-525(perm\050:\051,)-1050(invperm\050:\051)]TJ 0 -10.959 Td [(integer)-14700(::)-525(prec,)-525(base_prec)]TJ -9.414 -10.959 Td [(end)-525(type)-525(psb_cprec_type)]TJ 0 -21.918 Td [(type)-525(psb_zprec_type)]TJ 9.414 -10.959 Td [(type\050psb_zspmat_type\051,)-525(allocatable)-525(::)-525(av\050:\051)]TJ 0 -10.959 Td [(complex\050psb_dpk_\051,)-525(allocatable)-2625(::)-525(d\050:\051)]TJ 0 -10.958 Td [(type\050psb_desc_type\051)-8400(::)-525(desc_data)]TJ 0 -10.959 Td [(integer,)-525(allocatable)-7875(::)-525(iprcparm\050:\051)]TJ 0 -10.959 Td [(real\050psb_dpk_\051,)-525(allocatable)-4200(::)-525(rprcparm\050:\051)]TJ 0 -10.959 Td [(integer,)-525(allocatable)-7875(::)-525(perm\050:\051,)-1050(invperm\050:\051)]TJ 0 -10.959 Td [(integer)-14700(::)-525(prec,)-525(base_prec)]TJ -9.414 -10.959 Td [(end)-525(type)-525(psb_zprec_type)]TJ -ET q 1 0 0 1 107.177 705.93 cm []0 d 0 J 0.398 w 0 0 m 329.147 0 l S Q q -1 0 0 1 107.377 251.235 cm -[]0 d 0 J 0.398 w 0 0 m 0 454.695 l S +1 0 0 1 107.377 251.434 cm +[]0 d 0 J 0.398 w 0 0 m 0 454.296 l S Q +0 g 0 G +0 g 0 G +BT +/F46 8.9664 Tf 124.961 686.801 Td [(type)-525(psb_sprec_type)]TJ 9.414 -10.959 Td [(type\050psb_sspmat_type\051,)-525(allocatable)-525(::)-525(av\050:\051)]TJ 0 -10.958 Td [(real\050psb_spk_\051,)-525(allocatable)-4200(::)-525(d\050:\051)]TJ 0 -10.959 Td [(type\050psb_desc_type\051)-8400(::)-525(desc_data)]TJ 0 -10.959 Td [(integer,)-525(allocatable)-7875(::)-525(iprcparm\050:\051)]TJ 0 -10.959 Td [(real\050psb_spk_\051,)-525(allocatable)-4200(::)-525(rprcparm\050:\051)]TJ 0 -10.959 Td [(integer,)-525(allocatable)-7875(::)-525(perm\050:\051,)-1050(invperm\050:\051)]TJ 0 -10.959 Td [(integer)-14700(::)-525(prec,)-525(base_prec)]TJ -9.414 -10.959 Td [(end)-525(type)-525(psb_sprec_type)]TJ 0 -21.918 Td [(type)-525(psb_dprec_type)]TJ 9.414 -10.959 Td [(type\050psb_dspmat_type\051,)-525(allocatable)-525(::)-525(av\050:\051)]TJ 0 -10.958 Td [(real\050psb_dpk_\051,)-525(allocatable)-4200(::)-525(d\050:\051)]TJ 0 -10.959 Td [(type\050psb_desc_type\051)-8400(::)-525(desc_data)]TJ 0 -10.959 Td [(integer,)-525(allocatable)-7875(::)-525(iprcparm\050:\051)]TJ 0 -10.959 Td [(real\050psb_dpk_\051,)-525(allocatable)-4200(::)-525(rprcparm\050:\051)]TJ 0 -10.959 Td [(integer,)-525(allocatable)-7875(::)-525(perm\050:\051,)-1050(invperm\050:\051)]TJ 0 -10.959 Td [(integer)-14700(::)-525(prec,)-525(base_prec)]TJ -9.414 -10.959 Td [(end)-525(type)-525(psb_dprec_type)]TJ 0 -21.918 Td [(type)-525(psb_cprec_type)]TJ 9.414 -10.959 Td [(type\050psb_cspmat_type\051,)-525(allocatable)-525(::)-525(av\050:\051)]TJ 0 -10.958 Td [(complex\050psb_spk_\051,)-525(allocatable)-2625(::)-525(d\050:\051)]TJ 0 -10.959 Td [(type\050psb_desc_type\051)-8400(::)-525(desc_data)]TJ 0 -10.959 Td [(integer,)-525(allocatable)-7875(::)-525(iprcparm\050:\051)]TJ 0 -10.959 Td [(real\050psb_spk_\051,)-525(allocatable)-4200(::)-525(rprcparm\050:\051)]TJ 0 -10.959 Td [(integer,)-525(allocatable)-7875(::)-525(perm\050:\051,)-1050(invperm\050:\051)]TJ 0 -10.959 Td [(integer)-14700(::)-525(prec,)-525(base_prec)]TJ -9.414 -10.959 Td [(end)-525(type)-525(psb_cprec_type)]TJ 0 -21.918 Td [(type)-525(psb_zprec_type)]TJ 9.414 -10.959 Td [(type\050psb_zspmat_type\051,)-525(allocatable)-525(::)-525(av\050:\051)]TJ 0 -10.959 Td [(complex\050psb_dpk_\051,)-525(allocatable)-2625(::)-525(d\050:\051)]TJ 0 -10.958 Td [(type\050psb_desc_type\051)-8400(::)-525(desc_data)]TJ 0 -10.959 Td [(integer,)-525(allocatable)-7875(::)-525(iprcparm\050:\051)]TJ 0 -10.959 Td [(real\050psb_dpk_\051,)-525(allocatable)-4200(::)-525(rprcparm\050:\051)]TJ 0 -10.959 Td [(integer,)-525(allocatable)-7875(::)-525(perm\050:\051,)-1050(invperm\050:\051)]TJ 0 -10.959 Td [(integer)-14700(::)-525(prec,)-525(base_prec)]TJ -9.414 -10.959 Td [(end)-525(type)-525(psb_zprec_type)]TJ +ET q -1 0 0 1 436.125 251.235 cm -[]0 d 0 J 0.398 w 0 0 m 0 454.695 l S +1 0 0 1 436.125 251.434 cm +[]0 d 0 J 0.398 w 0 0 m 0 454.296 l S Q q 1 0 0 1 107.177 251.235 cm @@ -13982,7 +13984,7 @@ endobj /ProcSet [ /PDF /Text ] >> endobj 1228 0 obj << -/Length 2995 +/Length 5566 >> stream 0 g 0 G @@ -13998,7 +14000,7 @@ BT /F16 11.9552 Tf 124.986 706.129 Td [(init)-375(|)-375(Initializes)-375(PSBLAS)-375(parallel)-375(en)31(vironmen)31(t)]TJ 0 g 0 G 0 g 0 G -/F30 9.9626 Tf -25.091 -18.389 Td [(call)-525(psb_init\050icontxt,)-525(np\051)]TJ/F8 9.9626 Tf 14.944 -21.918 Td [(This)-294(subroutine)-294(initializes)-294(th)1(e)-294(PSBLAS)-294(parallel)-294(en)28(vironmen)28(t,)-302(de\014ning)-294(a)-294(vir-)]TJ -14.944 -11.955 Td [(tual)-333(parallel)-334(mac)28(hine.)]TJ +/F30 9.9626 Tf -25.091 -18.389 Td [(call)-525(psb_init\050icontxt,)-525(np,)-525(basectxt,)-525(ids\051)]TJ/F8 9.9626 Tf 14.944 -21.918 Td [(This)-294(subroutine)-294(initializes)-294(th)1(e)-294(PSBLAS)-294(parallel)-294(en)28(vironmen)28(t,)-302(de\014ning)-294(a)-294(vir-)]TJ -14.944 -11.955 Td [(tual)-333(parallel)-334(mac)28(hine.)]TJ 0 g 0 G /F27 9.9626 Tf 0 -19.926 Td [(T)32(yp)-32(e:)]TJ 0 g 0 G @@ -14009,24 +14011,46 @@ BT 0 g 0 G 0 -19.925 Td [(np)]TJ 0 g 0 G -/F8 9.9626 Tf 17.712 0 Td [(Num)28(b)-28(er)-333(of)-334(pr)1(o)-28(cesses)-334(in)-333(the)-333(PSBLAS)-334(virtual)-333(parallel)-333(mac)27(h)1(ine.)]TJ 7.195 -11.955 Td [(Scop)-28(e:)]TJ/F27 9.9626 Tf 32.379 0 Td [(global)]TJ/F8 9.9626 Tf 29.756 0 Td [(.)]TJ -62.135 -11.956 Td [(T)28(yp)-28(e:)]TJ/F27 9.9626 Tf 29.611 0 Td [(optional)]TJ/F8 9.9626 Tf 40.577 0 Td [(.)]TJ -70.188 -11.955 Td [(In)28(ten)28(t:)]TJ/F27 9.9626 Tf 33.486 0 Td [(in)]TJ/F8 9.9626 Tf 9.547 0 Td [(.)]TJ -43.033 -11.955 Td [(Sp)-28(eci\014ed)-393(as:)-563(an)-393(in)27(t)1(e)-1(ger)-393(v)56(alue.)-1016(Default:)-564(use)-393(all)-393(a)28(v)56(ailable)-393(pro)-28(cesses)-393(pro-)]TJ 0 -11.955 Td [(vided)-333(b)28(y)-334(the)-333(underlying)-333(parallel)-333(e)-1(n)28(vironmen)28(t.)]TJ +/F8 9.9626 Tf 17.712 0 Td [(Num)28(b)-28(er)-333(of)-334(pr)1(o)-28(cesses)-334(in)-333(the)-333(PSBLAS)-334(virtual)-333(parallel)-333(mac)27(h)1(ine.)]TJ 7.195 -11.955 Td [(Scop)-28(e:)]TJ/F27 9.9626 Tf 32.379 0 Td [(global)]TJ/F8 9.9626 Tf 29.756 0 Td [(.)]TJ -62.135 -11.956 Td [(T)28(yp)-28(e:)]TJ/F27 9.9626 Tf 29.611 0 Td [(optional)]TJ/F8 9.9626 Tf 40.577 0 Td [(.)]TJ -70.188 -11.955 Td [(In)28(ten)28(t:)]TJ/F27 9.9626 Tf 33.486 0 Td [(in)]TJ/F8 9.9626 Tf 9.547 0 Td [(.)]TJ -43.033 -11.955 Td [(Sp)-28(eci\014ed)-333(as:)-445(an)-333(in)28(teger)-333(v)55(alue.)-778(Default)1(:)-445(use)-333(all)-334(a)28(v)56(ailable)-334(p)1(ro)-28(cesses)-1(.)]TJ 0 g 0 G -/F27 9.9626 Tf -24.907 -21.918 Td [(On)-383(Return)]TJ +/F27 9.9626 Tf -24.907 -19.925 Td [(basectxt)]TJ +0 g 0 G +/F8 9.9626 Tf 46.736 0 Td [(the)-356(initial)-357(comm)28(unication)-356(con)28(text.)-514(The)-356(new)-357(con)28(text)-356(will)-357(b)-27(e)-357(de\014ned)]TJ -21.829 -11.955 Td [(from)-333(the)-334(pro)-27(cess)-1(es)-333(participating)-333(in)-333(the)-334(initial)-333(one.)]TJ 0 -11.956 Td [(Scop)-28(e:)]TJ/F27 9.9626 Tf 32.379 0 Td [(global)]TJ/F8 9.9626 Tf 29.756 0 Td [(.)]TJ -62.135 -11.955 Td [(T)28(yp)-28(e:)]TJ/F27 9.9626 Tf 29.611 0 Td [(optional)]TJ/F8 9.9626 Tf 40.577 0 Td [(.)]TJ -70.188 -11.955 Td [(In)28(ten)28(t:)]TJ/F27 9.9626 Tf 33.486 0 Td [(in)]TJ/F8 9.9626 Tf 9.547 0 Td [(.)]TJ -43.033 -11.955 Td [(Sp)-28(eci\014ed)-333(as:)-445(an)-333(in)28(teger)-333(v)55(alue.)-778(Default)1(:)-445(use)-333(MPI)]TJ +ET +q +1 0 0 1 339.182 466.768 cm +[]0 d 0 J 0.398 w 0 0 m 2.989 0 l S +Q +BT +/F8 9.9626 Tf 342.171 466.569 Td [(COMM)]TJ +ET +q +1 0 0 1 375.977 466.768 cm +[]0 d 0 J 0.398 w 0 0 m 2.989 0 l S +Q +BT +/F8 9.9626 Tf 378.966 466.569 Td [(W)28(ORLD.)]TJ +0 g 0 G +/F27 9.9626 Tf -279.071 -19.925 Td [(ids)]TJ +0 g 0 G +/F8 9.9626 Tf 19.048 0 Td [(Iden)28(tities)-497(of)-497(the)-497(pro)-28(cesses)-497(to)-497(use)-497(for)-497(the)-498(n)1(e)-1(w)-497(con)28(text;)-579(the)-497(argumen)28(t)-497(is)]TJ 5.859 -11.956 Td [(ignored)-428(when)]TJ/F30 9.9626 Tf 63.346 0 Td [(np)]TJ/F8 9.9626 Tf 14.722 0 Td [(is)-428(not)-428(sp)-27(eci\014ed.)-728(This)-428(allo)28(ws)-428(the)-428(pro)-27(ce)-1(sses)-427(in)-428(the)-428(new)]TJ -78.068 -11.955 Td [(en)28(vironmen)28(t)-334(to)-333(b)-28(e)-333(in)-333(an)-334(order)-333(di\013eren)28(t)-334(fr)1(om)-334(the)-333(original)-333(one.)]TJ 0 -11.955 Td [(Scop)-28(e:)]TJ/F27 9.9626 Tf 32.379 0 Td [(global)]TJ/F8 9.9626 Tf 29.756 0 Td [(.)]TJ -62.135 -11.955 Td [(T)28(yp)-28(e:)]TJ/F27 9.9626 Tf 29.611 0 Td [(optional)]TJ/F8 9.9626 Tf 40.577 0 Td [(.)]TJ -70.188 -11.955 Td [(In)28(ten)28(t:)]TJ/F27 9.9626 Tf 33.486 0 Td [(in)]TJ/F8 9.9626 Tf 9.547 0 Td [(.)]TJ -43.033 -11.955 Td [(Sp)-28(eci\014ed)-333(as:)-445(an)-333(in)28(teger)-333(arra)27(y)84(.)-778(Default:)-444(use)-334(the)-333(indices)-333(\0500)]TJ/F11 9.9626 Tf 254.158 0 Td [(:)-167(:)-166(:)-167(np)]TJ/F14 9.9626 Tf 26.49 0 Td [(\000)]TJ/F8 9.9626 Tf 9.963 0 Td [(1\051.)]TJ +0 g 0 G +/F27 9.9626 Tf -315.518 -21.918 Td [(On)-383(Return)]TJ 0 g 0 G 0 g 0 G 0 -19.925 Td [(icon)32(txt)]TJ 0 g 0 G -/F8 9.9626 Tf 39.989 0 Td [(the)-333(comm)27(unication)-333(con)28(text)-333(iden)27(tifyin)1(g)-334(the)-333(virtual)-333(parallel)-334(mac)28(hine.)]TJ -15.082 -11.955 Td [(Scop)-28(e:)]TJ/F27 9.9626 Tf 32.379 0 Td [(global)]TJ/F8 9.9626 Tf 29.756 0 Td [(.)]TJ -62.135 -11.956 Td [(T)28(yp)-28(e:)]TJ/F27 9.9626 Tf 29.611 0 Td [(required)]TJ/F8 9.9626 Tf 41.898 0 Td [(.)]TJ -71.509 -11.955 Td [(In)28(ten)28(t:)]TJ/F27 9.9626 Tf 33.486 0 Td [(out)]TJ/F8 9.9626 Tf 16.549 0 Td [(.)]TJ -50.035 -11.955 Td [(Sp)-28(eci\014ed)-333(as:)-445(an)-333(in)28(teger)-333(v)55(ariable.)]TJ/F16 11.9552 Tf -24.907 -21.918 Td [(Notes)]TJ +/F8 9.9626 Tf 39.989 0 Td [(the)-458(comm)28(unication)-457(con)27(text)-457(iden)28(tifying)-458(the)-457(virtual)-458(paral)1(le)-1(l)-457(mac)28(hine.)]TJ -15.082 -11.956 Td [(Note)-335(that)-335(this)-335(is)-336(alw)28(a)28(ys)-335(a)-335(duplicate)-335(of)]TJ/F30 9.9626 Tf 169.952 0 Td [(basectxt)]TJ/F8 9.9626 Tf 41.843 0 Td [(,)-336(so)-335(that)-335(library)-335(comm)28(u-)]TJ -211.795 -11.955 Td [(nications)-305(are)-305(completely)-305(s)-1(eparated)-305(from)-305(other)-305(comm)28(unication)-305(op)-28(erations.)]TJ 0 -11.955 Td [(Scop)-28(e:)]TJ/F27 9.9626 Tf 32.379 0 Td [(global)]TJ/F8 9.9626 Tf 29.756 0 Td [(.)]TJ -62.135 -11.955 Td [(T)28(yp)-28(e:)]TJ/F27 9.9626 Tf 29.611 0 Td [(required)]TJ/F8 9.9626 Tf 41.898 0 Td [(.)]TJ -71.509 -11.955 Td [(In)28(ten)28(t:)]TJ/F27 9.9626 Tf 33.486 0 Td [(out)]TJ/F8 9.9626 Tf 16.549 0 Td [(.)]TJ -50.035 -11.956 Td [(Sp)-28(eci\014ed)-333(as:)-445(an)-333(in)28(teger)-333(v)55(ariable.)]TJ/F16 11.9552 Tf -24.907 -21.917 Td [(Notes)]TJ 0 g 0 G -/F8 9.9626 Tf 12.177 -19.925 Td [(1.)]TJ +/F8 9.9626 Tf 12.177 -19.926 Td [(1.)]TJ 0 g 0 G [-500(A)-333(call)-334(to)-333(this)-333(routine)-334(m)28(ust)-333(precede)-334(an)28(y)-333(other)-333(PSBLAS)-334(call.)]TJ 0 g 0 G 0 -19.925 Td [(2.)]TJ 0 g 0 G - [-500(It)-262(is)-262(an)-262(error)-262(to)-262(sp)-28(ecify)-262(a)-262(v)56(alue)-262(for)]TJ/F11 9.9626 Tf 159.869 0 Td [(np)]TJ/F8 9.9626 Tf 13.603 0 Td [(greater)-262(than)-262(the)-262(n)28(um)28(b)-28(er)-262(of)-262(pro)-28(cesses)]TJ -160.742 -11.955 Td [(a)28(v)55(ailable)-333(in)-333(the)-334(un)1(derlying)-334(parallel)-333(execution)-333(en)27(v)1(ironmen)27(t.)]TJ + [-500(It)-262(is)-262(an)-262(error)-262(to)-262(sp)-28(ecify)-262(a)-262(v)56(alue)-262(for)]TJ/F11 9.9626 Tf 159.869 0 Td [(np)]TJ/F8 9.9626 Tf 13.603 0 Td [(greater)-262(than)-262(the)-262(n)28(um)28(b)-28(er)-262(of)-262(pro)-28(cesses)]TJ -160.742 -11.955 Td [(a)28(v)55(ailable)-333(in)-333(the)-334(un)1(derlying)-334(base)-333(parallel)-333(en)27(vir)1(onme)-1(n)28(t.)]TJ 0 g 0 G - 141.968 -280.49 Td [(89)]TJ + 141.968 -97.177 Td [(89)]TJ 0 g 0 G ET endstream @@ -14045,13 +14069,13 @@ endobj /D [1227 0 R /XYZ 99.895 697.37 null] >> endobj 1230 0 obj << -/D [1227 0 R /XYZ 99.895 418.748 null] +/D [1227 0 R /XYZ 99.895 235.436 null] >> endobj 1231 0 obj << -/D [1227 0 R /XYZ 99.895 396.886 null] +/D [1227 0 R /XYZ 99.895 213.573 null] >> endobj 1226 0 obj << -/Font << /F16 431 0 R /F30 601 0 R /F8 434 0 R /F27 433 0 R /F11 587 0 R >> +/Font << /F16 431 0 R /F30 601 0 R /F8 434 0 R /F27 433 0 R /F11 587 0 R /F14 604 0 R >> /ProcSet [ /PDF /Text ] >> endobj 1234 0 obj << @@ -15176,7 +15200,7 @@ endobj /ProcSet [ /PDF /Text ] >> endobj 1322 0 obj << -/Length 3835 +/Length 3841 >> stream 0 g 0 G @@ -15184,22 +15208,22 @@ stream 0 g 0 G 0 g 0 G 0 g 0 G -0 g 0 G -0 g 0 G -BT -/F46 8.9664 Tf 159.073 690.537 Td [(subroutine)-525(psb_foo\050some)-525(args,)-525(info\051)]TJ 14.122 -10.959 Td [(...)]TJ 0 -10.958 Td [(if\050error)-525(detected\051)-525(then)]TJ 14.122 -10.959 Td [(info=errcode1)]TJ 0 -10.959 Td [(call)-525(psb_errpush\050'psb_foo',)-525(errcode1\051)]TJ 0 -10.959 Td [(goto)-525(9999)]TJ -14.122 -10.959 Td [(end)-525(if)]TJ 0 -10.959 Td [(...)]TJ 0 -10.959 Td [(call)-525(psb_bar\050some)-525(args,)-525(info\051)]TJ 0 -10.959 Td [(if\050info)-525(.ne.)-525(zero\051)-525(then)]TJ 14.122 -10.959 Td [(info=errcode2)]TJ 0 -10.959 Td [(call)-525(psb_errpush\050'psb_foo',)-525(errcode2\051)]TJ 0 -10.958 Td [(goto)-525(9999)]TJ -14.122 -10.959 Td [(end)-525(if)]TJ 0 -10.959 Td [(...)]TJ -14.122 -10.959 Td [(9999)-525(continue)]TJ 14.122 -10.959 Td [(if)-525(\050err_act)-525(.eq.)-525(act_abort\051)-525(then)]TJ 9.415 -10.959 Td [(call)-525(psb_error\050icontxt\051)]TJ 0 -10.959 Td [(return)]TJ -9.415 -10.959 Td [(else)]TJ 9.415 -10.959 Td [(return)]TJ -9.415 -10.959 Td [(end)-525(if)]TJ -14.122 -21.917 Td [(end)-525(subroutine)-525(psb_foo)]TJ -ET q 1 0 0 1 150.705 704.933 cm []0 d 0 J 0.398 w 0 0 m 346.583 0 l S Q q -1 0 0 1 150.904 428.321 cm -[]0 d 0 J 0.398 w 0 0 m 0 276.613 l S +1 0 0 1 150.904 428.52 cm +[]0 d 0 J 0.398 w 0 0 m 0 276.214 l S Q +0 g 0 G +0 g 0 G +BT +/F46 8.9664 Tf 159.073 690.537 Td [(subroutine)-525(psb_foo\050some)-525(args,)-525(info\051)]TJ 14.122 -10.959 Td [(...)]TJ 0 -10.958 Td [(if\050error)-525(detected\051)-525(then)]TJ 14.122 -10.959 Td [(info=errcode1)]TJ 0 -10.959 Td [(call)-525(psb_errpush\050'psb_foo',)-525(errcode1\051)]TJ 0 -10.959 Td [(goto)-525(9999)]TJ -14.122 -10.959 Td [(end)-525(if)]TJ 0 -10.959 Td [(...)]TJ 0 -10.959 Td [(call)-525(psb_bar\050some)-525(args,)-525(info\051)]TJ 0 -10.959 Td [(if\050info)-525(.ne.)-525(zero\051)-525(then)]TJ 14.122 -10.959 Td [(info=errcode2)]TJ 0 -10.959 Td [(call)-525(psb_errpush\050'psb_foo',)-525(errcode2\051)]TJ 0 -10.958 Td [(goto)-525(9999)]TJ -14.122 -10.959 Td [(end)-525(if)]TJ 0 -10.959 Td [(...)]TJ -14.122 -10.959 Td [(9999)-525(continue)]TJ 14.122 -10.959 Td [(if)-525(\050err_act)-525(.eq.)-525(act_abort\051)-525(then)]TJ 9.415 -10.959 Td [(call)-525(psb_error\050icontxt\051)]TJ 0 -10.959 Td [(return)]TJ -9.415 -10.959 Td [(else)]TJ 9.415 -10.959 Td [(return)]TJ -9.415 -10.959 Td [(end)-525(if)]TJ -14.122 -21.917 Td [(end)-525(subroutine)-525(psb_foo)]TJ +ET q -1 0 0 1 497.088 428.321 cm -[]0 d 0 J 0.398 w 0 0 m 0 276.613 l S +1 0 0 1 497.088 428.52 cm +[]0 d 0 J 0.398 w 0 0 m 0 276.214 l S Q q 1 0 0 1 150.705 428.321 cm @@ -15218,21 +15242,23 @@ BT 0 g 0 G 0 g 0 G 0 g 0 G -0 g 0 G -0 g 0 G -/F30 9.9626 Tf 8.368 -35.368 Td [(==========================================================)]TJ 0 -11.955 Td [(Process:)-525(0.)-1050(PSBLAS)-525(Error)-525(\0504010\051)-525(in)-525(subroutine:)-525(df_sample)]TJ 0 -11.955 Td [(Error)-525(from)-525(call)-525(to)-525(subroutine)-525(mat)-525(dist)]TJ 0 -11.955 Td [(==========================================================)]TJ 0 -11.956 Td [(Process:)-525(0.)-1050(PSBLAS)-525(Error)-525(\0504010\051)-525(in)-525(subroutine:)-525(mat_distv)]TJ 0 -11.955 Td [(Error)-525(from)-525(call)-525(to)-525(subroutine)-525(psb_spasb)]TJ 0 -11.955 Td [(==========================================================)]TJ 0 -11.955 Td [(Process:)-525(0.)-1050(PSBLAS)-525(Error)-525(\0504010\051)-525(in)-525(subroutine:)-525(psb_spasb)]TJ 0 -11.955 Td [(Error)-525(from)-525(call)-525(to)-525(subroutine)-525(psb_cest)]TJ 0 -11.955 Td [(==========================================================)]TJ 0 -11.956 Td [(Process:)-525(0.)-1050(PSBLAS)-525(Error)-525(\050136\051)-525(in)-525(subroutine:)-525(psb_cest)]TJ 0 -11.955 Td [(Format)-525(FOO)-525(is)-525(unknown)]TJ 0 -11.955 Td [(==========================================================)]TJ 0 -11.955 Td [(Aborting...)]TJ ET q 1 0 0 1 150.705 365.268 cm []0 d 0 J 0.398 w 0 0 m 346.583 0 l S Q q -1 0 0 1 150.904 187.158 cm -[]0 d 0 J 0.398 w 0 0 m 0 178.111 l S +1 0 0 1 150.904 187.357 cm +[]0 d 0 J 0.398 w 0 0 m 0 177.712 l S Q +0 g 0 G +0 g 0 G +BT +/F30 9.9626 Tf 159.073 352.958 Td [(==========================================================)]TJ 0 -11.955 Td [(Process:)-525(0.)-1050(PSBLAS)-525(Error)-525(\0504010\051)-525(in)-525(subroutine:)-525(df_sample)]TJ 0 -11.955 Td [(Error)-525(from)-525(call)-525(to)-525(subroutine)-525(mat)-525(dist)]TJ 0 -11.955 Td [(==========================================================)]TJ 0 -11.956 Td [(Process:)-525(0.)-1050(PSBLAS)-525(Error)-525(\0504010\051)-525(in)-525(subroutine:)-525(mat_distv)]TJ 0 -11.955 Td [(Error)-525(from)-525(call)-525(to)-525(subroutine)-525(psb_spasb)]TJ 0 -11.955 Td [(==========================================================)]TJ 0 -11.955 Td [(Process:)-525(0.)-1050(PSBLAS)-525(Error)-525(\0504010\051)-525(in)-525(subroutine:)-525(psb_spasb)]TJ 0 -11.955 Td [(Error)-525(from)-525(call)-525(to)-525(subroutine)-525(psb_cest)]TJ 0 -11.955 Td [(==========================================================)]TJ 0 -11.956 Td [(Process:)-525(0.)-1050(PSBLAS)-525(Error)-525(\050136\051)-525(in)-525(subroutine:)-525(psb_cest)]TJ 0 -11.955 Td [(Format)-525(FOO)-525(is)-525(unknown)]TJ 0 -11.955 Td [(==========================================================)]TJ 0 -11.955 Td [(Aborting...)]TJ +ET q -1 0 0 1 497.088 187.158 cm -[]0 d 0 J 0.398 w 0 0 m 0 178.111 l S +1 0 0 1 497.088 187.357 cm +[]0 d 0 J 0.398 w 0 0 m 0 177.712 l S Q q 1 0 0 1 150.705 187.158 cm @@ -20297,9 +20323,9 @@ endobj /OpenAction 425 0 R >> endobj 1576 0 obj << - /Title (Parallel Sparse BLAS V. 2.3.1) /Subject (Parallel Sparse Basic Linear Algebra Subroutines) /Keywords (Computer Science Linear Algebra Fluid Dynamics Parallel Linux MPI PSBLAS Iterative Solvers Preconditioners) /Creator (pdfLaTeX) /Producer ($Id: userguide.tex 3407 2008-09-18 11:11:42Z sfilippo $) /Author()/Title()/Subject()/Creator(LaTeX with hyperref package)/Producer(pdfTeX-1.40.3)/Keywords() -/CreationDate (D:20080919140514+02'00') -/ModDate (D:20080919140514+02'00') + /Title (Parallel Sparse BLAS V. 3.0-beta) /Subject (Parallel Sparse Basic Linear Algebra Subroutines) /Keywords (Computer Science Linear Algebra Fluid Dynamics Parallel Linux MPI PSBLAS Iterative Solvers Preconditioners) /Creator (pdfLaTeX) /Producer ($Id: userguide.tex 3417 2008-09-19 16:06:44Z sfilippo $) /Author()/Title()/Subject()/Creator(LaTeX with hyperref package)/Producer(pdfTeX-1.40.3)/Keywords() +/CreationDate (D:20100513140809+02'00') +/ModDate (D:20100513140809+02'00') /Trapped /False /PTEX.Fullbanner (This is pdfTeX using libpoppler, Version 3.141592-1.40.3-2.2 (Web2C 7.5.6) kpathsea version 3.5.6) >> endobj @@ -20311,1582 +20337,1582 @@ xref 0000000004 00000 f 0000000000 00000 f 0000000015 00000 n -0000010123 00000 n -0000897052 00000 n +0000010142 00000 n +0000899664 00000 n 0000000058 00000 n -0000000102 00000 n -0000084054 00000 n -0000896980 00000 n -0000000147 00000 n -0000000180 00000 n -0000091987 00000 n -0000896857 00000 n -0000000226 00000 n -0000000263 00000 n -0000102217 00000 n -0000896783 00000 n -0000000314 00000 n -0000000355 00000 n -0000110464 00000 n -0000896696 00000 n -0000000406 00000 n -0000000445 00000 n -0000117716 00000 n -0000896609 00000 n -0000000496 00000 n -0000000540 00000 n -0000135962 00000 n -0000896535 00000 n -0000000591 00000 n -0000000631 00000 n -0000146704 00000 n -0000896411 00000 n -0000000677 00000 n -0000000713 00000 n -0000146764 00000 n -0000896300 00000 n -0000000764 00000 n -0000000812 00000 n -0000163159 00000 n -0000896239 00000 n -0000000868 00000 n -0000000908 00000 n -0000163219 00000 n -0000896115 00000 n -0000000959 00000 n -0000001010 00000 n -0000186913 00000 n -0000896054 00000 n -0000001066 00000 n -0000001106 00000 n -0000186974 00000 n -0000895967 00000 n -0000001157 00000 n -0000001209 00000 n -0000187096 00000 n -0000895855 00000 n -0000001260 00000 n -0000001312 00000 n -0000187157 00000 n -0000895781 00000 n -0000001359 00000 n -0000001412 00000 n -0000191838 00000 n -0000895694 00000 n -0000001459 00000 n -0000001512 00000 n -0000199101 00000 n -0000895607 00000 n -0000001559 00000 n -0000001613 00000 n -0000199162 00000 n -0000895520 00000 n -0000001660 00000 n -0000001714 00000 n -0000204772 00000 n -0000895433 00000 n -0000001761 00000 n -0000001807 00000 n -0000204832 00000 n -0000895346 00000 n -0000001854 00000 n -0000001911 00000 n -0000204892 00000 n -0000895259 00000 n -0000001958 00000 n -0000002015 00000 n -0000211793 00000 n -0000895172 00000 n -0000002062 00000 n -0000002107 00000 n -0000211854 00000 n -0000895085 00000 n -0000002155 00000 n -0000002199 00000 n -0000211915 00000 n -0000895010 00000 n -0000002247 00000 n -0000002294 00000 n -0000213486 00000 n -0000894880 00000 n -0000002341 00000 n -0000002385 00000 n -0000221640 00000 n -0000894801 00000 n -0000002434 00000 n -0000002468 00000 n -0000231692 00000 n -0000894708 00000 n -0000002517 00000 n -0000002549 00000 n -0000241267 00000 n -0000894615 00000 n -0000002598 00000 n -0000002631 00000 n -0000249582 00000 n -0000894522 00000 n -0000002680 00000 n -0000002713 00000 n -0000256231 00000 n -0000894429 00000 n -0000002762 00000 n -0000002796 00000 n -0000263244 00000 n -0000894336 00000 n -0000002845 00000 n -0000002878 00000 n -0000270955 00000 n -0000894243 00000 n -0000002927 00000 n -0000002961 00000 n -0000279016 00000 n -0000894150 00000 n -0000003010 00000 n -0000003043 00000 n -0000286954 00000 n -0000894057 00000 n -0000003092 00000 n -0000003126 00000 n -0000293268 00000 n -0000893964 00000 n -0000003175 00000 n -0000003208 00000 n -0000301791 00000 n -0000893871 00000 n -0000003257 00000 n -0000003288 00000 n -0000319025 00000 n -0000893792 00000 n -0000003337 00000 n -0000003368 00000 n -0000333681 00000 n -0000893662 00000 n -0000003415 00000 n -0000003459 00000 n -0000340577 00000 n -0000893583 00000 n -0000003508 00000 n -0000003539 00000 n -0000360899 00000 n -0000893490 00000 n -0000003588 00000 n -0000003619 00000 n -0000385241 00000 n -0000893397 00000 n -0000003668 00000 n -0000003701 00000 n -0000394824 00000 n -0000893318 00000 n -0000003750 00000 n -0000003784 00000 n -0000403757 00000 n -0000893187 00000 n -0000003831 00000 n -0000003877 00000 n -0000403819 00000 n -0000893108 00000 n -0000003926 00000 n -0000003958 00000 n -0000426957 00000 n -0000893015 00000 n -0000004007 00000 n -0000004039 00000 n -0000431337 00000 n -0000892922 00000 n -0000004088 00000 n -0000004120 00000 n -0000435430 00000 n -0000892829 00000 n -0000004169 00000 n -0000004201 00000 n -0000438263 00000 n -0000892736 00000 n -0000004250 00000 n -0000004283 00000 n -0000444939 00000 n -0000892643 00000 n -0000004332 00000 n -0000004367 00000 n -0000452646 00000 n -0000892550 00000 n -0000004416 00000 n -0000004448 00000 n -0000460460 00000 n -0000892457 00000 n -0000004497 00000 n -0000004529 00000 n -0000470958 00000 n -0000892364 00000 n -0000004578 00000 n -0000004610 00000 n -0000476948 00000 n -0000892271 00000 n -0000004659 00000 n -0000004692 00000 n -0000481689 00000 n -0000892178 00000 n -0000004741 00000 n -0000004772 00000 n -0000486946 00000 n -0000892085 00000 n -0000004821 00000 n -0000004853 00000 n -0000493711 00000 n -0000891992 00000 n -0000004902 00000 n -0000004934 00000 n -0000498209 00000 n -0000891899 00000 n -0000004983 00000 n -0000005015 00000 n -0000501680 00000 n -0000891806 00000 n -0000005064 00000 n -0000005097 00000 n -0000505536 00000 n -0000891713 00000 n -0000005146 00000 n -0000005177 00000 n -0000512699 00000 n -0000891620 00000 n -0000005226 00000 n -0000005270 00000 n -0000520189 00000 n -0000891527 00000 n -0000005319 00000 n -0000005363 00000 n -0000524058 00000 n -0000891434 00000 n -0000005412 00000 n -0000005450 00000 n -0000529701 00000 n -0000891341 00000 n -0000005499 00000 n -0000005540 00000 n -0000533603 00000 n -0000891248 00000 n -0000005589 00000 n -0000005627 00000 n -0000539255 00000 n -0000891155 00000 n -0000005676 00000 n -0000005717 00000 n -0000543744 00000 n -0000891062 00000 n -0000005766 00000 n -0000005808 00000 n -0000548114 00000 n -0000890969 00000 n -0000005857 00000 n -0000005898 00000 n -0000554614 00000 n -0000890876 00000 n -0000005947 00000 n -0000005986 00000 n -0000563933 00000 n -0000890783 00000 n -0000006035 00000 n -0000006068 00000 n -0000570131 00000 n -0000890704 00000 n -0000006117 00000 n -0000006154 00000 n -0000578712 00000 n -0000890573 00000 n -0000006201 00000 n -0000006252 00000 n -0000582101 00000 n -0000890494 00000 n -0000006301 00000 n -0000006332 00000 n -0000587297 00000 n -0000890401 00000 n -0000006381 00000 n -0000006412 00000 n -0000592225 00000 n -0000890308 00000 n -0000006461 00000 n -0000006492 00000 n -0000595018 00000 n -0000890215 00000 n -0000006541 00000 n -0000006582 00000 n -0000598456 00000 n -0000890122 00000 n -0000006631 00000 n -0000006669 00000 n -0000600102 00000 n -0000890029 00000 n -0000006718 00000 n -0000006750 00000 n -0000602004 00000 n -0000889936 00000 n -0000006799 00000 n -0000006833 00000 n -0000603779 00000 n -0000889843 00000 n -0000006882 00000 n -0000006914 00000 n -0000608749 00000 n -0000889750 00000 n -0000006963 00000 n -0000006995 00000 n -0000614393 00000 n -0000889657 00000 n -0000007044 00000 n -0000007074 00000 n -0000620117 00000 n -0000889564 00000 n -0000007123 00000 n -0000007153 00000 n -0000625871 00000 n -0000889471 00000 n -0000007202 00000 n -0000007232 00000 n -0000631683 00000 n -0000889378 00000 n -0000007281 00000 n -0000007311 00000 n -0000637527 00000 n -0000889285 00000 n -0000007360 00000 n -0000007390 00000 n -0000643446 00000 n -0000889192 00000 n -0000007439 00000 n -0000007469 00000 n -0000649317 00000 n -0000889113 00000 n -0000007518 00000 n -0000007548 00000 n -0000656543 00000 n -0000888983 00000 n -0000007595 00000 n -0000007631 00000 n -0000664214 00000 n -0000888904 00000 n -0000007680 00000 n -0000007714 00000 n -0000665781 00000 n -0000888811 00000 n -0000007763 00000 n -0000007795 00000 n -0000667448 00000 n -0000888718 00000 n -0000007844 00000 n -0000007890 00000 n -0000669582 00000 n -0000888639 00000 n -0000007939 00000 n -0000007982 00000 n -0000670527 00000 n -0000888509 00000 n -0000008029 00000 n -0000008060 00000 n -0000675533 00000 n -0000888405 00000 n -0000008109 00000 n -0000008139 00000 n -0000681001 00000 n -0000888326 00000 n -0000008188 00000 n -0000008219 00000 n -0000684819 00000 n -0000888233 00000 n -0000008268 00000 n -0000008305 00000 n -0000688500 00000 n -0000888140 00000 n -0000008354 00000 n -0000008392 00000 n -0000692811 00000 n -0000888061 00000 n -0000008441 00000 n -0000008479 00000 n -0000694141 00000 n -0000887931 00000 n -0000008527 00000 n -0000008573 00000 n -0000699552 00000 n -0000887852 00000 n -0000008622 00000 n -0000008657 00000 n -0000705459 00000 n -0000887759 00000 n -0000008706 00000 n -0000008740 00000 n -0000711207 00000 n -0000887666 00000 n -0000008789 00000 n -0000008824 00000 n -0000713802 00000 n -0000887587 00000 n -0000008873 00000 n -0000008909 00000 n -0000714830 00000 n -0000887471 00000 n -0000008957 00000 n -0000008997 00000 n -0000722795 00000 n -0000887406 00000 n -0000009046 00000 n -0000009072 00000 n -0000009882 00000 n -0000010182 00000 n -0000009124 00000 n -0000010001 00000 n -0000010062 00000 n -0000881813 00000 n -0000883549 00000 n -0000881667 00000 n -0000882396 00000 n -0000883986 00000 n -0000010609 00000 n -0000010428 00000 n -0000010292 00000 n -0000010547 00000 n -0000028837 00000 n -0000028988 00000 n -0000029139 00000 n -0000029296 00000 n -0000029453 00000 n -0000029610 00000 n -0000029767 00000 n -0000029917 00000 n -0000030074 00000 n -0000030236 00000 n -0000030393 00000 n -0000030555 00000 n -0000030712 00000 n -0000030869 00000 n -0000031022 00000 n -0000031175 00000 n -0000031328 00000 n -0000031481 00000 n -0000031633 00000 n -0000031786 00000 n -0000031939 00000 n -0000032092 00000 n -0000032246 00000 n -0000032400 00000 n -0000032551 00000 n -0000032705 00000 n -0000032859 00000 n -0000033013 00000 n -0000033167 00000 n -0000033321 00000 n -0000033474 00000 n -0000033628 00000 n -0000033782 00000 n -0000033936 00000 n -0000034090 00000 n -0000034243 00000 n -0000034397 00000 n -0000034548 00000 n -0000034702 00000 n -0000034855 00000 n -0000035009 00000 n -0000056853 00000 n -0000057004 00000 n -0000057157 00000 n -0000035284 00000 n -0000028378 00000 n -0000010680 00000 n -0000035162 00000 n -0000035223 00000 n -0000057311 00000 n -0000057465 00000 n -0000057619 00000 n -0000057773 00000 n -0000057927 00000 n -0000058081 00000 n -0000058235 00000 n -0000058388 00000 n -0000058541 00000 n -0000058695 00000 n -0000058849 00000 n -0000059002 00000 n -0000059155 00000 n -0000059308 00000 n -0000059462 00000 n -0000059616 00000 n -0000059770 00000 n -0000059924 00000 n -0000060078 00000 n -0000060232 00000 n -0000060386 00000 n -0000060539 00000 n -0000060691 00000 n -0000060845 00000 n -0000060999 00000 n -0000061153 00000 n -0000061305 00000 n -0000061459 00000 n -0000061613 00000 n -0000061767 00000 n -0000061921 00000 n -0000062075 00000 n -0000062229 00000 n -0000062383 00000 n -0000062537 00000 n -0000062691 00000 n -0000062845 00000 n -0000062999 00000 n -0000063153 00000 n -0000063307 00000 n -0000063461 00000 n -0000063614 00000 n -0000071365 00000 n -0000071516 00000 n -0000071669 00000 n -0000071823 00000 n -0000063829 00000 n -0000056362 00000 n -0000035381 00000 n -0000063767 00000 n -0000071976 00000 n -0000072130 00000 n -0000072281 00000 n -0000072434 00000 n -0000072588 00000 n -0000072741 00000 n -0000072895 00000 n -0000073049 00000 n -0000073199 00000 n -0000073353 00000 n -0000073507 00000 n -0000073661 00000 n -0000073815 00000 n -0000073966 00000 n -0000074180 00000 n -0000071090 00000 n -0000063913 00000 n -0000074119 00000 n -0000074583 00000 n -0000074402 00000 n -0000074264 00000 n -0000074521 00000 n -0000082980 00000 n -0000083135 00000 n -0000083291 00000 n -0000083445 00000 n -0000083600 00000 n -0000083750 00000 n -0000083902 00000 n -0000091531 00000 n -0000091682 00000 n -0000084114 00000 n -0000082793 00000 n -0000074654 00000 n -0000883403 00000 n -0000884104 00000 n -0000742275 00000 n -0000742212 00000 n -0000740076 00000 n -0000740138 00000 n -0000740388 00000 n -0000739891 00000 n -0000739953 00000 n -0000091835 00000 n -0000089871 00000 n -0000092110 00000 n -0000089716 00000 n -0000084211 00000 n -0000881959 00000 n -0000092048 00000 n -0000091269 00000 n -0000091388 00000 n -0000091435 00000 n -0000091509 00000 n -0000740014 00000 n -0000101696 00000 n -0000101849 00000 n -0000102003 00000 n -0000102401 00000 n -0000101541 00000 n -0000092235 00000 n -0000102156 00000 n -0000883695 00000 n -0000882684 00000 n -0000882251 00000 n -0000883115 00000 n -0000882541 00000 n -0000102277 00000 n -0000882827 00000 n -0000102339 00000 n -0000740326 00000 n -0000110034 00000 n -0000110187 00000 n -0000108063 00000 n -0000110525 00000 n -0000107916 00000 n -0000102601 00000 n -0000110340 00000 n -0000110402 00000 n -0000109772 00000 n -0000109891 00000 n -0000109938 00000 n -0000110012 00000 n -0000739829 00000 n -0000739768 00000 n -0000117351 00000 n -0000117503 00000 n -0000117775 00000 n -0000117204 00000 n -0000110689 00000 n -0000117655 00000 n -0000127302 00000 n -0000126503 00000 n -0000117911 00000 n -0000126622 00000 n -0000882105 00000 n -0000126684 00000 n -0000126744 00000 n -0000126806 00000 n -0000126868 00000 n -0000126930 00000 n -0000126992 00000 n -0000127054 00000 n -0000127116 00000 n -0000127178 00000 n -0000127240 00000 n -0000138046 00000 n -0000136022 00000 n -0000135112 00000 n -0000127424 00000 n -0000135231 00000 n -0000135292 00000 n -0000135353 00000 n -0000135414 00000 n -0000135475 00000 n -0000135536 00000 n -0000135597 00000 n -0000135658 00000 n -0000135718 00000 n -0000135779 00000 n -0000135840 00000 n -0000135901 00000 n -0000884222 00000 n -0000138265 00000 n -0000137907 00000 n -0000136132 00000 n -0000138203 00000 n -0000146335 00000 n -0000146486 00000 n -0000147191 00000 n -0000146188 00000 n -0000138349 00000 n -0000146643 00000 n -0000146824 00000 n -0000146886 00000 n -0000146947 00000 n -0000147008 00000 n -0000147069 00000 n -0000147130 00000 n -0000154260 00000 n -0000153522 00000 n -0000147301 00000 n -0000153641 00000 n -0000153703 00000 n -0000153765 00000 n -0000153826 00000 n -0000153888 00000 n -0000153950 00000 n -0000154012 00000 n -0000154074 00000 n -0000154136 00000 n -0000154198 00000 n -0000162942 00000 n -0000163341 00000 n -0000162803 00000 n -0000154370 00000 n -0000163098 00000 n -0000163279 00000 n -0000172390 00000 n -0000172851 00000 n -0000172251 00000 n -0000163451 00000 n -0000172541 00000 n -0000172603 00000 n -0000172665 00000 n -0000172727 00000 n -0000172789 00000 n -0000176862 00000 n -0000176924 00000 n -0000176682 00000 n -0000172974 00000 n -0000176801 00000 n -0000884340 00000 n -0000186399 00000 n -0000186550 00000 n -0000186699 00000 n -0000187218 00000 n -0000186244 00000 n -0000177021 00000 n -0000186851 00000 n -0000187034 00000 n -0000191776 00000 n -0000198440 00000 n -0000191898 00000 n -0000191596 00000 n -0000187354 00000 n -0000191715 00000 n -0000883841 00000 n -0000198590 00000 n -0000198739 00000 n -0000198889 00000 n -0000204560 00000 n -0000199223 00000 n -0000198277 00000 n -0000192008 00000 n -0000199039 00000 n -0000211288 00000 n -0000204952 00000 n -0000204421 00000 n -0000199346 00000 n -0000204711 00000 n -0000211436 00000 n -0000211583 00000 n -0000211976 00000 n -0000211133 00000 n -0000205062 00000 n -0000211731 00000 n -0000213004 00000 n -0000212763 00000 n -0000212073 00000 n -0000212882 00000 n -0000212943 00000 n -0000884458 00000 n -0000213548 00000 n -0000213305 00000 n -0000213088 00000 n -0000213424 00000 n -0000220832 00000 n -0000220982 00000 n -0000221129 00000 n -0000221279 00000 n -0000221429 00000 n -0000223591 00000 n -0000221762 00000 n -0000220661 00000 n -0000213632 00000 n -0000221579 00000 n -0000221700 00000 n -0000223803 00000 n -0000223452 00000 n -0000221898 00000 n -0000223741 00000 n -0000231031 00000 n -0000231181 00000 n -0000231331 00000 n -0000231482 00000 n -0000231814 00000 n -0000230868 00000 n -0000223900 00000 n -0000231631 00000 n -0000231752 00000 n -0000232828 00000 n -0000232647 00000 n -0000231963 00000 n -0000232766 00000 n -0000240607 00000 n -0000240757 00000 n -0000240907 00000 n -0000241057 00000 n -0000241388 00000 n -0000240444 00000 n -0000232912 00000 n -0000241206 00000 n -0000241327 00000 n -0000884576 00000 n -0000242402 00000 n -0000242221 00000 n -0000241537 00000 n -0000242340 00000 n -0000249224 00000 n -0000249370 00000 n -0000249704 00000 n -0000249077 00000 n -0000242486 00000 n -0000249521 00000 n -0000249642 00000 n -0000255871 00000 n -0000256020 00000 n -0000256354 00000 n -0000255724 00000 n -0000249853 00000 n -0000256169 00000 n -0000256292 00000 n -0000262884 00000 n -0000263032 00000 n -0000263366 00000 n -0000262737 00000 n -0000256503 00000 n -0000263183 00000 n -0000263304 00000 n -0000270595 00000 n -0000270744 00000 n -0000271079 00000 n -0000270448 00000 n -0000263527 00000 n -0000270893 00000 n -0000271017 00000 n -0000272103 00000 n -0000271923 00000 n -0000271240 00000 n -0000272042 00000 n -0000884694 00000 n -0000278656 00000 n -0000278805 00000 n -0000279140 00000 n -0000278509 00000 n -0000272187 00000 n -0000278954 00000 n -0000279078 00000 n -0000286594 00000 n -0000286742 00000 n -0000287076 00000 n -0000286447 00000 n -0000279289 00000 n -0000286893 00000 n -0000287014 00000 n -0000292908 00000 n -0000293056 00000 n -0000293391 00000 n -0000292761 00000 n -0000287225 00000 n -0000293206 00000 n -0000883260 00000 n -0000293329 00000 n -0000301280 00000 n -0000301431 00000 n -0000301580 00000 n -0000308975 00000 n -0000302099 00000 n -0000301125 00000 n -0000293540 00000 n -0000301730 00000 n -0000301851 00000 n -0000301913 00000 n -0000301975 00000 n -0000302037 00000 n -0000309126 00000 n -0000309276 00000 n -0000309426 00000 n -0000309578 00000 n -0000309731 00000 n -0000309884 00000 n -0000310097 00000 n -0000308788 00000 n -0000302260 00000 n -0000310035 00000 n -0000318814 00000 n -0000326324 00000 n -0000319147 00000 n -0000318675 00000 n -0000310207 00000 n -0000318964 00000 n -0000319085 00000 n -0000884812 00000 n -0000326476 00000 n -0000326627 00000 n -0000326778 00000 n -0000326928 00000 n -0000327140 00000 n -0000326153 00000 n -0000319321 00000 n -0000327078 00000 n -0000332145 00000 n -0000332296 00000 n -0000332508 00000 n -0000331998 00000 n -0000327276 00000 n -0000332447 00000 n -0000333467 00000 n -0000333743 00000 n -0000333328 00000 n -0000332618 00000 n -0000333619 00000 n -0000340064 00000 n -0000340215 00000 n -0000340366 00000 n -0000340699 00000 n -0000339909 00000 n -0000333827 00000 n -0000340516 00000 n -0000340637 00000 n +0000000105 00000 n +0000084073 00000 n +0000899592 00000 n +0000000150 00000 n +0000000183 00000 n +0000092006 00000 n +0000899469 00000 n +0000000229 00000 n +0000000266 00000 n +0000102236 00000 n +0000899395 00000 n +0000000317 00000 n +0000000358 00000 n +0000110483 00000 n +0000899308 00000 n +0000000409 00000 n +0000000448 00000 n +0000117735 00000 n +0000899221 00000 n +0000000499 00000 n +0000000543 00000 n +0000135981 00000 n +0000899147 00000 n +0000000594 00000 n +0000000634 00000 n +0000146723 00000 n +0000899023 00000 n +0000000680 00000 n +0000000716 00000 n +0000146783 00000 n +0000898912 00000 n +0000000767 00000 n +0000000815 00000 n +0000163185 00000 n +0000898851 00000 n +0000000871 00000 n +0000000911 00000 n +0000163245 00000 n +0000898727 00000 n +0000000962 00000 n +0000001013 00000 n +0000186935 00000 n +0000898666 00000 n +0000001069 00000 n +0000001109 00000 n +0000186996 00000 n +0000898579 00000 n +0000001160 00000 n +0000001212 00000 n +0000187118 00000 n +0000898467 00000 n +0000001263 00000 n +0000001315 00000 n +0000187179 00000 n +0000898393 00000 n +0000001362 00000 n +0000001415 00000 n +0000191860 00000 n +0000898306 00000 n +0000001462 00000 n +0000001515 00000 n +0000199123 00000 n +0000898219 00000 n +0000001562 00000 n +0000001616 00000 n +0000199184 00000 n +0000898132 00000 n +0000001663 00000 n +0000001717 00000 n +0000204794 00000 n +0000898045 00000 n +0000001764 00000 n +0000001810 00000 n +0000204854 00000 n +0000897958 00000 n +0000001857 00000 n +0000001914 00000 n +0000204914 00000 n +0000897871 00000 n +0000001961 00000 n +0000002018 00000 n +0000211815 00000 n +0000897784 00000 n +0000002065 00000 n +0000002110 00000 n +0000211876 00000 n +0000897697 00000 n +0000002158 00000 n +0000002202 00000 n +0000211937 00000 n +0000897622 00000 n +0000002250 00000 n +0000002297 00000 n +0000213508 00000 n +0000897492 00000 n +0000002344 00000 n +0000002388 00000 n +0000221662 00000 n +0000897413 00000 n +0000002437 00000 n +0000002471 00000 n +0000231714 00000 n +0000897320 00000 n +0000002520 00000 n +0000002552 00000 n +0000241289 00000 n +0000897227 00000 n +0000002601 00000 n +0000002634 00000 n +0000249604 00000 n +0000897134 00000 n +0000002683 00000 n +0000002716 00000 n +0000256253 00000 n +0000897041 00000 n +0000002765 00000 n +0000002799 00000 n +0000263266 00000 n +0000896948 00000 n +0000002848 00000 n +0000002881 00000 n +0000270977 00000 n +0000896855 00000 n +0000002930 00000 n +0000002964 00000 n +0000279038 00000 n +0000896762 00000 n +0000003013 00000 n +0000003046 00000 n +0000286976 00000 n +0000896669 00000 n +0000003095 00000 n +0000003129 00000 n +0000293290 00000 n +0000896576 00000 n +0000003178 00000 n +0000003211 00000 n +0000301813 00000 n +0000896483 00000 n +0000003260 00000 n +0000003291 00000 n +0000319047 00000 n +0000896404 00000 n +0000003340 00000 n +0000003371 00000 n +0000333703 00000 n +0000896274 00000 n +0000003418 00000 n +0000003462 00000 n +0000340599 00000 n +0000896195 00000 n +0000003511 00000 n +0000003542 00000 n +0000360921 00000 n +0000896102 00000 n +0000003591 00000 n +0000003622 00000 n +0000385263 00000 n +0000896009 00000 n +0000003671 00000 n +0000003704 00000 n +0000394846 00000 n +0000895930 00000 n +0000003753 00000 n +0000003787 00000 n +0000403779 00000 n +0000895799 00000 n +0000003834 00000 n +0000003880 00000 n +0000403841 00000 n +0000895720 00000 n +0000003929 00000 n +0000003961 00000 n +0000426979 00000 n +0000895627 00000 n +0000004010 00000 n +0000004042 00000 n +0000431359 00000 n +0000895534 00000 n +0000004091 00000 n +0000004123 00000 n +0000435452 00000 n +0000895441 00000 n +0000004172 00000 n +0000004204 00000 n +0000438285 00000 n +0000895348 00000 n +0000004253 00000 n +0000004286 00000 n +0000444961 00000 n +0000895255 00000 n +0000004335 00000 n +0000004370 00000 n +0000452668 00000 n +0000895162 00000 n +0000004419 00000 n +0000004451 00000 n +0000460482 00000 n +0000895069 00000 n +0000004500 00000 n +0000004532 00000 n +0000470980 00000 n +0000894976 00000 n +0000004581 00000 n +0000004613 00000 n +0000476970 00000 n +0000894883 00000 n +0000004662 00000 n +0000004695 00000 n +0000481711 00000 n +0000894790 00000 n +0000004744 00000 n +0000004775 00000 n +0000486968 00000 n +0000894697 00000 n +0000004824 00000 n +0000004856 00000 n +0000493733 00000 n +0000894604 00000 n +0000004905 00000 n +0000004937 00000 n +0000498231 00000 n +0000894511 00000 n +0000004986 00000 n +0000005018 00000 n +0000501702 00000 n +0000894418 00000 n +0000005067 00000 n +0000005100 00000 n +0000505558 00000 n +0000894325 00000 n +0000005149 00000 n +0000005180 00000 n +0000512721 00000 n +0000894232 00000 n +0000005229 00000 n +0000005273 00000 n +0000520211 00000 n +0000894139 00000 n +0000005322 00000 n +0000005366 00000 n +0000524080 00000 n +0000894046 00000 n +0000005415 00000 n +0000005453 00000 n +0000529723 00000 n +0000893953 00000 n +0000005502 00000 n +0000005543 00000 n +0000533625 00000 n +0000893860 00000 n +0000005592 00000 n +0000005630 00000 n +0000539277 00000 n +0000893767 00000 n +0000005679 00000 n +0000005720 00000 n +0000543766 00000 n +0000893674 00000 n +0000005769 00000 n +0000005811 00000 n +0000548136 00000 n +0000893581 00000 n +0000005860 00000 n +0000005901 00000 n +0000554636 00000 n +0000893488 00000 n +0000005950 00000 n +0000005989 00000 n +0000563955 00000 n +0000893395 00000 n +0000006038 00000 n +0000006071 00000 n +0000570153 00000 n +0000893316 00000 n +0000006120 00000 n +0000006157 00000 n +0000578734 00000 n +0000893185 00000 n +0000006204 00000 n +0000006255 00000 n +0000584694 00000 n +0000893106 00000 n +0000006304 00000 n +0000006335 00000 n +0000589903 00000 n +0000893013 00000 n +0000006384 00000 n +0000006415 00000 n +0000594831 00000 n +0000892920 00000 n +0000006464 00000 n +0000006495 00000 n +0000597624 00000 n +0000892827 00000 n +0000006544 00000 n +0000006585 00000 n +0000601062 00000 n +0000892734 00000 n +0000006634 00000 n +0000006672 00000 n +0000602708 00000 n +0000892641 00000 n +0000006721 00000 n +0000006753 00000 n +0000604610 00000 n +0000892548 00000 n +0000006802 00000 n +0000006836 00000 n +0000606385 00000 n +0000892455 00000 n +0000006885 00000 n +0000006917 00000 n +0000611355 00000 n +0000892362 00000 n +0000006966 00000 n +0000006998 00000 n +0000616999 00000 n +0000892269 00000 n +0000007047 00000 n +0000007077 00000 n +0000622723 00000 n +0000892176 00000 n +0000007126 00000 n +0000007156 00000 n +0000628477 00000 n +0000892083 00000 n +0000007205 00000 n +0000007235 00000 n +0000634289 00000 n +0000891990 00000 n +0000007284 00000 n +0000007314 00000 n +0000640133 00000 n +0000891897 00000 n +0000007363 00000 n +0000007393 00000 n +0000646052 00000 n +0000891804 00000 n +0000007442 00000 n +0000007472 00000 n +0000651923 00000 n +0000891725 00000 n +0000007521 00000 n +0000007551 00000 n +0000659149 00000 n +0000891595 00000 n +0000007598 00000 n +0000007634 00000 n +0000666826 00000 n +0000891516 00000 n +0000007683 00000 n +0000007717 00000 n +0000668393 00000 n +0000891423 00000 n +0000007766 00000 n +0000007798 00000 n +0000670060 00000 n +0000891330 00000 n +0000007847 00000 n +0000007893 00000 n +0000672194 00000 n +0000891251 00000 n +0000007942 00000 n +0000007985 00000 n +0000673139 00000 n +0000891121 00000 n +0000008032 00000 n +0000008063 00000 n +0000678145 00000 n +0000891017 00000 n +0000008112 00000 n +0000008142 00000 n +0000683613 00000 n +0000890938 00000 n +0000008191 00000 n +0000008222 00000 n +0000687431 00000 n +0000890845 00000 n +0000008271 00000 n +0000008308 00000 n +0000691112 00000 n +0000890752 00000 n +0000008357 00000 n +0000008395 00000 n +0000695423 00000 n +0000890673 00000 n +0000008444 00000 n +0000008482 00000 n +0000696753 00000 n +0000890543 00000 n +0000008530 00000 n +0000008576 00000 n +0000702164 00000 n +0000890464 00000 n +0000008625 00000 n +0000008660 00000 n +0000708071 00000 n +0000890371 00000 n +0000008709 00000 n +0000008743 00000 n +0000713819 00000 n +0000890278 00000 n +0000008792 00000 n +0000008827 00000 n +0000716414 00000 n +0000890199 00000 n +0000008876 00000 n +0000008912 00000 n +0000717442 00000 n +0000890083 00000 n +0000008960 00000 n +0000009000 00000 n +0000725407 00000 n +0000890018 00000 n +0000009049 00000 n +0000009075 00000 n +0000009901 00000 n +0000010201 00000 n +0000009127 00000 n +0000010020 00000 n +0000010081 00000 n +0000884425 00000 n +0000886161 00000 n +0000884279 00000 n +0000885008 00000 n +0000886598 00000 n +0000010628 00000 n +0000010447 00000 n +0000010311 00000 n +0000010566 00000 n +0000028856 00000 n +0000029007 00000 n +0000029158 00000 n +0000029315 00000 n +0000029472 00000 n +0000029629 00000 n +0000029786 00000 n +0000029936 00000 n +0000030093 00000 n +0000030255 00000 n +0000030412 00000 n +0000030574 00000 n +0000030731 00000 n +0000030888 00000 n +0000031041 00000 n +0000031194 00000 n +0000031347 00000 n +0000031500 00000 n +0000031652 00000 n +0000031805 00000 n +0000031958 00000 n +0000032111 00000 n +0000032265 00000 n +0000032419 00000 n +0000032570 00000 n +0000032724 00000 n +0000032878 00000 n +0000033032 00000 n +0000033186 00000 n +0000033340 00000 n +0000033493 00000 n +0000033647 00000 n +0000033801 00000 n +0000033955 00000 n +0000034109 00000 n +0000034262 00000 n +0000034416 00000 n +0000034567 00000 n +0000034721 00000 n +0000034874 00000 n +0000035028 00000 n +0000056872 00000 n +0000057023 00000 n +0000057176 00000 n +0000035303 00000 n +0000028397 00000 n +0000010699 00000 n +0000035181 00000 n +0000035242 00000 n +0000057330 00000 n +0000057484 00000 n +0000057638 00000 n +0000057792 00000 n +0000057946 00000 n +0000058100 00000 n +0000058254 00000 n +0000058407 00000 n +0000058560 00000 n +0000058714 00000 n +0000058868 00000 n +0000059021 00000 n +0000059174 00000 n +0000059327 00000 n +0000059481 00000 n +0000059635 00000 n +0000059789 00000 n +0000059943 00000 n +0000060097 00000 n +0000060251 00000 n +0000060405 00000 n +0000060558 00000 n +0000060710 00000 n +0000060864 00000 n +0000061018 00000 n +0000061172 00000 n +0000061324 00000 n +0000061478 00000 n +0000061632 00000 n +0000061786 00000 n +0000061940 00000 n +0000062094 00000 n +0000062248 00000 n +0000062402 00000 n +0000062556 00000 n +0000062710 00000 n +0000062864 00000 n +0000063018 00000 n +0000063172 00000 n +0000063326 00000 n +0000063480 00000 n +0000063633 00000 n +0000071384 00000 n +0000071535 00000 n +0000071688 00000 n +0000071842 00000 n +0000063848 00000 n +0000056381 00000 n +0000035400 00000 n +0000063786 00000 n +0000071995 00000 n +0000072149 00000 n +0000072300 00000 n +0000072453 00000 n +0000072607 00000 n +0000072760 00000 n +0000072914 00000 n +0000073068 00000 n +0000073218 00000 n +0000073372 00000 n +0000073526 00000 n +0000073680 00000 n +0000073834 00000 n +0000073985 00000 n +0000074199 00000 n +0000071109 00000 n +0000063932 00000 n +0000074138 00000 n +0000074602 00000 n +0000074421 00000 n +0000074283 00000 n +0000074540 00000 n +0000082999 00000 n +0000083154 00000 n +0000083310 00000 n +0000083464 00000 n +0000083619 00000 n +0000083769 00000 n +0000083921 00000 n +0000091550 00000 n +0000091701 00000 n +0000084133 00000 n +0000082812 00000 n +0000074673 00000 n +0000886015 00000 n +0000886716 00000 n +0000744887 00000 n +0000744824 00000 n +0000742688 00000 n +0000742750 00000 n +0000743000 00000 n +0000742503 00000 n +0000742565 00000 n +0000091854 00000 n +0000089890 00000 n +0000092129 00000 n +0000089735 00000 n +0000084230 00000 n +0000884571 00000 n +0000092067 00000 n +0000091288 00000 n +0000091407 00000 n +0000091454 00000 n +0000091528 00000 n +0000742626 00000 n +0000101715 00000 n +0000101868 00000 n +0000102022 00000 n +0000102420 00000 n +0000101560 00000 n +0000092254 00000 n +0000102175 00000 n +0000886307 00000 n +0000885296 00000 n +0000884863 00000 n +0000885727 00000 n +0000885153 00000 n +0000102296 00000 n +0000885439 00000 n +0000102358 00000 n +0000742938 00000 n +0000110053 00000 n +0000110206 00000 n +0000108082 00000 n +0000110544 00000 n +0000107935 00000 n +0000102620 00000 n +0000110359 00000 n +0000110421 00000 n +0000109791 00000 n +0000109910 00000 n +0000109957 00000 n +0000110031 00000 n +0000742441 00000 n +0000742380 00000 n +0000117370 00000 n +0000117522 00000 n +0000117794 00000 n +0000117223 00000 n +0000110708 00000 n +0000117674 00000 n +0000127321 00000 n +0000126522 00000 n +0000117930 00000 n +0000126641 00000 n +0000884717 00000 n +0000126703 00000 n +0000126763 00000 n +0000126825 00000 n +0000126887 00000 n +0000126949 00000 n +0000127011 00000 n +0000127073 00000 n +0000127135 00000 n +0000127197 00000 n +0000127259 00000 n +0000138065 00000 n +0000136041 00000 n +0000135131 00000 n +0000127443 00000 n +0000135250 00000 n +0000135311 00000 n +0000135372 00000 n +0000135433 00000 n +0000135494 00000 n +0000135555 00000 n +0000135616 00000 n +0000135677 00000 n +0000135737 00000 n +0000135798 00000 n +0000135859 00000 n +0000135920 00000 n +0000886834 00000 n +0000138284 00000 n +0000137926 00000 n +0000136151 00000 n +0000138222 00000 n +0000146354 00000 n +0000146505 00000 n +0000147210 00000 n +0000146207 00000 n +0000138368 00000 n +0000146662 00000 n +0000146843 00000 n +0000146905 00000 n +0000146966 00000 n +0000147027 00000 n +0000147088 00000 n +0000147149 00000 n +0000154286 00000 n +0000153548 00000 n +0000147320 00000 n +0000153667 00000 n +0000153729 00000 n +0000153791 00000 n +0000153852 00000 n +0000153914 00000 n +0000153976 00000 n +0000154038 00000 n +0000154100 00000 n +0000154162 00000 n +0000154224 00000 n +0000162968 00000 n +0000163367 00000 n +0000162829 00000 n +0000154396 00000 n +0000163124 00000 n +0000163305 00000 n +0000172416 00000 n +0000172877 00000 n +0000172277 00000 n +0000163477 00000 n +0000172567 00000 n +0000172629 00000 n +0000172691 00000 n +0000172753 00000 n +0000172815 00000 n +0000176884 00000 n +0000176946 00000 n +0000176704 00000 n +0000173000 00000 n +0000176823 00000 n +0000886952 00000 n +0000186421 00000 n +0000186572 00000 n +0000186721 00000 n +0000187240 00000 n +0000186266 00000 n +0000177043 00000 n +0000186873 00000 n +0000187056 00000 n +0000191798 00000 n +0000198462 00000 n +0000191920 00000 n +0000191618 00000 n +0000187376 00000 n +0000191737 00000 n +0000886453 00000 n +0000198612 00000 n +0000198761 00000 n +0000198911 00000 n +0000204582 00000 n +0000199245 00000 n +0000198299 00000 n +0000192030 00000 n +0000199061 00000 n +0000211310 00000 n +0000204974 00000 n +0000204443 00000 n +0000199368 00000 n +0000204733 00000 n +0000211458 00000 n +0000211605 00000 n +0000211998 00000 n +0000211155 00000 n +0000205084 00000 n +0000211753 00000 n +0000213026 00000 n +0000212785 00000 n +0000212095 00000 n +0000212904 00000 n +0000212965 00000 n +0000887070 00000 n +0000213570 00000 n +0000213327 00000 n +0000213110 00000 n +0000213446 00000 n +0000220854 00000 n +0000221004 00000 n +0000221151 00000 n +0000221301 00000 n +0000221451 00000 n +0000223613 00000 n +0000221784 00000 n +0000220683 00000 n +0000213654 00000 n +0000221601 00000 n +0000221722 00000 n +0000223825 00000 n +0000223474 00000 n +0000221920 00000 n +0000223763 00000 n +0000231053 00000 n +0000231203 00000 n +0000231353 00000 n +0000231504 00000 n +0000231836 00000 n +0000230890 00000 n +0000223922 00000 n +0000231653 00000 n +0000231774 00000 n +0000232850 00000 n +0000232669 00000 n +0000231985 00000 n +0000232788 00000 n +0000240629 00000 n +0000240779 00000 n +0000240929 00000 n +0000241079 00000 n +0000241410 00000 n +0000240466 00000 n +0000232934 00000 n +0000241228 00000 n +0000241349 00000 n +0000887188 00000 n +0000242424 00000 n +0000242243 00000 n +0000241559 00000 n +0000242362 00000 n +0000249246 00000 n +0000249392 00000 n +0000249726 00000 n +0000249099 00000 n +0000242508 00000 n +0000249543 00000 n +0000249664 00000 n +0000255893 00000 n +0000256042 00000 n +0000256376 00000 n +0000255746 00000 n +0000249875 00000 n +0000256191 00000 n +0000256314 00000 n +0000262906 00000 n +0000263054 00000 n +0000263388 00000 n +0000262759 00000 n +0000256525 00000 n +0000263205 00000 n +0000263326 00000 n +0000270617 00000 n +0000270766 00000 n +0000271101 00000 n +0000270470 00000 n +0000263549 00000 n +0000270915 00000 n +0000271039 00000 n +0000272125 00000 n +0000271945 00000 n +0000271262 00000 n +0000272064 00000 n +0000887306 00000 n +0000278678 00000 n +0000278827 00000 n +0000279162 00000 n +0000278531 00000 n +0000272209 00000 n +0000278976 00000 n +0000279100 00000 n +0000286616 00000 n +0000286764 00000 n +0000287098 00000 n +0000286469 00000 n +0000279311 00000 n +0000286915 00000 n +0000287036 00000 n +0000292930 00000 n +0000293078 00000 n +0000293413 00000 n +0000292783 00000 n +0000287247 00000 n +0000293228 00000 n +0000885872 00000 n +0000293351 00000 n +0000301302 00000 n +0000301453 00000 n +0000301602 00000 n +0000308997 00000 n +0000302121 00000 n +0000301147 00000 n +0000293562 00000 n +0000301752 00000 n +0000301873 00000 n +0000301935 00000 n +0000301997 00000 n +0000302059 00000 n +0000309148 00000 n +0000309298 00000 n +0000309448 00000 n +0000309600 00000 n +0000309753 00000 n +0000309906 00000 n +0000310119 00000 n +0000308810 00000 n +0000302282 00000 n +0000310057 00000 n +0000318836 00000 n +0000326346 00000 n +0000319169 00000 n +0000318697 00000 n +0000310229 00000 n +0000318986 00000 n +0000319107 00000 n +0000887424 00000 n +0000326498 00000 n +0000326649 00000 n +0000326800 00000 n +0000326950 00000 n +0000327162 00000 n +0000326175 00000 n +0000319343 00000 n +0000327100 00000 n +0000332167 00000 n +0000332318 00000 n +0000332530 00000 n +0000332020 00000 n +0000327298 00000 n +0000332469 00000 n +0000333489 00000 n +0000333765 00000 n +0000333350 00000 n +0000332640 00000 n +0000333641 00000 n +0000340086 00000 n +0000340237 00000 n +0000340388 00000 n +0000340721 00000 n +0000339931 00000 n +0000333849 00000 n +0000340538 00000 n +0000340659 00000 n +0000349411 00000 n +0000345182 00000 n +0000349561 00000 n +0000349835 00000 n +0000345035 00000 n +0000340857 00000 n +0000349711 00000 n +0000349773 00000 n +0000349076 00000 n +0000349195 00000 n +0000349242 00000 n +0000349316 00000 n 0000349389 00000 n -0000345160 00000 n -0000349539 00000 n -0000349813 00000 n -0000345013 00000 n -0000340835 00000 n -0000349689 00000 n -0000349751 00000 n -0000349054 00000 n -0000349173 00000 n -0000349220 00000 n -0000349294 00000 n -0000349367 00000 n -0000353253 00000 n -0000353073 00000 n -0000349964 00000 n -0000353192 00000 n -0000882971 00000 n -0000884930 00000 n -0000360536 00000 n -0000360687 00000 n -0000361022 00000 n -0000360389 00000 n -0000353337 00000 n -0000360837 00000 n -0000360960 00000 n -0000367251 00000 n -0000372549 00000 n -0000367402 00000 n -0000367551 00000 n -0000367945 00000 n -0000367096 00000 n -0000361171 00000 n -0000367702 00000 n -0000367763 00000 n -0000367824 00000 n -0000367885 00000 n -0000376923 00000 n -0000371940 00000 n -0000371759 00000 n -0000368081 00000 n -0000371878 00000 n -0000376985 00000 n -0000372430 00000 n -0000372024 00000 n +0000353275 00000 n +0000353095 00000 n +0000349986 00000 n +0000353214 00000 n +0000885583 00000 n +0000887542 00000 n +0000360558 00000 n +0000360709 00000 n +0000361044 00000 n +0000360411 00000 n +0000353359 00000 n +0000360859 00000 n +0000360982 00000 n +0000367273 00000 n +0000372571 00000 n +0000367424 00000 n +0000367573 00000 n +0000367967 00000 n +0000367118 00000 n +0000361193 00000 n +0000367724 00000 n +0000367785 00000 n +0000367846 00000 n +0000367907 00000 n +0000376945 00000 n +0000371962 00000 n +0000371781 00000 n +0000368103 00000 n +0000371900 00000 n +0000377007 00000 n +0000372452 00000 n +0000372046 00000 n +0000376884 00000 n +0000376549 00000 n +0000376668 00000 n +0000376715 00000 n +0000376789 00000 n 0000376862 00000 n -0000376527 00000 n -0000376646 00000 n -0000376693 00000 n -0000376767 00000 n -0000376840 00000 n -0000384878 00000 n -0000385029 00000 n -0000385364 00000 n -0000384731 00000 n -0000377084 00000 n -0000385179 00000 n -0000385302 00000 n -0000387119 00000 n -0000386939 00000 n -0000385525 00000 n -0000387058 00000 n -0000885048 00000 n -0000394612 00000 n -0000397025 00000 n -0000394948 00000 n -0000394473 00000 n -0000387203 00000 n -0000394762 00000 n -0000394886 00000 n -0000397237 00000 n -0000396886 00000 n -0000395109 00000 n -0000397176 00000 n -0000403881 00000 n -0000403576 00000 n -0000397334 00000 n -0000403695 00000 n -0000410425 00000 n -0000410698 00000 n -0000410286 00000 n -0000404017 00000 n -0000410576 00000 n -0000410637 00000 n -0000420808 00000 n -0000420188 00000 n -0000410808 00000 n -0000420307 00000 n -0000420369 00000 n -0000420431 00000 n -0000420493 00000 n -0000420556 00000 n -0000420619 00000 n -0000420682 00000 n -0000420745 00000 n -0000426742 00000 n -0000427142 00000 n -0000426598 00000 n -0000420957 00000 n -0000426894 00000 n -0000427018 00000 n -0000427081 00000 n -0000885166 00000 n -0000430972 00000 n -0000431122 00000 n -0000431463 00000 n -0000430819 00000 n -0000427266 00000 n -0000431273 00000 n -0000431399 00000 n -0000435064 00000 n -0000435215 00000 n -0000435491 00000 n -0000434911 00000 n -0000431574 00000 n -0000435367 00000 n -0000438049 00000 n -0000438325 00000 n -0000437905 00000 n -0000435602 00000 n -0000438199 00000 n -0000444575 00000 n -0000444724 00000 n -0000445001 00000 n -0000444422 00000 n -0000438436 00000 n -0000444876 00000 n -0000447100 00000 n -0000446785 00000 n -0000445138 00000 n -0000446908 00000 n -0000446972 00000 n -0000447036 00000 n -0000452284 00000 n -0000452435 00000 n -0000452896 00000 n -0000452131 00000 n -0000447185 00000 n -0000452583 00000 n -0000452707 00000 n -0000452770 00000 n -0000452833 00000 n -0000885291 00000 n -0000459943 00000 n -0000460095 00000 n -0000460244 00000 n -0000460522 00000 n -0000459781 00000 n -0000453020 00000 n -0000460396 00000 n -0000464272 00000 n -0000463708 00000 n -0000460646 00000 n -0000463831 00000 n -0000463894 00000 n -0000463957 00000 n -0000464020 00000 n -0000464083 00000 n -0000464146 00000 n -0000464209 00000 n -0000470594 00000 n -0000470745 00000 n -0000471149 00000 n -0000470441 00000 n -0000464383 00000 n -0000470894 00000 n -0000471021 00000 n -0000471085 00000 n -0000473204 00000 n -0000472829 00000 n -0000471260 00000 n -0000472952 00000 n -0000473015 00000 n -0000473078 00000 n -0000473141 00000 n -0000476585 00000 n -0000476733 00000 n -0000477010 00000 n -0000476432 00000 n -0000473289 00000 n -0000476884 00000 n -0000481324 00000 n -0000481474 00000 n -0000481814 00000 n -0000481171 00000 n -0000477121 00000 n -0000481626 00000 n -0000481751 00000 n -0000885416 00000 n -0000486731 00000 n -0000487008 00000 n -0000486587 00000 n -0000481925 00000 n -0000486882 00000 n -0000493496 00000 n -0000493772 00000 n -0000493352 00000 n -0000487132 00000 n -0000493648 00000 n -0000494829 00000 n -0000494514 00000 n -0000493896 00000 n -0000494637 00000 n -0000494701 00000 n -0000494765 00000 n -0000497996 00000 n -0000498270 00000 n -0000497852 00000 n -0000494914 00000 n -0000498146 00000 n -0000501464 00000 n -0000501742 00000 n -0000501320 00000 n -0000498381 00000 n -0000501616 00000 n -0000505597 00000 n -0000505350 00000 n -0000501853 00000 n -0000505473 00000 n -0000885541 00000 n -0000512485 00000 n -0000512761 00000 n -0000512341 00000 n -0000505734 00000 n -0000512635 00000 n -0000513949 00000 n -0000513637 00000 n -0000512885 00000 n -0000513760 00000 n -0000513823 00000 n -0000513886 00000 n -0000519974 00000 n -0000520251 00000 n -0000519830 00000 n -0000514034 00000 n -0000520125 00000 n -0000523843 00000 n -0000524182 00000 n -0000523699 00000 n -0000520375 00000 n -0000523995 00000 n -0000524119 00000 n -0000529486 00000 n -0000529827 00000 n -0000529342 00000 n -0000524306 00000 n -0000529637 00000 n -0000529763 00000 n -0000533388 00000 n -0000533727 00000 n -0000533244 00000 n -0000529951 00000 n -0000533540 00000 n -0000533664 00000 n -0000885666 00000 n -0000539040 00000 n -0000539381 00000 n -0000538896 00000 n -0000533851 00000 n -0000539191 00000 n -0000539317 00000 n -0000543530 00000 n -0000543931 00000 n -0000543386 00000 n -0000539505 00000 n -0000543681 00000 n -0000543805 00000 n -0000543868 00000 n -0000547900 00000 n -0000548304 00000 n -0000547756 00000 n -0000544042 00000 n -0000548050 00000 n -0000548176 00000 n -0000548240 00000 n -0000554401 00000 n -0000554676 00000 n -0000554257 00000 n -0000548415 00000 n -0000554551 00000 n -0000558950 00000 n -0000558571 00000 n -0000554800 00000 n -0000558694 00000 n -0000558758 00000 n -0000558822 00000 n -0000558886 00000 n -0000563418 00000 n -0000563568 00000 n -0000563720 00000 n -0000563994 00000 n -0000563256 00000 n -0000559074 00000 n -0000563870 00000 n -0000885791 00000 n -0000570194 00000 n -0000569944 00000 n -0000564118 00000 n -0000570067 00000 n -0000578156 00000 n -0000577404 00000 n -0000570318 00000 n -0000577527 00000 n -0000577590 00000 n -0000577653 00000 n -0000577716 00000 n -0000577779 00000 n -0000577842 00000 n -0000577905 00000 n -0000577967 00000 n -0000578030 00000 n -0000578093 00000 n -0000578775 00000 n -0000578525 00000 n -0000578279 00000 n -0000578648 00000 n -0000582288 00000 n -0000581915 00000 n -0000578860 00000 n -0000582038 00000 n -0000582162 00000 n -0000582225 00000 n -0000587487 00000 n -0000587110 00000 n -0000582412 00000 n -0000587233 00000 n -0000587360 00000 n -0000587423 00000 n -0000592475 00000 n -0000592039 00000 n -0000587624 00000 n -0000592162 00000 n -0000592286 00000 n -0000592349 00000 n -0000592412 00000 n -0000885916 00000 n -0000595080 00000 n -0000594831 00000 n -0000592612 00000 n -0000594954 00000 n -0000598517 00000 n -0000598270 00000 n -0000595191 00000 n -0000598393 00000 n -0000600164 00000 n -0000599915 00000 n -0000598654 00000 n -0000600038 00000 n -0000602065 00000 n -0000601818 00000 n -0000600275 00000 n -0000601941 00000 n -0000603841 00000 n -0000603592 00000 n -0000602176 00000 n -0000603715 00000 n -0000608810 00000 n -0000608563 00000 n -0000603952 00000 n -0000608686 00000 n -0000886041 00000 n -0000614583 00000 n -0000614206 00000 n -0000608947 00000 n -0000614329 00000 n -0000614455 00000 n -0000614519 00000 n -0000620304 00000 n -0000619931 00000 n -0000614720 00000 n -0000620054 00000 n -0000620178 00000 n -0000620241 00000 n -0000626061 00000 n -0000625684 00000 n -0000620441 00000 n -0000625807 00000 n -0000625933 00000 n -0000625997 00000 n -0000631870 00000 n -0000631497 00000 n -0000626198 00000 n -0000631620 00000 n -0000631744 00000 n -0000631807 00000 n -0000637717 00000 n -0000637340 00000 n -0000632007 00000 n -0000637463 00000 n -0000637589 00000 n -0000637653 00000 n -0000643569 00000 n -0000643260 00000 n -0000637854 00000 n -0000643383 00000 n -0000643507 00000 n -0000886166 00000 n -0000649442 00000 n -0000649130 00000 n -0000643706 00000 n -0000649253 00000 n -0000649379 00000 n -0000656178 00000 n -0000656329 00000 n -0000656605 00000 n -0000656025 00000 n -0000649579 00000 n -0000656480 00000 n -0000660785 00000 n -0000660849 00000 n -0000660912 00000 n -0000660598 00000 n -0000656703 00000 n -0000660721 00000 n -0000664275 00000 n -0000664028 00000 n -0000661010 00000 n -0000664151 00000 n -0000665844 00000 n -0000665594 00000 n -0000664386 00000 n -0000665717 00000 n -0000667510 00000 n -0000667262 00000 n -0000665955 00000 n -0000667385 00000 n -0000886291 00000 n -0000669645 00000 n -0000669395 00000 n -0000667621 00000 n -0000669518 00000 n -0000670589 00000 n -0000670341 00000 n -0000669756 00000 n -0000670464 00000 n -0000675320 00000 n -0000675596 00000 n -0000675176 00000 n -0000670687 00000 n -0000675469 00000 n -0000680788 00000 n -0000681063 00000 n -0000680644 00000 n -0000675707 00000 n -0000680938 00000 n -0000684606 00000 n -0000684882 00000 n -0000684462 00000 n -0000681174 00000 n -0000684755 00000 n -0000688562 00000 n -0000688314 00000 n -0000684993 00000 n -0000688437 00000 n -0000886416 00000 n -0000692598 00000 n -0000692874 00000 n -0000692454 00000 n -0000688673 00000 n -0000692747 00000 n -0000694203 00000 n -0000693955 00000 n -0000692985 00000 n -0000694078 00000 n -0000699181 00000 n -0000699333 00000 n -0000699677 00000 n -0000699028 00000 n -0000694314 00000 n -0000699488 00000 n -0000699614 00000 n -0000704793 00000 n -0000704942 00000 n -0000705093 00000 n -0000705245 00000 n -0000705520 00000 n -0000704622 00000 n -0000699839 00000 n -0000705396 00000 n -0000710840 00000 n -0000710991 00000 n -0000711269 00000 n -0000710687 00000 n -0000705631 00000 n -0000711143 00000 n -0000713587 00000 n -0000713864 00000 n -0000713443 00000 n -0000711380 00000 n -0000713739 00000 n -0000886541 00000 n -0000714893 00000 n -0000714643 00000 n -0000713975 00000 n -0000714766 00000 n -0000722431 00000 n -0000722581 00000 n -0000722856 00000 n -0000722278 00000 n -0000714991 00000 n -0000722732 00000 n -0000728904 00000 n -0000729119 00000 n -0000728760 00000 n -0000723018 00000 n -0000729055 00000 n -0000731967 00000 n -0000731781 00000 n -0000729243 00000 n -0000731904 00000 n -0000732392 00000 n -0000732205 00000 n -0000732065 00000 n -0000732328 00000 n -0000740450 00000 n -0000739456 00000 n -0000732464 00000 n -0000739579 00000 n -0000739642 00000 n -0000739705 00000 n -0000740200 00000 n -0000740263 00000 n -0000886666 00000 n -0000742402 00000 n -0000742025 00000 n -0000740561 00000 n -0000742148 00000 n -0000742338 00000 n -0000742487 00000 n -0000742940 00000 n -0000743274 00000 n -0000743630 00000 n -0000743656 00000 n -0000744167 00000 n -0000744205 00000 n -0000744900 00000 n -0000745257 00000 n -0000745337 00000 n -0000745713 00000 n -0000746355 00000 n -0000747019 00000 n -0000747647 00000 n -0000748290 00000 n -0000748580 00000 n -0000749233 00000 n -0000763370 00000 n -0000763817 00000 n -0000776216 00000 n -0000776644 00000 n -0000787751 00000 n -0000788086 00000 n -0000790172 00000 n -0000790394 00000 n -0000794953 00000 n -0000795200 00000 n -0000811939 00000 n -0000812472 00000 n -0000814748 00000 n -0000814980 00000 n -0000817363 00000 n -0000817601 00000 n -0000827283 00000 n -0000827660 00000 n -0000833650 00000 n -0000833970 00000 n -0000838020 00000 n -0000838364 00000 n -0000839987 00000 n -0000840223 00000 n -0000853733 00000 n -0000854109 00000 n -0000860382 00000 n -0000860650 00000 n -0000873872 00000 n -0000874333 00000 n -0000881321 00000 n -0000886755 00000 n -0000886875 00000 n -0000886997 00000 n -0000887123 00000 n -0000887240 00000 n -0000887332 00000 n -0000897151 00000 n -0000897338 00000 n -0000897523 00000 n -0000897706 00000 n -0000897884 00000 n -0000898053 00000 n -0000898224 00000 n -0000898394 00000 n -0000898565 00000 n -0000898735 00000 n -0000898908 00000 n -0000899083 00000 n -0000899260 00000 n -0000899435 00000 n -0000899612 00000 n -0000899786 00000 n -0000899960 00000 n -0000900137 00000 n -0000900312 00000 n -0000900489 00000 n -0000900675 00000 n -0000900876 00000 n -0000901099 00000 n -0000901284 00000 n -0000901464 00000 n -0000901644 00000 n -0000901829 00000 n -0000902012 00000 n -0000902197 00000 n -0000902379 00000 n -0000902559 00000 n -0000902728 00000 n -0000902899 00000 n -0000903069 00000 n -0000903240 00000 n -0000903410 00000 n -0000903581 00000 n -0000903751 00000 n -0000903926 00000 n -0000904101 00000 n -0000904278 00000 n -0000904452 00000 n -0000904626 00000 n -0000904803 00000 n -0000904978 00000 n -0000905155 00000 n -0000905330 00000 n -0000905519 00000 n -0000905722 00000 n -0000905923 00000 n -0000906126 00000 n -0000906326 00000 n -0000906526 00000 n -0000906729 00000 n -0000906930 00000 n -0000907133 00000 n -0000907334 00000 n -0000907537 00000 n -0000907738 00000 n -0000907941 00000 n -0000908142 00000 n -0000908338 00000 n -0000908523 00000 n -0000908724 00000 n -0000908955 00000 n -0000909154 00000 n -0000909329 00000 n -0000909498 00000 n -0000909616 00000 n -0000909732 00000 n -0000909848 00000 n -0000909965 00000 n -0000910082 00000 n -0000910198 00000 n -0000910313 00000 n -0000910433 00000 n -0000910557 00000 n -0000910681 00000 n -0000910801 00000 n -0000910872 00000 n -0000910990 00000 n -0000911106 00000 n -0000911188 00000 n -0000911228 00000 n -0000911465 00000 n +0000384900 00000 n +0000385051 00000 n +0000385386 00000 n +0000384753 00000 n +0000377106 00000 n +0000385201 00000 n +0000385324 00000 n +0000387141 00000 n +0000386961 00000 n +0000385547 00000 n +0000387080 00000 n +0000887660 00000 n +0000394634 00000 n +0000397047 00000 n +0000394970 00000 n +0000394495 00000 n +0000387225 00000 n +0000394784 00000 n +0000394908 00000 n +0000397259 00000 n +0000396908 00000 n +0000395131 00000 n +0000397198 00000 n +0000403903 00000 n +0000403598 00000 n +0000397356 00000 n +0000403717 00000 n +0000410447 00000 n +0000410720 00000 n +0000410308 00000 n +0000404039 00000 n +0000410598 00000 n +0000410659 00000 n +0000420830 00000 n +0000420210 00000 n +0000410830 00000 n +0000420329 00000 n +0000420391 00000 n +0000420453 00000 n +0000420515 00000 n +0000420578 00000 n +0000420641 00000 n +0000420704 00000 n +0000420767 00000 n +0000426764 00000 n +0000427164 00000 n +0000426620 00000 n +0000420979 00000 n +0000426916 00000 n +0000427040 00000 n +0000427103 00000 n +0000887778 00000 n +0000430994 00000 n +0000431144 00000 n +0000431485 00000 n +0000430841 00000 n +0000427288 00000 n +0000431295 00000 n +0000431421 00000 n +0000435086 00000 n +0000435237 00000 n +0000435513 00000 n +0000434933 00000 n +0000431596 00000 n +0000435389 00000 n +0000438071 00000 n +0000438347 00000 n +0000437927 00000 n +0000435624 00000 n +0000438221 00000 n +0000444597 00000 n +0000444746 00000 n +0000445023 00000 n +0000444444 00000 n +0000438458 00000 n +0000444898 00000 n +0000447122 00000 n +0000446807 00000 n +0000445160 00000 n +0000446930 00000 n +0000446994 00000 n +0000447058 00000 n +0000452306 00000 n +0000452457 00000 n +0000452918 00000 n +0000452153 00000 n +0000447207 00000 n +0000452605 00000 n +0000452729 00000 n +0000452792 00000 n +0000452855 00000 n +0000887903 00000 n +0000459965 00000 n +0000460117 00000 n +0000460266 00000 n +0000460544 00000 n +0000459803 00000 n +0000453042 00000 n +0000460418 00000 n +0000464294 00000 n +0000463730 00000 n +0000460668 00000 n +0000463853 00000 n +0000463916 00000 n +0000463979 00000 n +0000464042 00000 n +0000464105 00000 n +0000464168 00000 n +0000464231 00000 n +0000470616 00000 n +0000470767 00000 n +0000471171 00000 n +0000470463 00000 n +0000464405 00000 n +0000470916 00000 n +0000471043 00000 n +0000471107 00000 n +0000473226 00000 n +0000472851 00000 n +0000471282 00000 n +0000472974 00000 n +0000473037 00000 n +0000473100 00000 n +0000473163 00000 n +0000476607 00000 n +0000476755 00000 n +0000477032 00000 n +0000476454 00000 n +0000473311 00000 n +0000476906 00000 n +0000481346 00000 n +0000481496 00000 n +0000481836 00000 n +0000481193 00000 n +0000477143 00000 n +0000481648 00000 n +0000481773 00000 n +0000888028 00000 n +0000486753 00000 n +0000487030 00000 n +0000486609 00000 n +0000481947 00000 n +0000486904 00000 n +0000493518 00000 n +0000493794 00000 n +0000493374 00000 n +0000487154 00000 n +0000493670 00000 n +0000494851 00000 n +0000494536 00000 n +0000493918 00000 n +0000494659 00000 n +0000494723 00000 n +0000494787 00000 n +0000498018 00000 n +0000498292 00000 n +0000497874 00000 n +0000494936 00000 n +0000498168 00000 n +0000501486 00000 n +0000501764 00000 n +0000501342 00000 n +0000498403 00000 n +0000501638 00000 n +0000505619 00000 n +0000505372 00000 n +0000501875 00000 n +0000505495 00000 n +0000888153 00000 n +0000512507 00000 n +0000512783 00000 n +0000512363 00000 n +0000505756 00000 n +0000512657 00000 n +0000513971 00000 n +0000513659 00000 n +0000512907 00000 n +0000513782 00000 n +0000513845 00000 n +0000513908 00000 n +0000519996 00000 n +0000520273 00000 n +0000519852 00000 n +0000514056 00000 n +0000520147 00000 n +0000523865 00000 n +0000524204 00000 n +0000523721 00000 n +0000520397 00000 n +0000524017 00000 n +0000524141 00000 n +0000529508 00000 n +0000529849 00000 n +0000529364 00000 n +0000524328 00000 n +0000529659 00000 n +0000529785 00000 n +0000533410 00000 n +0000533749 00000 n +0000533266 00000 n +0000529973 00000 n +0000533562 00000 n +0000533686 00000 n +0000888278 00000 n +0000539062 00000 n +0000539403 00000 n +0000538918 00000 n +0000533873 00000 n +0000539213 00000 n +0000539339 00000 n +0000543552 00000 n +0000543953 00000 n +0000543408 00000 n +0000539527 00000 n +0000543703 00000 n +0000543827 00000 n +0000543890 00000 n +0000547922 00000 n +0000548326 00000 n +0000547778 00000 n +0000544064 00000 n +0000548072 00000 n +0000548198 00000 n +0000548262 00000 n +0000554423 00000 n +0000554698 00000 n +0000554279 00000 n +0000548437 00000 n +0000554573 00000 n +0000558972 00000 n +0000558593 00000 n +0000554822 00000 n +0000558716 00000 n +0000558780 00000 n +0000558844 00000 n +0000558908 00000 n +0000563440 00000 n +0000563590 00000 n +0000563742 00000 n +0000564016 00000 n +0000563278 00000 n +0000559096 00000 n +0000563892 00000 n +0000888403 00000 n +0000570216 00000 n +0000569966 00000 n +0000564140 00000 n +0000570089 00000 n +0000578178 00000 n +0000577426 00000 n +0000570340 00000 n +0000577549 00000 n +0000577612 00000 n +0000577675 00000 n +0000577738 00000 n +0000577801 00000 n +0000577864 00000 n +0000577927 00000 n +0000577989 00000 n +0000578052 00000 n +0000578115 00000 n +0000578797 00000 n +0000578547 00000 n +0000578301 00000 n +0000578670 00000 n +0000584881 00000 n +0000584508 00000 n +0000578882 00000 n +0000584631 00000 n +0000584755 00000 n +0000584818 00000 n +0000590093 00000 n +0000589716 00000 n +0000585018 00000 n +0000589839 00000 n +0000589966 00000 n +0000590029 00000 n +0000595081 00000 n +0000594645 00000 n +0000590230 00000 n +0000594768 00000 n +0000594892 00000 n +0000594955 00000 n +0000595018 00000 n +0000888528 00000 n +0000597686 00000 n +0000597437 00000 n +0000595218 00000 n +0000597560 00000 n +0000601123 00000 n +0000600876 00000 n +0000597797 00000 n +0000600999 00000 n +0000602770 00000 n +0000602521 00000 n +0000601260 00000 n +0000602644 00000 n +0000604671 00000 n +0000604424 00000 n +0000602881 00000 n +0000604547 00000 n +0000606447 00000 n +0000606198 00000 n +0000604782 00000 n +0000606321 00000 n +0000611416 00000 n +0000611169 00000 n +0000606558 00000 n +0000611292 00000 n +0000888653 00000 n +0000617189 00000 n +0000616812 00000 n +0000611553 00000 n +0000616935 00000 n +0000617061 00000 n +0000617125 00000 n +0000622910 00000 n +0000622537 00000 n +0000617326 00000 n +0000622660 00000 n +0000622784 00000 n +0000622847 00000 n +0000628667 00000 n +0000628290 00000 n +0000623047 00000 n +0000628413 00000 n +0000628539 00000 n +0000628603 00000 n +0000634476 00000 n +0000634103 00000 n +0000628804 00000 n +0000634226 00000 n +0000634350 00000 n +0000634413 00000 n +0000640323 00000 n +0000639946 00000 n +0000634613 00000 n +0000640069 00000 n +0000640195 00000 n +0000640259 00000 n +0000646175 00000 n +0000645866 00000 n +0000640460 00000 n +0000645989 00000 n +0000646113 00000 n +0000888778 00000 n +0000652048 00000 n +0000651736 00000 n +0000646312 00000 n +0000651859 00000 n +0000651985 00000 n +0000658784 00000 n +0000658935 00000 n +0000659211 00000 n +0000658631 00000 n +0000652185 00000 n +0000659086 00000 n +0000663397 00000 n +0000663461 00000 n +0000663524 00000 n +0000663210 00000 n +0000659309 00000 n +0000663333 00000 n +0000666887 00000 n +0000666640 00000 n +0000663622 00000 n +0000666763 00000 n +0000668456 00000 n +0000668206 00000 n +0000666998 00000 n +0000668329 00000 n +0000670122 00000 n +0000669874 00000 n +0000668567 00000 n +0000669997 00000 n +0000888903 00000 n +0000672257 00000 n +0000672007 00000 n +0000670233 00000 n +0000672130 00000 n +0000673201 00000 n +0000672953 00000 n +0000672368 00000 n +0000673076 00000 n +0000677932 00000 n +0000678208 00000 n +0000677788 00000 n +0000673299 00000 n +0000678081 00000 n +0000683400 00000 n +0000683675 00000 n +0000683256 00000 n +0000678319 00000 n +0000683550 00000 n +0000687218 00000 n +0000687494 00000 n +0000687074 00000 n +0000683786 00000 n +0000687367 00000 n +0000691174 00000 n +0000690926 00000 n +0000687605 00000 n +0000691049 00000 n +0000889028 00000 n +0000695210 00000 n +0000695486 00000 n +0000695066 00000 n +0000691285 00000 n +0000695359 00000 n +0000696815 00000 n +0000696567 00000 n +0000695597 00000 n +0000696690 00000 n +0000701793 00000 n +0000701945 00000 n +0000702289 00000 n +0000701640 00000 n +0000696926 00000 n +0000702100 00000 n +0000702226 00000 n +0000707405 00000 n +0000707554 00000 n +0000707705 00000 n +0000707857 00000 n +0000708132 00000 n +0000707234 00000 n +0000702451 00000 n +0000708008 00000 n +0000713452 00000 n +0000713603 00000 n +0000713881 00000 n +0000713299 00000 n +0000708243 00000 n +0000713755 00000 n +0000716199 00000 n +0000716476 00000 n +0000716055 00000 n +0000713992 00000 n +0000716351 00000 n +0000889153 00000 n +0000717505 00000 n +0000717255 00000 n +0000716587 00000 n +0000717378 00000 n +0000725043 00000 n +0000725193 00000 n +0000725468 00000 n +0000724890 00000 n +0000717603 00000 n +0000725344 00000 n +0000731516 00000 n +0000731731 00000 n +0000731372 00000 n +0000725630 00000 n +0000731667 00000 n +0000734579 00000 n +0000734393 00000 n +0000731855 00000 n +0000734516 00000 n +0000735004 00000 n +0000734817 00000 n +0000734677 00000 n +0000734940 00000 n +0000743062 00000 n +0000742068 00000 n +0000735076 00000 n +0000742191 00000 n +0000742254 00000 n +0000742317 00000 n +0000742812 00000 n +0000742875 00000 n +0000889278 00000 n +0000745014 00000 n +0000744637 00000 n +0000743173 00000 n +0000744760 00000 n +0000744950 00000 n +0000745099 00000 n +0000745552 00000 n +0000745886 00000 n +0000746242 00000 n +0000746268 00000 n +0000746779 00000 n +0000746817 00000 n +0000747512 00000 n +0000747869 00000 n +0000747949 00000 n +0000748325 00000 n +0000748967 00000 n +0000749631 00000 n +0000750259 00000 n +0000750902 00000 n +0000751192 00000 n +0000751845 00000 n +0000765982 00000 n +0000766429 00000 n +0000778828 00000 n +0000779256 00000 n +0000790363 00000 n +0000790698 00000 n +0000792784 00000 n +0000793006 00000 n +0000797565 00000 n +0000797812 00000 n +0000814551 00000 n +0000815084 00000 n +0000817360 00000 n +0000817592 00000 n +0000819975 00000 n +0000820213 00000 n +0000829895 00000 n +0000830272 00000 n +0000836262 00000 n +0000836582 00000 n +0000840632 00000 n +0000840976 00000 n +0000842599 00000 n +0000842835 00000 n +0000856345 00000 n +0000856721 00000 n +0000862994 00000 n +0000863262 00000 n +0000876484 00000 n +0000876945 00000 n +0000883933 00000 n +0000889367 00000 n +0000889487 00000 n +0000889609 00000 n +0000889735 00000 n +0000889852 00000 n +0000889944 00000 n +0000899763 00000 n +0000899950 00000 n +0000900135 00000 n +0000900318 00000 n +0000900496 00000 n +0000900665 00000 n +0000900836 00000 n +0000901006 00000 n +0000901177 00000 n +0000901347 00000 n +0000901520 00000 n +0000901695 00000 n +0000901872 00000 n +0000902047 00000 n +0000902224 00000 n +0000902398 00000 n +0000902572 00000 n +0000902749 00000 n +0000902924 00000 n +0000903101 00000 n +0000903287 00000 n +0000903488 00000 n +0000903711 00000 n +0000903896 00000 n +0000904076 00000 n +0000904256 00000 n +0000904441 00000 n +0000904624 00000 n +0000904809 00000 n +0000904991 00000 n +0000905171 00000 n +0000905340 00000 n +0000905511 00000 n +0000905681 00000 n +0000905852 00000 n +0000906022 00000 n +0000906193 00000 n +0000906363 00000 n +0000906538 00000 n +0000906713 00000 n +0000906890 00000 n +0000907064 00000 n +0000907238 00000 n +0000907415 00000 n +0000907590 00000 n +0000907767 00000 n +0000907942 00000 n +0000908131 00000 n +0000908334 00000 n +0000908535 00000 n +0000908738 00000 n +0000908938 00000 n +0000909138 00000 n +0000909341 00000 n +0000909542 00000 n +0000909745 00000 n +0000909946 00000 n +0000910149 00000 n +0000910350 00000 n +0000910553 00000 n +0000910754 00000 n +0000910950 00000 n +0000911135 00000 n +0000911336 00000 n +0000911567 00000 n +0000911766 00000 n +0000911941 00000 n +0000912110 00000 n +0000912228 00000 n +0000912344 00000 n +0000912460 00000 n +0000912577 00000 n +0000912694 00000 n +0000912810 00000 n +0000912925 00000 n +0000913045 00000 n +0000913169 00000 n +0000913293 00000 n +0000913413 00000 n +0000913484 00000 n +0000913602 00000 n +0000913718 00000 n +0000913800 00000 n +0000913840 00000 n +0000914077 00000 n trailer << /Size 1577 /Root 1575 0 R /Info 1576 0 R -/ID [ ] >> +/ID [<8AAD10DCAB737049A07541F2CDE03D7C> <8AAD10DCAB737049A07541F2CDE03D7C>] >> startxref -912104 +914719 %%EOF diff --git a/docs/src/Makefile b/docs/src/Makefile index 1c892674..ef473b89 100644 --- a/docs/src/Makefile +++ b/docs/src/Makefile @@ -138,7 +138,7 @@ PDF = $(join $(BASEFILE),.pdf) PS = $(join $(BASEFILE),.ps) GXS = $(join $(BASEFILE),.gxs) GLX = $(join $(BASEFILE),.glx) -TARGETPDF= ../psblas-2.3.1.pdf +TARGETPDF= ../psblas-3.0.pdf BASEHTML = $(patsubst %.tex,%,$(HTMLFILE)) HTML = $(join $(HTMLFILE),.html) HTMLDIR = ../html diff --git a/docs/src/penv.tex b/docs/src/penv.tex index 320e1379..7ae1f0ef 100644 --- a/docs/src/penv.tex +++ b/docs/src/penv.tex @@ -6,7 +6,7 @@ \addcontentsline{toc}{subsection}{psb\_init} \begin{verbatim} -call psb_init(icontxt, np) +call psb_init(icontxt, np, basectxt, ids) \end{verbatim} This subroutine initializes the PSBLAS parallel environment, defining @@ -19,14 +19,31 @@ Scope: {\bf global}.\\ Type: {\bf optional}.\\ Intent: {\bf in}.\\ Specified as: an integer value. \ -Default: use all available processes provided by the underlying -parallel environment. +Default: use all available processes. +\item[basectxt] the initial communication context. The new context + will be defined from the processes participating in the initial one.\\ + Scope: {\bf global}.\\ +Type: {\bf optional}.\\ +Intent: {\bf in}.\\ +Specified as: an integer value. \ +Default: use MPI\_COMM\_WORLD. +\item[ids] Identities of the processes to use for the new context; the + argument is ignored when \verb|np| is not specified. This allows the + processes in the new environment to be in an order different from the + original one.\\ + Scope: {\bf global}.\\ +Type: {\bf optional}.\\ +Intent: {\bf in}.\\ +Specified as: an integer array. \ +Default: use the indices $(0\dots np-1)$. \end{description} \begin{description} \item[\bf On Return] \item[icontxt] the communication context identifying the virtual - parallel machine.\\ + parallel machine. Note that this is always a duplicate of + \verb|basectxt|, so that library communications are completely + separated from other communication operations.\\ Scope: {\bf global}.\\ Type: {\bf required}.\\ Intent: {\bf out}.\\ @@ -38,7 +55,7 @@ Specified as: an integer variable. \begin{enumerate} \item A call to this routine must precede any other PSBLAS call. \item It is an error to specify a value for $np$ greater than the - number of processes available in the underlying parallel execution + number of processes available in the underlying base parallel environment. \end{enumerate} diff --git a/docs/src/userguide.tex b/docs/src/userguide.tex index d8621c01..3d272d57 100644 --- a/docs/src/userguide.tex +++ b/docs/src/userguide.tex @@ -24,7 +24,7 @@ \relax \pdfcompresslevel=0 %-- 0 = none, 9 = best \pdfinfo{ %-- Info dictionary of PDF output /Author (Alfredo Buttari) - /Title (Parallel Sparse BLAS V. 2.3.1) + /Title (Parallel Sparse BLAS V. 3.0-beta) /Subject (Parallel Sparse Basic Linear Algebra Subroutines) /Keywords (Computer Science Linear Algebra Fluid Dynamics Parallel Linux MPI PSBLAS Iterative Solvers Preconditioners) /Creator (pdfLaTeX) @@ -77,7 +77,7 @@ \begin{document} -\pdfbookmark{PSBLAS-v2.3.1 User's Guide}{title} +\pdfbookmark{PSBLAS-v3.0-beta User's Guide}{title} \newlength{\centeroffset} \setlength{\centeroffset}{-0.5\oddsidemargin} @@ -87,7 +87,7 @@ \vspace*{\stretch{1}} \noindent\hspace*{\centeroffset}\makebox[0pt][l]{\begin{minipage}{\textwidth} \flushright -{\Huge\bfseries PSBLAS 2.3.1 User's guide +{\Huge\bfseries PSBLAS 3.0-beta User's guide } \noindent\rule[-1ex]{\textwidth}{5pt}\\[2.5ex] \hfill\emph{\Large A reference guide for the Parallel Sparse BLAS library} @@ -100,7 +100,7 @@ by Salvatore Filippone\\ and Alfredo Buttari}\\ University of Rome ``Tor Vergata''.\\[3ex] -September 30th, 2008. +May 15th, 2010. \end{minipage}} %\addtolength{\textwidth}{\centeroffset} diff --git a/docs/src/userhtml.tex b/docs/src/userhtml.tex index bbe87921..a4eed4bd 100644 --- a/docs/src/userhtml.tex +++ b/docs/src/userhtml.tex @@ -23,7 +23,7 @@ % \relax % \pdfcompresslevel=0 %-- 0 = none, 9 = best % \pdfinfo{ %-- Info dictionary of PDF output /Author (Alfredo Buttari) -% /Title (Parallel Sparse BLAS V. 2.3.1) +% /Title (Parallel Sparse BLAS V. 3.0) % /Subject (Parallel Sparse Basic Linear Algebra Subroutines) % /Keywords (Computer Science Linear Algebra Fluid Dynamics Parallel Linux MPI PSBLAS Iterative Solvers Preconditioners) % /Creator (pdfLaTeX) @@ -83,9 +83,9 @@ University of Rome ``Tor Vergata'', Italy\\[2ex] %\\[10ex] %\today -Software version: 2.3.1\\ +Software version: 3.0-beta\\ %\today -September 30th, 2008 +May 15th, 2010 \cleardoublepage \begingroup \renewcommand*{\thepage}{toc} diff --git a/test/serial/Makefile b/test/serial/Makefile index 1892f1c0..d2613410 100644 --- a/test/serial/Makefile +++ b/test/serial/Makefile @@ -3,7 +3,8 @@ include ../../Make.inc # Libraries used # LIBDIR=../../lib/ -PSBLAS_LIB= -L$(LIBDIR) -lpsb_util -lpsb_krylov -lpsb_prec -lpsb_base +PSBLAS_LIB= -L$(LIBDIR) -lpsb_base +#-lpsb_util -lpsb_krylov -lpsb_prec -lpsb_base LDLIBS=$(PSBLDLIBS) # # Compilers and such diff --git a/test/serial/d_coo_matgen.f03 b/test/serial/d_coo_matgen.f03 index d36ca76a..a68f346d 100644 --- a/test/serial/d_coo_matgen.f03 +++ b/test/serial/d_coo_matgen.f03 @@ -1,8 +1,8 @@ ! program d_coo_matgen use psb_sparse_mod - use psb_prec_mod - use psb_krylov_mod +!!$ use psb_prec_mod +!!$ use psb_krylov_mod use psb_d_base_mat_mod use psb_d_csr_mat_mod implicit none @@ -18,7 +18,7 @@ program d_coo_matgen ! sparse matrix and preconditioner type(psb_d_sparse_mat) :: a - type(psb_dprec_type) :: prec +!!$ type(psb_dprec_type) :: prec ! descriptor type(psb_desc_type) :: desc_a ! dense matrices @@ -138,6 +138,8 @@ contains ! Note that if a1=a2=a3=a4=0., the PDE is the well-known Laplace equation. ! use psb_sparse_mod + use psb_d_base_mat_mod + use psb_d_csr_mat_mod implicit none integer :: idim integer, parameter :: nb=20 @@ -195,6 +197,7 @@ contains nlr = nt call psb_barrier(ictxt) + call acoo%set_null() t0 = psb_wtime() call acoo%allocate(nr,nr) diff --git a/test/serial/d_matgen.f03 b/test/serial/d_matgen.f03 index 989987c0..2b756fe4 100644 --- a/test/serial/d_matgen.f03 +++ b/test/serial/d_matgen.f03 @@ -1,8 +1,8 @@ ! program d_matgen use psb_sparse_mod - use psb_prec_mod - use psb_krylov_mod +!!$ use psb_prec_mod +!!$ use psb_krylov_mod use psb_d_base_mat_mod use psb_d_csr_mat_mod use psb_d_mat_mod @@ -19,7 +19,7 @@ program d_matgen ! sparse matrix and preconditioner type(psb_d_sparse_mat) :: a - type(psb_dprec_type) :: prec +!!$ type(psb_dprec_type) :: prec ! descriptor type(psb_desc_type) :: desc_a ! dense matrices @@ -382,13 +382,13 @@ contains call a_n%print(20) anorm = a_n%csnmi() write(0,*) 'Nrm infinity ',anorm - call a_n%csget(2,3,element,irow,icol,val,info) - write(0,*) 'From csget ',element,info - if (info == psb_success_) then - do i=1,element - write(0,*) irow(i),icol(i),val(i) - end do - end if +!!$ call a_n%csget(2,3,element,irow,icol,val,info) +!!$ write(0,*) 'From csget ',element,info +!!$ if (info == psb_success_) then +!!$ do i=1,element +!!$ write(0,*) irow(i),icol(i),val(i) +!!$ end do +!!$ end if isz = a_n%get_size() write(0,*) 'Size 1: ',isz @@ -404,7 +404,7 @@ contains end if !!$ t1 = psb_wtime() - call a_n%cscnv(info,mold=acxx) + call a_n%cscnv(info,mold=acsr) if(info /= psb_success_) then info=psb_err_from_subroutine_ diff --git a/test/torture/Makefile b/test/torture/Makefile index c853fbed..801ee306 100644 --- a/test/torture/Makefile +++ b/test/torture/Makefile @@ -3,7 +3,7 @@ include ../../Make.inc # Libraries used # LIBDIR=../../lib/ -PSBLAS_LIB= -L$(LIBDIR) -lpsb_util -lpsb_krylov -lpsb_prec -lpsb_base +PSBLAS_LIB= -L$(LIBDIR) -lpsb_base LDLIBS=$(PSBLDLIBS) # # Compilers and such @@ -11,17 +11,29 @@ LDLIBS=$(PSBLDLIBS) CCOPT= -g FINCLUDES=$(FMFLAG)$(LIBDIR) $(FMFLAG). -PSBTOBJS=psb_mvsv_tester.o psbtf.o +PSBTOBJS=psbtf.o psb_mvsv_tester.o \ + psb_s_mvsv_tester.o psb_d_mvsv_tester.o psb_c_mvsv_tester.o \ + psb_z_mvsv_tester.o EXEDIR=./runs all: psbtf +psbtf.o: psb_mvsv_tester.o +psb_mvsv_tester.o: psb_s_mvsv_tester.o psb_d_mvsv_tester.o psb_c_mvsv_tester.o \ + psb_z_mvsv_tester.o psbtf: $(PSBTOBJS) $(F90LINK) $(PSBTOBJS) -o psbtf $(PSBLAS_LIB) $(LDLIBS) /bin/mv psbtf $(EXEDIR) psbtf.o: psb_mvsv_tester.o + + +psbt1: psbt1.o + $(F90LINK) psbt1.o -o psbt1 $(PSBLAS_LIB) $(LDLIBS) + /bin/mv psbt1 $(EXEDIR) + + .f90.o: $(MPF90) $(F90COPT) $(FINCLUDES) $(FDEFINES) -c $< diff --git a/test/torture/psb_mvsv_tester.f90 b/test/torture/psb_mvsv_tester.f90 index 5963a75f..f997bf01 100644 --- a/test/torture/psb_mvsv_tester.f90 +++ b/test/torture/psb_mvsv_tester.f90 @@ -1,11089 +1,6 @@ module psb_mvsv_tester - -contains -subroutine s_usmv_2_n_ap3_bp1_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_s_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='n' - integer :: incx=1 - integer :: incy=1 - real*4 :: alpha=3 - real*4 :: beta=1 - ! 1 1 - ! 0 1 - - ! declaration of VA,IA,JA - integer :: nnz=3 - integer :: m=2 - integer :: k=2 - integer :: IA(3)=(/1, 1, 2/) - integer :: JA(3)=(/1, 2, 2/) - real*4 :: VA(3)=(/1, 1, 1/) - real*4 :: x(2)=(/1, 1/)! reference x - real*4 :: cy(2)=(/9, 6/)! reference cy after - real*4 :: bcy(2)=(/3, 3/)! reference bcy before - real*4 :: y(2)=(/3, 3/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spmm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on s matrix 2 x 2 blocked 1 x 1 usmv alpha= 3 beta= 1 incx=1 incy=1 trans=n is not ok" - if(res == 0)print*,"on s matrix 2 x 2 blocked 1 x 1 usmv alpha= 3 beta= 1 incx=1 incy=1 trans=n is ok" -end subroutine s_usmv_2_n_ap3_bp1_ix1_iy1 -! - -subroutine s_usmv_2_t_ap3_bp1_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_s_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='t' - integer :: incx=1 - integer :: incy=1 - real*4 :: alpha=3 - real*4 :: beta=1 - ! 1 0 - ! 1 0 - - ! declaration of VA,IA,JA - integer :: nnz=2 - integer :: m=2 - integer :: k=2 - integer :: IA(2)=(/1, 2/) - integer :: JA(2)=(/1, 1/) - real*4 :: VA(2)=(/1, 1/) - real*4 :: x(2)=(/1, 1/)! reference x - real*4 :: cy(2)=(/9, 3/)! reference cy after - real*4 :: bcy(2)=(/3, 3/)! reference bcy before - real*4 :: y(2)=(/3, 3/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spmm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on s matrix 2 x 2 blocked 1 x 1 usmv alpha= 3 beta= 1 incx=1 incy=1 trans=t is not ok" - if(res == 0)print*,"on s matrix 2 x 2 blocked 1 x 1 usmv alpha= 3 beta= 1 incx=1 incy=1 trans=t is ok" -end subroutine s_usmv_2_t_ap3_bp1_ix1_iy1 -! - -subroutine s_usmv_2_c_ap3_bp1_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_s_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='c' - integer :: incx=1 - integer :: incy=1 - real*4 :: alpha=3 - real*4 :: beta=1 - ! 1 2 - ! 0 6 - - ! declaration of VA,IA,JA - integer :: nnz=3 - integer :: m=2 - integer :: k=2 - integer :: IA(3)=(/1, 1, 2/) - integer :: JA(3)=(/1, 2, 2/) - real*4 :: VA(3)=(/1, 2, 6/) - real*4 :: x(2)=(/1, 1/)! reference x - real*4 :: cy(2)=(/6, 27/)! reference cy after - real*4 :: bcy(2)=(/3, 3/)! reference bcy before - real*4 :: y(2)=(/3, 3/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spmm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on s matrix 2 x 2 blocked 1 x 1 usmv alpha= 3 beta= 1 incx=1 incy=1 trans=c is not ok" - if(res == 0)print*,"on s matrix 2 x 2 blocked 1 x 1 usmv alpha= 3 beta= 1 incx=1 incy=1 trans=c is ok" -end subroutine s_usmv_2_c_ap3_bp1_ix1_iy1 -! - -subroutine s_usmv_2_n_ap3_bm0_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_s_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='n' - integer :: incx=1 - integer :: incy=1 - real*4 :: alpha=3 - real*4 :: beta=0 - ! 1 2 - ! 0 0 - - ! declaration of VA,IA,JA - integer :: nnz=2 - integer :: m=2 - integer :: k=2 - integer :: IA(2)=(/1, 1/) - integer :: JA(2)=(/1, 2/) - real*4 :: VA(2)=(/1, 2/) - real*4 :: x(2)=(/1, 1/)! reference x - real*4 :: cy(2)=(/9, 0/)! reference cy after - real*4 :: bcy(2)=(/3, 3/)! reference bcy before - real*4 :: y(2)=(/3, 3/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spmm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on s matrix 2 x 2 blocked 1 x 1 usmv alpha= 3 beta= 0 incx=1 incy=1 trans=n is not ok" - if(res == 0)print*,"on s matrix 2 x 2 blocked 1 x 1 usmv alpha= 3 beta= 0 incx=1 incy=1 trans=n is ok" -end subroutine s_usmv_2_n_ap3_bm0_ix1_iy1 -! - -subroutine s_usmv_2_t_ap3_bm0_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_s_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='t' - integer :: incx=1 - integer :: incy=1 - real*4 :: alpha=3 - real*4 :: beta=0 - ! 1 3 - ! 2 0 - - ! declaration of VA,IA,JA - integer :: nnz=3 - integer :: m=2 - integer :: k=2 - integer :: IA(3)=(/1, 1, 2/) - integer :: JA(3)=(/1, 2, 1/) - real*4 :: VA(3)=(/1, 3, 2/) - real*4 :: x(2)=(/1, 1/)! reference x - real*4 :: cy(2)=(/9, 9/)! reference cy after - real*4 :: bcy(2)=(/3, 3/)! reference bcy before - real*4 :: y(2)=(/3, 3/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spmm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on s matrix 2 x 2 blocked 1 x 1 usmv alpha= 3 beta= 0 incx=1 incy=1 trans=t is not ok" - if(res == 0)print*,"on s matrix 2 x 2 blocked 1 x 1 usmv alpha= 3 beta= 0 incx=1 incy=1 trans=t is ok" -end subroutine s_usmv_2_t_ap3_bm0_ix1_iy1 -! - -subroutine s_usmv_2_c_ap3_bm0_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_s_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='c' - integer :: incx=1 - integer :: incy=1 - real*4 :: alpha=3 - real*4 :: beta=0 - ! 1 0 - ! 1 0 - - ! declaration of VA,IA,JA - integer :: nnz=2 - integer :: m=2 - integer :: k=2 - integer :: IA(2)=(/1, 2/) - integer :: JA(2)=(/1, 1/) - real*4 :: VA(2)=(/1, 1/) - real*4 :: x(2)=(/1, 1/)! reference x - real*4 :: cy(2)=(/6, 0/)! reference cy after - real*4 :: bcy(2)=(/3, 3/)! reference bcy before - real*4 :: y(2)=(/3, 3/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spmm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on s matrix 2 x 2 blocked 1 x 1 usmv alpha= 3 beta= 0 incx=1 incy=1 trans=c is not ok" - if(res == 0)print*,"on s matrix 2 x 2 blocked 1 x 1 usmv alpha= 3 beta= 0 incx=1 incy=1 trans=c is ok" -end subroutine s_usmv_2_c_ap3_bm0_ix1_iy1 -! - -subroutine s_usmv_2_n_ap1_bp1_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_s_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='n' - integer :: incx=1 - integer :: incy=1 - real*4 :: alpha=1 - real*4 :: beta=1 - ! 1 0 - ! 0 0 - - ! declaration of VA,IA,JA - integer :: nnz=1 - integer :: m=2 - integer :: k=2 - integer :: IA(1)=(/1/) - integer :: JA(1)=(/1/) - real*4 :: VA(1)=(/1/) - real*4 :: x(2)=(/1, 1/)! reference x - real*4 :: cy(2)=(/4, 3/)! reference cy after - real*4 :: bcy(2)=(/3, 3/)! reference bcy before - real*4 :: y(2)=(/3, 3/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spmm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on s matrix 2 x 2 blocked 1 x 1 usmv alpha= 1 beta= 1 incx=1 incy=1 trans=n is not ok" - if(res == 0)print*,"on s matrix 2 x 2 blocked 1 x 1 usmv alpha= 1 beta= 1 incx=1 incy=1 trans=n is ok" -end subroutine s_usmv_2_n_ap1_bp1_ix1_iy1 -! - -subroutine s_usmv_2_t_ap1_bp1_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_s_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='t' - integer :: incx=1 - integer :: incy=1 - real*4 :: alpha=1 - real*4 :: beta=1 - ! 1 0 - ! 1 0 - - ! declaration of VA,IA,JA - integer :: nnz=2 - integer :: m=2 - integer :: k=2 - integer :: IA(2)=(/1, 2/) - integer :: JA(2)=(/1, 1/) - real*4 :: VA(2)=(/1, 1/) - real*4 :: x(2)=(/1, 1/)! reference x - real*4 :: cy(2)=(/5, 3/)! reference cy after - real*4 :: bcy(2)=(/3, 3/)! reference bcy before - real*4 :: y(2)=(/3, 3/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spmm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on s matrix 2 x 2 blocked 1 x 1 usmv alpha= 1 beta= 1 incx=1 incy=1 trans=t is not ok" - if(res == 0)print*,"on s matrix 2 x 2 blocked 1 x 1 usmv alpha= 1 beta= 1 incx=1 incy=1 trans=t is ok" -end subroutine s_usmv_2_t_ap1_bp1_ix1_iy1 -! - -subroutine s_usmv_2_c_ap1_bp1_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_s_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='c' - integer :: incx=1 - integer :: incy=1 - real*4 :: alpha=1 - real*4 :: beta=1 - ! 1 2 - ! 5 1 - - ! declaration of VA,IA,JA - integer :: nnz=4 - integer :: m=2 - integer :: k=2 - integer :: IA(4)=(/1, 1, 2, 2/) - integer :: JA(4)=(/1, 2, 1, 2/) - real*4 :: VA(4)=(/1, 2, 5, 1/) - real*4 :: x(2)=(/1, 1/)! reference x - real*4 :: cy(2)=(/9, 6/)! reference cy after - real*4 :: bcy(2)=(/3, 3/)! reference bcy before - real*4 :: y(2)=(/3, 3/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spmm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on s matrix 2 x 2 blocked 1 x 1 usmv alpha= 1 beta= 1 incx=1 incy=1 trans=c is not ok" - if(res == 0)print*,"on s matrix 2 x 2 blocked 1 x 1 usmv alpha= 1 beta= 1 incx=1 incy=1 trans=c is ok" -end subroutine s_usmv_2_c_ap1_bp1_ix1_iy1 -! - -subroutine s_usmv_2_n_ap1_bm0_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_s_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='n' - integer :: incx=1 - integer :: incy=1 - real*4 :: alpha=1 - real*4 :: beta=0 - ! 1 1 - ! 2 0 - - ! declaration of VA,IA,JA - integer :: nnz=3 - integer :: m=2 - integer :: k=2 - integer :: IA(3)=(/1, 1, 2/) - integer :: JA(3)=(/1, 2, 1/) - real*4 :: VA(3)=(/1, 1, 2/) - real*4 :: x(2)=(/1, 1/)! reference x - real*4 :: cy(2)=(/2, 2/)! reference cy after - real*4 :: bcy(2)=(/3, 3/)! reference bcy before - real*4 :: y(2)=(/3, 3/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spmm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on s matrix 2 x 2 blocked 1 x 1 usmv alpha= 1 beta= 0 incx=1 incy=1 trans=n is not ok" - if(res == 0)print*,"on s matrix 2 x 2 blocked 1 x 1 usmv alpha= 1 beta= 0 incx=1 incy=1 trans=n is ok" -end subroutine s_usmv_2_n_ap1_bm0_ix1_iy1 -! - -subroutine s_usmv_2_t_ap1_bm0_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_s_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='t' - integer :: incx=1 - integer :: incy=1 - real*4 :: alpha=1 - real*4 :: beta=0 - ! 1 3 - ! 1 1 - - ! declaration of VA,IA,JA - integer :: nnz=4 - integer :: m=2 - integer :: k=2 - integer :: IA(4)=(/1, 1, 2, 2/) - integer :: JA(4)=(/1, 2, 1, 2/) - real*4 :: VA(4)=(/1, 3, 1, 1/) - real*4 :: x(2)=(/1, 1/)! reference x - real*4 :: cy(2)=(/2, 4/)! reference cy after - real*4 :: bcy(2)=(/3, 3/)! reference bcy before - real*4 :: y(2)=(/3, 3/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spmm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on s matrix 2 x 2 blocked 1 x 1 usmv alpha= 1 beta= 0 incx=1 incy=1 trans=t is not ok" - if(res == 0)print*,"on s matrix 2 x 2 blocked 1 x 1 usmv alpha= 1 beta= 0 incx=1 incy=1 trans=t is ok" -end subroutine s_usmv_2_t_ap1_bm0_ix1_iy1 -! - -subroutine s_usmv_2_c_ap1_bm0_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_s_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='c' - integer :: incx=1 - integer :: incy=1 - real*4 :: alpha=1 - real*4 :: beta=0 - ! 1 0 - ! 2 1 - - ! declaration of VA,IA,JA - integer :: nnz=3 - integer :: m=2 - integer :: k=2 - integer :: IA(3)=(/1, 2, 2/) - integer :: JA(3)=(/1, 1, 2/) - real*4 :: VA(3)=(/1, 2, 1/) - real*4 :: x(2)=(/1, 1/)! reference x - real*4 :: cy(2)=(/3, 1/)! reference cy after - real*4 :: bcy(2)=(/3, 3/)! reference bcy before - real*4 :: y(2)=(/3, 3/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spmm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on s matrix 2 x 2 blocked 1 x 1 usmv alpha= 1 beta= 0 incx=1 incy=1 trans=c is not ok" - if(res == 0)print*,"on s matrix 2 x 2 blocked 1 x 1 usmv alpha= 1 beta= 0 incx=1 incy=1 trans=c is ok" -end subroutine s_usmv_2_c_ap1_bm0_ix1_iy1 -! - -subroutine s_usmv_2_n_am1_bp1_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_s_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='n' - integer :: incx=1 - integer :: incy=1 - real*4 :: alpha=-1 - real*4 :: beta=1 - ! 1 3 - ! 0 0 - - ! declaration of VA,IA,JA - integer :: nnz=2 - integer :: m=2 - integer :: k=2 - integer :: IA(2)=(/1, 1/) - integer :: JA(2)=(/1, 2/) - real*4 :: VA(2)=(/1, 3/) - real*4 :: x(2)=(/1, 1/)! reference x - real*4 :: cy(2)=(/-1, 3/)! reference cy after - real*4 :: bcy(2)=(/3, 3/)! reference bcy before - real*4 :: y(2)=(/3, 3/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spmm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on s matrix 2 x 2 blocked 1 x 1 usmv alpha=-1 beta= 1 incx=1 incy=1 trans=n is not ok" - if(res == 0)print*,"on s matrix 2 x 2 blocked 1 x 1 usmv alpha=-1 beta= 1 incx=1 incy=1 trans=n is ok" -end subroutine s_usmv_2_n_am1_bp1_ix1_iy1 -! - -subroutine s_usmv_2_t_am1_bp1_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_s_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='t' - integer :: incx=1 - integer :: incy=1 - real*4 :: alpha=-1 - real*4 :: beta=1 - ! 1 1 - ! 0 0 - - ! declaration of VA,IA,JA - integer :: nnz=2 - integer :: m=2 - integer :: k=2 - integer :: IA(2)=(/1, 1/) - integer :: JA(2)=(/1, 2/) - real*4 :: VA(2)=(/1, 1/) - real*4 :: x(2)=(/1, 1/)! reference x - real*4 :: cy(2)=(/2, 2/)! reference cy after - real*4 :: bcy(2)=(/3, 3/)! reference bcy before - real*4 :: y(2)=(/3, 3/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spmm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on s matrix 2 x 2 blocked 1 x 1 usmv alpha=-1 beta= 1 incx=1 incy=1 trans=t is not ok" - if(res == 0)print*,"on s matrix 2 x 2 blocked 1 x 1 usmv alpha=-1 beta= 1 incx=1 incy=1 trans=t is ok" -end subroutine s_usmv_2_t_am1_bp1_ix1_iy1 -! - -subroutine s_usmv_2_c_am1_bp1_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_s_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='c' - integer :: incx=1 - integer :: incy=1 - real*4 :: alpha=-1 - real*4 :: beta=1 - ! 1 0 - ! 1 2 - - ! declaration of VA,IA,JA - integer :: nnz=3 - integer :: m=2 - integer :: k=2 - integer :: IA(3)=(/1, 2, 2/) - integer :: JA(3)=(/1, 1, 2/) - real*4 :: VA(3)=(/1, 1, 2/) - real*4 :: x(2)=(/1, 1/)! reference x - real*4 :: cy(2)=(/1, 1/)! reference cy after - real*4 :: bcy(2)=(/3, 3/)! reference bcy before - real*4 :: y(2)=(/3, 3/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spmm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on s matrix 2 x 2 blocked 1 x 1 usmv alpha=-1 beta= 1 incx=1 incy=1 trans=c is not ok" - if(res == 0)print*,"on s matrix 2 x 2 blocked 1 x 1 usmv alpha=-1 beta= 1 incx=1 incy=1 trans=c is ok" -end subroutine s_usmv_2_c_am1_bp1_ix1_iy1 -! - -subroutine s_usmv_2_n_am1_bm0_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_s_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='n' - integer :: incx=1 - integer :: incy=1 - real*4 :: alpha=-1 - real*4 :: beta=0 - ! 1 0 - ! 1 1 - - ! declaration of VA,IA,JA - integer :: nnz=3 - integer :: m=2 - integer :: k=2 - integer :: IA(3)=(/1, 2, 2/) - integer :: JA(3)=(/1, 1, 2/) - real*4 :: VA(3)=(/1, 1, 1/) - real*4 :: x(2)=(/1, 1/)! reference x - real*4 :: cy(2)=(/-1, -2/)! reference cy after - real*4 :: bcy(2)=(/3, 3/)! reference bcy before - real*4 :: y(2)=(/3, 3/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spmm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on s matrix 2 x 2 blocked 1 x 1 usmv alpha=-1 beta= 0 incx=1 incy=1 trans=n is not ok" - if(res == 0)print*,"on s matrix 2 x 2 blocked 1 x 1 usmv alpha=-1 beta= 0 incx=1 incy=1 trans=n is ok" -end subroutine s_usmv_2_n_am1_bm0_ix1_iy1 -! - -subroutine s_usmv_2_t_am1_bm0_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_s_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='t' - integer :: incx=1 - integer :: incy=1 - real*4 :: alpha=-1 - real*4 :: beta=0 - ! 1 4 - ! 3 1 - - ! declaration of VA,IA,JA - integer :: nnz=4 - integer :: m=2 - integer :: k=2 - integer :: IA(4)=(/1, 1, 2, 2/) - integer :: JA(4)=(/1, 2, 1, 2/) - real*4 :: VA(4)=(/1, 4, 3, 1/) - real*4 :: x(2)=(/1, 1/)! reference x - real*4 :: cy(2)=(/-4, -5/)! reference cy after - real*4 :: bcy(2)=(/3, 3/)! reference bcy before - real*4 :: y(2)=(/3, 3/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spmm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on s matrix 2 x 2 blocked 1 x 1 usmv alpha=-1 beta= 0 incx=1 incy=1 trans=t is not ok" - if(res == 0)print*,"on s matrix 2 x 2 blocked 1 x 1 usmv alpha=-1 beta= 0 incx=1 incy=1 trans=t is ok" -end subroutine s_usmv_2_t_am1_bm0_ix1_iy1 -! - -subroutine s_usmv_2_c_am1_bm0_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_s_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='c' - integer :: incx=1 - integer :: incy=1 - real*4 :: alpha=-1 - real*4 :: beta=0 - ! 1 1 - ! 0 1 - - ! declaration of VA,IA,JA - integer :: nnz=3 - integer :: m=2 - integer :: k=2 - integer :: IA(3)=(/1, 1, 2/) - integer :: JA(3)=(/1, 2, 2/) - real*4 :: VA(3)=(/1, 1, 1/) - real*4 :: x(2)=(/1, 1/)! reference x - real*4 :: cy(2)=(/-1, -2/)! reference cy after - real*4 :: bcy(2)=(/3, 3/)! reference bcy before - real*4 :: y(2)=(/3, 3/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spmm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on s matrix 2 x 2 blocked 1 x 1 usmv alpha=-1 beta= 0 incx=1 incy=1 trans=c is not ok" - if(res == 0)print*,"on s matrix 2 x 2 blocked 1 x 1 usmv alpha=-1 beta= 0 incx=1 incy=1 trans=c is ok" -end subroutine s_usmv_2_c_am1_bm0_ix1_iy1 -! - -subroutine s_usmv_2_n_am3_bp1_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_s_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='n' - integer :: incx=1 - integer :: incy=1 - real*4 :: alpha=-3 - real*4 :: beta=1 - ! 1 3 - ! 0 1 - - ! declaration of VA,IA,JA - integer :: nnz=3 - integer :: m=2 - integer :: k=2 - integer :: IA(3)=(/1, 1, 2/) - integer :: JA(3)=(/1, 2, 2/) - real*4 :: VA(3)=(/1, 3, 1/) - real*4 :: x(2)=(/1, 1/)! reference x - real*4 :: cy(2)=(/-9, 0/)! reference cy after - real*4 :: bcy(2)=(/3, 3/)! reference bcy before - real*4 :: y(2)=(/3, 3/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spmm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on s matrix 2 x 2 blocked 1 x 1 usmv alpha=-3 beta= 1 incx=1 incy=1 trans=n is not ok" - if(res == 0)print*,"on s matrix 2 x 2 blocked 1 x 1 usmv alpha=-3 beta= 1 incx=1 incy=1 trans=n is ok" -end subroutine s_usmv_2_n_am3_bp1_ix1_iy1 -! - -subroutine s_usmv_2_t_am3_bp1_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_s_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='t' - integer :: incx=1 - integer :: incy=1 - real*4 :: alpha=-3 - real*4 :: beta=1 - ! 1 4 - ! 1 0 - - ! declaration of VA,IA,JA - integer :: nnz=3 - integer :: m=2 - integer :: k=2 - integer :: IA(3)=(/1, 1, 2/) - integer :: JA(3)=(/1, 2, 1/) - real*4 :: VA(3)=(/1, 4, 1/) - real*4 :: x(2)=(/1, 1/)! reference x - real*4 :: cy(2)=(/-3, -9/)! reference cy after - real*4 :: bcy(2)=(/3, 3/)! reference bcy before - real*4 :: y(2)=(/3, 3/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spmm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on s matrix 2 x 2 blocked 1 x 1 usmv alpha=-3 beta= 1 incx=1 incy=1 trans=t is not ok" - if(res == 0)print*,"on s matrix 2 x 2 blocked 1 x 1 usmv alpha=-3 beta= 1 incx=1 incy=1 trans=t is ok" -end subroutine s_usmv_2_t_am3_bp1_ix1_iy1 -! - -subroutine s_usmv_2_c_am3_bp1_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_s_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='c' - integer :: incx=1 - integer :: incy=1 - real*4 :: alpha=-3 - real*4 :: beta=1 - ! 1 1 - ! 0 1 - - ! declaration of VA,IA,JA - integer :: nnz=3 - integer :: m=2 - integer :: k=2 - integer :: IA(3)=(/1, 1, 2/) - integer :: JA(3)=(/1, 2, 2/) - real*4 :: VA(3)=(/1, 1, 1/) - real*4 :: x(2)=(/1, 1/)! reference x - real*4 :: cy(2)=(/0, -3/)! reference cy after - real*4 :: bcy(2)=(/3, 3/)! reference bcy before - real*4 :: y(2)=(/3, 3/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spmm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on s matrix 2 x 2 blocked 1 x 1 usmv alpha=-3 beta= 1 incx=1 incy=1 trans=c is not ok" - if(res == 0)print*,"on s matrix 2 x 2 blocked 1 x 1 usmv alpha=-3 beta= 1 incx=1 incy=1 trans=c is ok" -end subroutine s_usmv_2_c_am3_bp1_ix1_iy1 -! - -subroutine s_usmv_2_n_am3_bm0_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_s_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='n' - integer :: incx=1 - integer :: incy=1 - real*4 :: alpha=-3 - real*4 :: beta=0 - ! 1 0 - ! 2 0 - - ! declaration of VA,IA,JA - integer :: nnz=2 - integer :: m=2 - integer :: k=2 - integer :: IA(2)=(/1, 2/) - integer :: JA(2)=(/1, 1/) - real*4 :: VA(2)=(/1, 2/) - real*4 :: x(2)=(/1, 1/)! reference x - real*4 :: cy(2)=(/-3, -6/)! reference cy after - real*4 :: bcy(2)=(/3, 3/)! reference bcy before - real*4 :: y(2)=(/3, 3/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spmm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on s matrix 2 x 2 blocked 1 x 1 usmv alpha=-3 beta= 0 incx=1 incy=1 trans=n is not ok" - if(res == 0)print*,"on s matrix 2 x 2 blocked 1 x 1 usmv alpha=-3 beta= 0 incx=1 incy=1 trans=n is ok" -end subroutine s_usmv_2_n_am3_bm0_ix1_iy1 -! - -subroutine s_usmv_2_t_am3_bm0_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_s_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='t' - integer :: incx=1 - integer :: incy=1 - real*4 :: alpha=-3 - real*4 :: beta=0 - ! 1 0 - ! 0 0 - - ! declaration of VA,IA,JA - integer :: nnz=1 - integer :: m=2 - integer :: k=2 - integer :: IA(1)=(/1/) - integer :: JA(1)=(/1/) - real*4 :: VA(1)=(/1/) - real*4 :: x(2)=(/1, 1/)! reference x - real*4 :: cy(2)=(/-3, 0/)! reference cy after - real*4 :: bcy(2)=(/3, 3/)! reference bcy before - real*4 :: y(2)=(/3, 3/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spmm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on s matrix 2 x 2 blocked 1 x 1 usmv alpha=-3 beta= 0 incx=1 incy=1 trans=t is not ok" - if(res == 0)print*,"on s matrix 2 x 2 blocked 1 x 1 usmv alpha=-3 beta= 0 incx=1 incy=1 trans=t is ok" -end subroutine s_usmv_2_t_am3_bm0_ix1_iy1 -! - -subroutine s_usmv_2_c_am3_bm0_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_s_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='c' - integer :: incx=1 - integer :: incy=1 - real*4 :: alpha=-3 - real*4 :: beta=0 - ! 1 0 - ! 0 1 - - ! declaration of VA,IA,JA - integer :: nnz=2 - integer :: m=2 - integer :: k=2 - integer :: IA(2)=(/1, 2/) - integer :: JA(2)=(/1, 2/) - real*4 :: VA(2)=(/1, 1/) - real*4 :: x(2)=(/1, 1/)! reference x - real*4 :: cy(2)=(/-3, -3/)! reference cy after - real*4 :: bcy(2)=(/3, 3/)! reference bcy before - real*4 :: y(2)=(/3, 3/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spmm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on s matrix 2 x 2 blocked 1 x 1 usmv alpha=-3 beta= 0 incx=1 incy=1 trans=c is not ok" - if(res == 0)print*,"on s matrix 2 x 2 blocked 1 x 1 usmv alpha=-3 beta= 0 incx=1 incy=1 trans=c is ok" -end subroutine s_usmv_2_c_am3_bm0_ix1_iy1 -! - -subroutine s_ussv_2_n_ap3_bm0_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_s_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='n' - integer :: incx=1 - real*4 :: alpha=3 - real*4 :: beta=0 - ! 1 0 - ! 0 1 - - ! declaration of VA,IA,JA - integer :: nnz=2 - integer :: m=2 - integer :: k=2 - integer :: IA(2)=(/1, 2/) - integer :: JA(2)=(/1, 2/) - real*4 :: VA(2)=(/1, 1/) - real*4 :: x(2)=(/3, 3/)! reference x - real*4 :: cy(2)=(/9, 9/)! reference cy after - real*4 :: bcy(2)=(/0, 0/)! reference bcy before - real*4 :: y(2)=(/0, 0/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call a%set_triangle() - call a%set_lower() - call a%set_unit(.false.) - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spsm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spsm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on s matrix 2 x 2 blocked 1 x 1 ussv alpha= 3 beta= 0 incx=1 incy=1 trans=n is not ok" - if(res == 0)print*,"on s matrix 2 x 2 blocked 1 x 1 ussv alpha= 3 beta= 0 incx=1 incy=1 trans=n is ok" -end subroutine s_ussv_2_n_ap3_bm0_ix1_iy1 -! - -subroutine s_ussv_2_t_ap3_bm0_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_s_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='t' - integer :: incx=1 - real*4 :: alpha=3 - real*4 :: beta=0 - ! 1 0 - ! 0 1 - - ! declaration of VA,IA,JA - integer :: nnz=2 - integer :: m=2 - integer :: k=2 - integer :: IA(2)=(/1, 2/) - integer :: JA(2)=(/1, 2/) - real*4 :: VA(2)=(/1, 1/) - real*4 :: x(2)=(/3, 3/)! reference x - real*4 :: cy(2)=(/9, 9/)! reference cy after - real*4 :: bcy(2)=(/0, 0/)! reference bcy before - real*4 :: y(2)=(/0, 0/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call a%set_triangle() - call a%set_lower() - call a%set_unit(.false.) - - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spsm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spsm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on s matrix 2 x 2 blocked 1 x 1 ussv alpha= 3 beta= 0 incx=1 incy=1 trans=t is not ok" - if(res == 0)print*,"on s matrix 2 x 2 blocked 1 x 1 ussv alpha= 3 beta= 0 incx=1 incy=1 trans=t is ok" -end subroutine s_ussv_2_t_ap3_bm0_ix1_iy1 -! - -subroutine s_ussv_2_c_ap3_bm0_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_s_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='c' - integer :: incx=1 - real*4 :: alpha=3 - real*4 :: beta=0 - ! 1 0 - ! 1 1 - - ! declaration of VA,IA,JA - integer :: nnz=3 - integer :: m=2 - integer :: k=2 - integer :: IA(3)=(/1, 2, 2/) - integer :: JA(3)=(/1, 1, 2/) - real*4 :: VA(3)=(/1, 1, 1/) - real*4 :: x(2)=(/6, 3/)! reference x - real*4 :: cy(2)=(/9, 9/)! reference cy after - real*4 :: bcy(2)=(/0, 0/)! reference bcy before - real*4 :: y(2)=(/0, 0/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call a%set_triangle() - call a%set_lower() - call a%set_unit(.false.) - - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spsm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spsm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,i,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on s matrix 2 x 2 blocked 1 x 1 ussv alpha= 3 beta= 0 incx=1 incy=1 trans=c is not ok" - if(res == 0)print*,"on s matrix 2 x 2 blocked 1 x 1 ussv alpha= 3 beta= 0 incx=1 incy=1 trans=c is ok" -end subroutine s_ussv_2_c_ap3_bm0_ix1_iy1 -! - -subroutine s_ussv_2_n_ap1_bm0_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_s_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='n' - integer :: incx=1 - real*4 :: alpha=1 - real*4 :: beta=0 - ! 1 0 - ! 0 1 - - ! declaration of VA,IA,JA - integer :: nnz=2 - integer :: m=2 - integer :: k=2 - integer :: IA(2)=(/1, 2/) - integer :: JA(2)=(/1, 2/) - real*4 :: VA(2)=(/1, 1/) - real*4 :: x(2)=(/1, 1/)! reference x - real*4 :: cy(2)=(/1, 1/)! reference cy after - real*4 :: bcy(2)=(/0, 0/)! reference bcy before - real*4 :: y(2)=(/0, 0/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call a%set_triangle() - call a%set_lower() - call a%set_unit(.false.) - - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spsm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spsm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on s matrix 2 x 2 blocked 1 x 1 ussv alpha= 1 beta= 0 incx=1 incy=1 trans=n is not ok" - if(res == 0)print*,"on s matrix 2 x 2 blocked 1 x 1 ussv alpha= 1 beta= 0 incx=1 incy=1 trans=n is ok" -end subroutine s_ussv_2_n_ap1_bm0_ix1_iy1 -! - -subroutine s_ussv_2_t_ap1_bm0_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_s_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='t' - integer :: incx=1 - real*4 :: alpha=1 - real*4 :: beta=0 - ! 1 0 - ! 0 1 - - ! declaration of VA,IA,JA - integer :: nnz=2 - integer :: m=2 - integer :: k=2 - integer :: IA(2)=(/1, 2/) - integer :: JA(2)=(/1, 2/) - real*4 :: VA(2)=(/1, 1/) - real*4 :: x(2)=(/1, 1/)! reference x - real*4 :: cy(2)=(/1, 1/)! reference cy after - real*4 :: bcy(2)=(/0, 0/)! reference bcy before - real*4 :: y(2)=(/0, 0/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call a%set_triangle() - call a%set_lower() - call a%set_unit(.false.) - - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spsm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spsm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on s matrix 2 x 2 blocked 1 x 1 ussv alpha= 1 beta= 0 incx=1 incy=1 trans=t is not ok" - if(res == 0)print*,"on s matrix 2 x 2 blocked 1 x 1 ussv alpha= 1 beta= 0 incx=1 incy=1 trans=t is ok" -end subroutine s_ussv_2_t_ap1_bm0_ix1_iy1 -! - -subroutine s_ussv_2_c_ap1_bm0_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_s_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='c' - integer :: incx=1 - real*4 :: alpha=1 - real*4 :: beta=0 - ! 1 0 - ! 0 1 - - ! declaration of VA,IA,JA - integer :: nnz=2 - integer :: m=2 - integer :: k=2 - integer :: IA(2)=(/1, 2/) - integer :: JA(2)=(/1, 2/) - real*4 :: VA(2)=(/1, 1/) - real*4 :: x(2)=(/1, 1/)! reference x - real*4 :: cy(2)=(/1, 1/)! reference cy after - real*4 :: bcy(2)=(/0, 0/)! reference bcy before - real*4 :: y(2)=(/0, 0/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call a%set_triangle() - call a%set_lower() - call a%set_unit(.false.) - - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spsm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spsm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on s matrix 2 x 2 blocked 1 x 1 ussv alpha= 1 beta= 0 incx=1 incy=1 trans=c is not ok" - if(res == 0)print*,"on s matrix 2 x 2 blocked 1 x 1 ussv alpha= 1 beta= 0 incx=1 incy=1 trans=c is ok" -end subroutine s_ussv_2_c_ap1_bm0_ix1_iy1 -! - -subroutine s_ussv_2_n_am1_bm0_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_s_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='n' - integer :: incx=1 - real*4 :: alpha=-1 - real*4 :: beta=0 - ! 1 0 - ! 0 1 - - ! declaration of VA,IA,JA - integer :: nnz=2 - integer :: m=2 - integer :: k=2 - integer :: IA(2)=(/1, 2/) - integer :: JA(2)=(/1, 2/) - real*4 :: VA(2)=(/1, 1/) - real*4 :: x(2)=(/-1, -1/)! reference x - real*4 :: cy(2)=(/1, 1/)! reference cy after - real*4 :: bcy(2)=(/0, 0/)! reference bcy before - real*4 :: y(2)=(/0, 0/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call a%set_triangle() - call a%set_lower() - call a%set_unit(.false.) - - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spsm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spsm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on s matrix 2 x 2 blocked 1 x 1 ussv alpha=-1 beta= 0 incx=1 incy=1 trans=n is not ok" - if(res == 0)print*,"on s matrix 2 x 2 blocked 1 x 1 ussv alpha=-1 beta= 0 incx=1 incy=1 trans=n is ok" -end subroutine s_ussv_2_n_am1_bm0_ix1_iy1 -! - -subroutine s_ussv_2_t_am1_bm0_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_s_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='t' - integer :: incx=1 - real*4 :: alpha=-1 - real*4 :: beta=0 - ! 1 0 - ! 3 1 - - ! declaration of VA,IA,JA - integer :: nnz=3 - integer :: m=2 - integer :: k=2 - integer :: IA(3)=(/1, 2, 2/) - integer :: JA(3)=(/1, 1, 2/) - real*4 :: VA(3)=(/1, 3, 1/) - real*4 :: x(2)=(/-4, -1/)! reference x - real*4 :: cy(2)=(/1, 1/)! reference cy after - real*4 :: bcy(2)=(/0, 0/)! reference bcy before - real*4 :: y(2)=(/0, 0/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call a%set_triangle() - call a%set_lower() - call a%set_unit(.false.) - - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spsm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spsm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on s matrix 2 x 2 blocked 1 x 1 ussv alpha=-1 beta= 0 incx=1 incy=1 trans=t is not ok" - if(res == 0)print*,"on s matrix 2 x 2 blocked 1 x 1 ussv alpha=-1 beta= 0 incx=1 incy=1 trans=t is ok" -end subroutine s_ussv_2_t_am1_bm0_ix1_iy1 -! - -subroutine s_ussv_2_c_am1_bm0_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_s_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='c' - integer :: incx=1 - real*4 :: alpha=-1 - real*4 :: beta=0 - ! 1 0 - ! 2 1 - - ! declaration of VA,IA,JA - integer :: nnz=3 - integer :: m=2 - integer :: k=2 - integer :: IA(3)=(/1, 2, 2/) - integer :: JA(3)=(/1, 1, 2/) - real*4 :: VA(3)=(/1, 2, 1/) - real*4 :: x(2)=(/-3, -1/)! reference x - real*4 :: cy(2)=(/1, 1/)! reference cy after - real*4 :: bcy(2)=(/0, 0/)! reference bcy before - real*4 :: y(2)=(/0, 0/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call a%set_triangle() - call a%set_lower() - call a%set_unit(.false.) - - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spsm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spsm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on s matrix 2 x 2 blocked 1 x 1 ussv alpha=-1 beta= 0 incx=1 incy=1 trans=c is not ok" - if(res == 0)print*,"on s matrix 2 x 2 blocked 1 x 1 ussv alpha=-1 beta= 0 incx=1 incy=1 trans=c is ok" -end subroutine s_ussv_2_c_am1_bm0_ix1_iy1 -! - -subroutine s_ussv_2_n_am3_bm0_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_s_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='n' - integer :: incx=1 - real*4 :: alpha=-3 - real*4 :: beta=0 - ! 1 0 - ! 0 1 - - ! declaration of VA,IA,JA - integer :: nnz=2 - integer :: m=2 - integer :: k=2 - integer :: IA(2)=(/1, 2/) - integer :: JA(2)=(/1, 2/) - real*4 :: VA(2)=(/1, 1/) - real*4 :: x(2)=(/-3, -3/)! reference x - real*4 :: cy(2)=(/9, 9/)! reference cy after - real*4 :: bcy(2)=(/0, 0/)! reference bcy before - real*4 :: y(2)=(/0, 0/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call a%set_triangle() - call a%set_lower() - call a%set_unit(.false.) - - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spsm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spsm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on s matrix 2 x 2 blocked 1 x 1 ussv alpha=-3 beta= 0 incx=1 incy=1 trans=n is not ok" - if(res == 0)print*,"on s matrix 2 x 2 blocked 1 x 1 ussv alpha=-3 beta= 0 incx=1 incy=1 trans=n is ok" -end subroutine s_ussv_2_n_am3_bm0_ix1_iy1 -! - -subroutine s_ussv_2_t_am3_bm0_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_s_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='t' - integer :: incx=1 - real*4 :: alpha=-3 - real*4 :: beta=0 - ! 1 0 - ! 0 1 - - ! declaration of VA,IA,JA - integer :: nnz=2 - integer :: m=2 - integer :: k=2 - integer :: IA(2)=(/1, 2/) - integer :: JA(2)=(/1, 2/) - real*4 :: VA(2)=(/1, 1/) - real*4 :: x(2)=(/-3, -3/)! reference x - real*4 :: cy(2)=(/9, 9/)! reference cy after - real*4 :: bcy(2)=(/0, 0/)! reference bcy before - real*4 :: y(2)=(/0, 0/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call a%set_triangle() - call a%set_lower() - call a%set_unit(.false.) - - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spsm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spsm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on s matrix 2 x 2 blocked 1 x 1 ussv alpha=-3 beta= 0 incx=1 incy=1 trans=t is not ok" - if(res == 0)print*,"on s matrix 2 x 2 blocked 1 x 1 ussv alpha=-3 beta= 0 incx=1 incy=1 trans=t is ok" -end subroutine s_ussv_2_t_am3_bm0_ix1_iy1 -! - -subroutine s_ussv_2_c_am3_bm0_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_s_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='c' - integer :: incx=1 - real*4 :: alpha=-3 - real*4 :: beta=0 - ! 1 0 - ! 0 1 - - ! declaration of VA,IA,JA - integer :: nnz=2 - integer :: m=2 - integer :: k=2 - integer :: IA(2)=(/1, 2/) - integer :: JA(2)=(/1, 2/) - real*4 :: VA(2)=(/1, 1/) - real*4 :: x(2)=(/-3, -3/)! reference x - real*4 :: cy(2)=(/9, 9/)! reference cy after - real*4 :: bcy(2)=(/0, 0/)! reference bcy before - real*4 :: y(2)=(/0, 0/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call a%set_triangle() - call a%set_lower() - call a%set_unit(.false.) - - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spsm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spsm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on s matrix 2 x 2 blocked 1 x 1 ussv alpha=-3 beta= 0 incx=1 incy=1 trans=c is not ok" - if(res == 0)print*,"on s matrix 2 x 2 blocked 1 x 1 ussv alpha=-3 beta= 0 incx=1 incy=1 trans=c is ok" -end subroutine s_ussv_2_c_am3_bm0_ix1_iy1 -! - -subroutine d_usmv_2_n_ap3_bp1_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_d_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='n' - integer :: incx=1 - integer :: incy=1 - real*8 :: alpha=3 - real*8 :: beta=1 - ! 1 1 - ! 0 0 - - ! declaration of VA,IA,JA - integer :: nnz=2 - integer :: m=2 - integer :: k=2 - integer :: IA(2)=(/1, 1/) - integer :: JA(2)=(/1, 2/) - real*8 :: VA(2)=(/1, 1/) - real*8 :: x(2)=(/1, 1/)! reference x - real*8 :: cy(2)=(/9, 3/)! reference cy after - real*8 :: bcy(2)=(/3, 3/)! reference bcy before - real*8 :: y(2)=(/3, 3/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spmm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on d matrix 2 x 2 blocked 1 x 1 usmv alpha= 3 beta= 1 incx=1 incy=1 trans=n is not ok" - if(res == 0)print*,"on d matrix 2 x 2 blocked 1 x 1 usmv alpha= 3 beta= 1 incx=1 incy=1 trans=n is ok" -end subroutine d_usmv_2_n_ap3_bp1_ix1_iy1 -! - -subroutine d_usmv_2_t_ap3_bp1_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_d_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='t' - integer :: incx=1 - integer :: incy=1 - real*8 :: alpha=3 - real*8 :: beta=1 - ! 1 0 - ! 0 1 - - ! declaration of VA,IA,JA - integer :: nnz=2 - integer :: m=2 - integer :: k=2 - integer :: IA(2)=(/1, 2/) - integer :: JA(2)=(/1, 2/) - real*8 :: VA(2)=(/1, 1/) - real*8 :: x(2)=(/1, 1/)! reference x - real*8 :: cy(2)=(/6, 6/)! reference cy after - real*8 :: bcy(2)=(/3, 3/)! reference bcy before - real*8 :: y(2)=(/3, 3/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spmm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on d matrix 2 x 2 blocked 1 x 1 usmv alpha= 3 beta= 1 incx=1 incy=1 trans=t is not ok" - if(res == 0)print*,"on d matrix 2 x 2 blocked 1 x 1 usmv alpha= 3 beta= 1 incx=1 incy=1 trans=t is ok" -end subroutine d_usmv_2_t_ap3_bp1_ix1_iy1 -! - -subroutine d_usmv_2_c_ap3_bp1_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_d_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='c' - integer :: incx=1 - integer :: incy=1 - real*8 :: alpha=3 - real*8 :: beta=1 - ! 1 0 - ! 3 1 - - ! declaration of VA,IA,JA - integer :: nnz=3 - integer :: m=2 - integer :: k=2 - integer :: IA(3)=(/1, 2, 2/) - integer :: JA(3)=(/1, 1, 2/) - real*8 :: VA(3)=(/1, 3, 1/) - real*8 :: x(2)=(/1, 1/)! reference x - real*8 :: cy(2)=(/15, 6/)! reference cy after - real*8 :: bcy(2)=(/3, 3/)! reference bcy before - real*8 :: y(2)=(/3, 3/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spmm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on d matrix 2 x 2 blocked 1 x 1 usmv alpha= 3 beta= 1 incx=1 incy=1 trans=c is not ok" - if(res == 0)print*,"on d matrix 2 x 2 blocked 1 x 1 usmv alpha= 3 beta= 1 incx=1 incy=1 trans=c is ok" -end subroutine d_usmv_2_c_ap3_bp1_ix1_iy1 -! - -subroutine d_usmv_2_n_ap3_bm0_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_d_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='n' - integer :: incx=1 - integer :: incy=1 - real*8 :: alpha=3 - real*8 :: beta=0 - ! 1 3 - ! 3 0 - - ! declaration of VA,IA,JA - integer :: nnz=3 - integer :: m=2 - integer :: k=2 - integer :: IA(3)=(/1, 1, 2/) - integer :: JA(3)=(/1, 2, 1/) - real*8 :: VA(3)=(/1, 3, 3/) - real*8 :: x(2)=(/1, 1/)! reference x - real*8 :: cy(2)=(/12, 9/)! reference cy after - real*8 :: bcy(2)=(/3, 3/)! reference bcy before - real*8 :: y(2)=(/3, 3/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spmm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on d matrix 2 x 2 blocked 1 x 1 usmv alpha= 3 beta= 0 incx=1 incy=1 trans=n is not ok" - if(res == 0)print*,"on d matrix 2 x 2 blocked 1 x 1 usmv alpha= 3 beta= 0 incx=1 incy=1 trans=n is ok" -end subroutine d_usmv_2_n_ap3_bm0_ix1_iy1 -! - -subroutine d_usmv_2_t_ap3_bm0_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_d_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='t' - integer :: incx=1 - integer :: incy=1 - real*8 :: alpha=3 - real*8 :: beta=0 - ! 1 3 - ! 3 0 - - ! declaration of VA,IA,JA - integer :: nnz=3 - integer :: m=2 - integer :: k=2 - integer :: IA(3)=(/1, 1, 2/) - integer :: JA(3)=(/1, 2, 1/) - real*8 :: VA(3)=(/1, 3, 3/) - real*8 :: x(2)=(/1, 1/)! reference x - real*8 :: cy(2)=(/12, 9/)! reference cy after - real*8 :: bcy(2)=(/3, 3/)! reference bcy before - real*8 :: y(2)=(/3, 3/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spmm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on d matrix 2 x 2 blocked 1 x 1 usmv alpha= 3 beta= 0 incx=1 incy=1 trans=t is not ok" - if(res == 0)print*,"on d matrix 2 x 2 blocked 1 x 1 usmv alpha= 3 beta= 0 incx=1 incy=1 trans=t is ok" -end subroutine d_usmv_2_t_ap3_bm0_ix1_iy1 -! - -subroutine d_usmv_2_c_ap3_bm0_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_d_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='c' - integer :: incx=1 - integer :: incy=1 - real*8 :: alpha=3 - real*8 :: beta=0 - ! 1 0 - ! 0 0 - - ! declaration of VA,IA,JA - integer :: nnz=1 - integer :: m=2 - integer :: k=2 - integer :: IA(1)=(/1/) - integer :: JA(1)=(/1/) - real*8 :: VA(1)=(/1/) - real*8 :: x(2)=(/1, 1/)! reference x - real*8 :: cy(2)=(/3, 0/)! reference cy after - real*8 :: bcy(2)=(/3, 3/)! reference bcy before - real*8 :: y(2)=(/3, 3/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spmm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on d matrix 2 x 2 blocked 1 x 1 usmv alpha= 3 beta= 0 incx=1 incy=1 trans=c is not ok" - if(res == 0)print*,"on d matrix 2 x 2 blocked 1 x 1 usmv alpha= 3 beta= 0 incx=1 incy=1 trans=c is ok" -end subroutine d_usmv_2_c_ap3_bm0_ix1_iy1 -! - -subroutine d_usmv_2_n_ap1_bp1_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_d_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='n' - integer :: incx=1 - integer :: incy=1 - real*8 :: alpha=1 - real*8 :: beta=1 - ! 1 0 - ! 0 2 - - ! declaration of VA,IA,JA - integer :: nnz=2 - integer :: m=2 - integer :: k=2 - integer :: IA(2)=(/1, 2/) - integer :: JA(2)=(/1, 2/) - real*8 :: VA(2)=(/1, 2/) - real*8 :: x(2)=(/1, 1/)! reference x - real*8 :: cy(2)=(/4, 5/)! reference cy after - real*8 :: bcy(2)=(/3, 3/)! reference bcy before - real*8 :: y(2)=(/3, 3/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spmm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on d matrix 2 x 2 blocked 1 x 1 usmv alpha= 1 beta= 1 incx=1 incy=1 trans=n is not ok" - if(res == 0)print*,"on d matrix 2 x 2 blocked 1 x 1 usmv alpha= 1 beta= 1 incx=1 incy=1 trans=n is ok" -end subroutine d_usmv_2_n_ap1_bp1_ix1_iy1 -! - -subroutine d_usmv_2_t_ap1_bp1_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_d_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='t' - integer :: incx=1 - integer :: incy=1 - real*8 :: alpha=1 - real*8 :: beta=1 - ! 1 0 - ! 1 0 - - ! declaration of VA,IA,JA - integer :: nnz=2 - integer :: m=2 - integer :: k=2 - integer :: IA(2)=(/1, 2/) - integer :: JA(2)=(/1, 1/) - real*8 :: VA(2)=(/1, 1/) - real*8 :: x(2)=(/1, 1/)! reference x - real*8 :: cy(2)=(/5, 3/)! reference cy after - real*8 :: bcy(2)=(/3, 3/)! reference bcy before - real*8 :: y(2)=(/3, 3/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spmm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on d matrix 2 x 2 blocked 1 x 1 usmv alpha= 1 beta= 1 incx=1 incy=1 trans=t is not ok" - if(res == 0)print*,"on d matrix 2 x 2 blocked 1 x 1 usmv alpha= 1 beta= 1 incx=1 incy=1 trans=t is ok" -end subroutine d_usmv_2_t_ap1_bp1_ix1_iy1 -! - -subroutine d_usmv_2_c_ap1_bp1_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_d_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='c' - integer :: incx=1 - integer :: incy=1 - real*8 :: alpha=1 - real*8 :: beta=1 - ! 1 0 - ! 0 0 - - ! declaration of VA,IA,JA - integer :: nnz=1 - integer :: m=2 - integer :: k=2 - integer :: IA(1)=(/1/) - integer :: JA(1)=(/1/) - real*8 :: VA(1)=(/1/) - real*8 :: x(2)=(/1, 1/)! reference x - real*8 :: cy(2)=(/4, 3/)! reference cy after - real*8 :: bcy(2)=(/3, 3/)! reference bcy before - real*8 :: y(2)=(/3, 3/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spmm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on d matrix 2 x 2 blocked 1 x 1 usmv alpha= 1 beta= 1 incx=1 incy=1 trans=c is not ok" - if(res == 0)print*,"on d matrix 2 x 2 blocked 1 x 1 usmv alpha= 1 beta= 1 incx=1 incy=1 trans=c is ok" -end subroutine d_usmv_2_c_ap1_bp1_ix1_iy1 -! - -subroutine d_usmv_2_n_ap1_bm0_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_d_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='n' - integer :: incx=1 - integer :: incy=1 - real*8 :: alpha=1 - real*8 :: beta=0 - ! 1 0 - ! 3 4 - - ! declaration of VA,IA,JA - integer :: nnz=3 - integer :: m=2 - integer :: k=2 - integer :: IA(3)=(/1, 2, 2/) - integer :: JA(3)=(/1, 1, 2/) - real*8 :: VA(3)=(/1, 3, 4/) - real*8 :: x(2)=(/1, 1/)! reference x - real*8 :: cy(2)=(/1, 7/)! reference cy after - real*8 :: bcy(2)=(/3, 3/)! reference bcy before - real*8 :: y(2)=(/3, 3/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spmm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on d matrix 2 x 2 blocked 1 x 1 usmv alpha= 1 beta= 0 incx=1 incy=1 trans=n is not ok" - if(res == 0)print*,"on d matrix 2 x 2 blocked 1 x 1 usmv alpha= 1 beta= 0 incx=1 incy=1 trans=n is ok" -end subroutine d_usmv_2_n_ap1_bm0_ix1_iy1 -! - -subroutine d_usmv_2_t_ap1_bm0_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_d_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='t' - integer :: incx=1 - integer :: incy=1 - real*8 :: alpha=1 - real*8 :: beta=0 - ! 1 0 - ! 1 0 - - ! declaration of VA,IA,JA - integer :: nnz=2 - integer :: m=2 - integer :: k=2 - integer :: IA(2)=(/1, 2/) - integer :: JA(2)=(/1, 1/) - real*8 :: VA(2)=(/1, 1/) - real*8 :: x(2)=(/1, 1/)! reference x - real*8 :: cy(2)=(/2, 0/)! reference cy after - real*8 :: bcy(2)=(/3, 3/)! reference bcy before - real*8 :: y(2)=(/3, 3/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spmm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on d matrix 2 x 2 blocked 1 x 1 usmv alpha= 1 beta= 0 incx=1 incy=1 trans=t is not ok" - if(res == 0)print*,"on d matrix 2 x 2 blocked 1 x 1 usmv alpha= 1 beta= 0 incx=1 incy=1 trans=t is ok" -end subroutine d_usmv_2_t_ap1_bm0_ix1_iy1 -! - -subroutine d_usmv_2_c_ap1_bm0_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_d_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='c' - integer :: incx=1 - integer :: incy=1 - real*8 :: alpha=1 - real*8 :: beta=0 - ! 1 0 - ! 0 3 - - ! declaration of VA,IA,JA - integer :: nnz=2 - integer :: m=2 - integer :: k=2 - integer :: IA(2)=(/1, 2/) - integer :: JA(2)=(/1, 2/) - real*8 :: VA(2)=(/1, 3/) - real*8 :: x(2)=(/1, 1/)! reference x - real*8 :: cy(2)=(/1, 3/)! reference cy after - real*8 :: bcy(2)=(/3, 3/)! reference bcy before - real*8 :: y(2)=(/3, 3/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spmm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on d matrix 2 x 2 blocked 1 x 1 usmv alpha= 1 beta= 0 incx=1 incy=1 trans=c is not ok" - if(res == 0)print*,"on d matrix 2 x 2 blocked 1 x 1 usmv alpha= 1 beta= 0 incx=1 incy=1 trans=c is ok" -end subroutine d_usmv_2_c_ap1_bm0_ix1_iy1 -! - -subroutine d_usmv_2_n_am1_bp1_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_d_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='n' - integer :: incx=1 - integer :: incy=1 - real*8 :: alpha=-1 - real*8 :: beta=1 - ! 1 0 - ! 0 1 - - ! declaration of VA,IA,JA - integer :: nnz=2 - integer :: m=2 - integer :: k=2 - integer :: IA(2)=(/1, 2/) - integer :: JA(2)=(/1, 2/) - real*8 :: VA(2)=(/1, 1/) - real*8 :: x(2)=(/1, 1/)! reference x - real*8 :: cy(2)=(/2, 2/)! reference cy after - real*8 :: bcy(2)=(/3, 3/)! reference bcy before - real*8 :: y(2)=(/3, 3/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spmm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on d matrix 2 x 2 blocked 1 x 1 usmv alpha=-1 beta= 1 incx=1 incy=1 trans=n is not ok" - if(res == 0)print*,"on d matrix 2 x 2 blocked 1 x 1 usmv alpha=-1 beta= 1 incx=1 incy=1 trans=n is ok" -end subroutine d_usmv_2_n_am1_bp1_ix1_iy1 -! - -subroutine d_usmv_2_t_am1_bp1_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_d_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='t' - integer :: incx=1 - integer :: incy=1 - real*8 :: alpha=-1 - real*8 :: beta=1 - ! 1 3 - ! 1 0 - - ! declaration of VA,IA,JA - integer :: nnz=3 - integer :: m=2 - integer :: k=2 - integer :: IA(3)=(/1, 1, 2/) - integer :: JA(3)=(/1, 2, 1/) - real*8 :: VA(3)=(/1, 3, 1/) - real*8 :: x(2)=(/1, 1/)! reference x - real*8 :: cy(2)=(/1, 0/)! reference cy after - real*8 :: bcy(2)=(/3, 3/)! reference bcy before - real*8 :: y(2)=(/3, 3/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spmm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on d matrix 2 x 2 blocked 1 x 1 usmv alpha=-1 beta= 1 incx=1 incy=1 trans=t is not ok" - if(res == 0)print*,"on d matrix 2 x 2 blocked 1 x 1 usmv alpha=-1 beta= 1 incx=1 incy=1 trans=t is ok" -end subroutine d_usmv_2_t_am1_bp1_ix1_iy1 -! - -subroutine d_usmv_2_c_am1_bp1_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_d_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='c' - integer :: incx=1 - integer :: incy=1 - real*8 :: alpha=-1 - real*8 :: beta=1 - ! 1 0 - ! 0 3 - - ! declaration of VA,IA,JA - integer :: nnz=2 - integer :: m=2 - integer :: k=2 - integer :: IA(2)=(/1, 2/) - integer :: JA(2)=(/1, 2/) - real*8 :: VA(2)=(/1, 3/) - real*8 :: x(2)=(/1, 1/)! reference x - real*8 :: cy(2)=(/2, 0/)! reference cy after - real*8 :: bcy(2)=(/3, 3/)! reference bcy before - real*8 :: y(2)=(/3, 3/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spmm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on d matrix 2 x 2 blocked 1 x 1 usmv alpha=-1 beta= 1 incx=1 incy=1 trans=c is not ok" - if(res == 0)print*,"on d matrix 2 x 2 blocked 1 x 1 usmv alpha=-1 beta= 1 incx=1 incy=1 trans=c is ok" -end subroutine d_usmv_2_c_am1_bp1_ix1_iy1 -! - -subroutine d_usmv_2_n_am1_bm0_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_d_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='n' - integer :: incx=1 - integer :: incy=1 - real*8 :: alpha=-1 - real*8 :: beta=0 - ! 1 3 - ! 0 3 - - ! declaration of VA,IA,JA - integer :: nnz=3 - integer :: m=2 - integer :: k=2 - integer :: IA(3)=(/1, 1, 2/) - integer :: JA(3)=(/1, 2, 2/) - real*8 :: VA(3)=(/1, 3, 3/) - real*8 :: x(2)=(/1, 1/)! reference x - real*8 :: cy(2)=(/-4, -3/)! reference cy after - real*8 :: bcy(2)=(/3, 3/)! reference bcy before - real*8 :: y(2)=(/3, 3/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spmm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on d matrix 2 x 2 blocked 1 x 1 usmv alpha=-1 beta= 0 incx=1 incy=1 trans=n is not ok" - if(res == 0)print*,"on d matrix 2 x 2 blocked 1 x 1 usmv alpha=-1 beta= 0 incx=1 incy=1 trans=n is ok" -end subroutine d_usmv_2_n_am1_bm0_ix1_iy1 -! - -subroutine d_usmv_2_t_am1_bm0_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_d_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='t' - integer :: incx=1 - integer :: incy=1 - real*8 :: alpha=-1 - real*8 :: beta=0 - ! 1 0 - ! 3 5 - - ! declaration of VA,IA,JA - integer :: nnz=3 - integer :: m=2 - integer :: k=2 - integer :: IA(3)=(/1, 2, 2/) - integer :: JA(3)=(/1, 1, 2/) - real*8 :: VA(3)=(/1, 3, 5/) - real*8 :: x(2)=(/1, 1/)! reference x - real*8 :: cy(2)=(/-4, -5/)! reference cy after - real*8 :: bcy(2)=(/3, 3/)! reference bcy before - real*8 :: y(2)=(/3, 3/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spmm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on d matrix 2 x 2 blocked 1 x 1 usmv alpha=-1 beta= 0 incx=1 incy=1 trans=t is not ok" - if(res == 0)print*,"on d matrix 2 x 2 blocked 1 x 1 usmv alpha=-1 beta= 0 incx=1 incy=1 trans=t is ok" -end subroutine d_usmv_2_t_am1_bm0_ix1_iy1 -! - -subroutine d_usmv_2_c_am1_bm0_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_d_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='c' - integer :: incx=1 - integer :: incy=1 - real*8 :: alpha=-1 - real*8 :: beta=0 - ! 1 2 - ! 0 0 - - ! declaration of VA,IA,JA - integer :: nnz=2 - integer :: m=2 - integer :: k=2 - integer :: IA(2)=(/1, 1/) - integer :: JA(2)=(/1, 2/) - real*8 :: VA(2)=(/1, 2/) - real*8 :: x(2)=(/1, 1/)! reference x - real*8 :: cy(2)=(/-1, -2/)! reference cy after - real*8 :: bcy(2)=(/3, 3/)! reference bcy before - real*8 :: y(2)=(/3, 3/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spmm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on d matrix 2 x 2 blocked 1 x 1 usmv alpha=-1 beta= 0 incx=1 incy=1 trans=c is not ok" - if(res == 0)print*,"on d matrix 2 x 2 blocked 1 x 1 usmv alpha=-1 beta= 0 incx=1 incy=1 trans=c is ok" -end subroutine d_usmv_2_c_am1_bm0_ix1_iy1 -! - -subroutine d_usmv_2_n_am3_bp1_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_d_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='n' - integer :: incx=1 - integer :: incy=1 - real*8 :: alpha=-3 - real*8 :: beta=1 - ! 1 0 - ! 0 6 - - ! declaration of VA,IA,JA - integer :: nnz=2 - integer :: m=2 - integer :: k=2 - integer :: IA(2)=(/1, 2/) - integer :: JA(2)=(/1, 2/) - real*8 :: VA(2)=(/1, 6/) - real*8 :: x(2)=(/1, 1/)! reference x - real*8 :: cy(2)=(/0, -15/)! reference cy after - real*8 :: bcy(2)=(/3, 3/)! reference bcy before - real*8 :: y(2)=(/3, 3/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spmm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on d matrix 2 x 2 blocked 1 x 1 usmv alpha=-3 beta= 1 incx=1 incy=1 trans=n is not ok" - if(res == 0)print*,"on d matrix 2 x 2 blocked 1 x 1 usmv alpha=-3 beta= 1 incx=1 incy=1 trans=n is ok" -end subroutine d_usmv_2_n_am3_bp1_ix1_iy1 -! - -subroutine d_usmv_2_t_am3_bp1_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_d_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='t' - integer :: incx=1 - integer :: incy=1 - real*8 :: alpha=-3 - real*8 :: beta=1 - ! 1 2 - ! 1 3 - - ! declaration of VA,IA,JA - integer :: nnz=4 - integer :: m=2 - integer :: k=2 - integer :: IA(4)=(/1, 1, 2, 2/) - integer :: JA(4)=(/1, 2, 1, 2/) - real*8 :: VA(4)=(/1, 2, 1, 3/) - real*8 :: x(2)=(/1, 1/)! reference x - real*8 :: cy(2)=(/-3, -12/)! reference cy after - real*8 :: bcy(2)=(/3, 3/)! reference bcy before - real*8 :: y(2)=(/3, 3/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spmm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on d matrix 2 x 2 blocked 1 x 1 usmv alpha=-3 beta= 1 incx=1 incy=1 trans=t is not ok" - if(res == 0)print*,"on d matrix 2 x 2 blocked 1 x 1 usmv alpha=-3 beta= 1 incx=1 incy=1 trans=t is ok" -end subroutine d_usmv_2_t_am3_bp1_ix1_iy1 -! - -subroutine d_usmv_2_c_am3_bp1_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_d_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='c' - integer :: incx=1 - integer :: incy=1 - real*8 :: alpha=-3 - real*8 :: beta=1 - ! 1 3 - ! 3 0 - - ! declaration of VA,IA,JA - integer :: nnz=3 - integer :: m=2 - integer :: k=2 - integer :: IA(3)=(/1, 1, 2/) - integer :: JA(3)=(/1, 2, 1/) - real*8 :: VA(3)=(/1, 3, 3/) - real*8 :: x(2)=(/1, 1/)! reference x - real*8 :: cy(2)=(/-9, -6/)! reference cy after - real*8 :: bcy(2)=(/3, 3/)! reference bcy before - real*8 :: y(2)=(/3, 3/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spmm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on d matrix 2 x 2 blocked 1 x 1 usmv alpha=-3 beta= 1 incx=1 incy=1 trans=c is not ok" - if(res == 0)print*,"on d matrix 2 x 2 blocked 1 x 1 usmv alpha=-3 beta= 1 incx=1 incy=1 trans=c is ok" -end subroutine d_usmv_2_c_am3_bp1_ix1_iy1 -! - -subroutine d_usmv_2_n_am3_bm0_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_d_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='n' - integer :: incx=1 - integer :: incy=1 - real*8 :: alpha=-3 - real*8 :: beta=0 - ! 1 0 - ! 0 0 - - ! declaration of VA,IA,JA - integer :: nnz=1 - integer :: m=2 - integer :: k=2 - integer :: IA(1)=(/1/) - integer :: JA(1)=(/1/) - real*8 :: VA(1)=(/1/) - real*8 :: x(2)=(/1, 1/)! reference x - real*8 :: cy(2)=(/-3, 0/)! reference cy after - real*8 :: bcy(2)=(/3, 3/)! reference bcy before - real*8 :: y(2)=(/3, 3/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spmm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on d matrix 2 x 2 blocked 1 x 1 usmv alpha=-3 beta= 0 incx=1 incy=1 trans=n is not ok" - if(res == 0)print*,"on d matrix 2 x 2 blocked 1 x 1 usmv alpha=-3 beta= 0 incx=1 incy=1 trans=n is ok" -end subroutine d_usmv_2_n_am3_bm0_ix1_iy1 -! - -subroutine d_usmv_2_t_am3_bm0_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_d_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='t' - integer :: incx=1 - integer :: incy=1 - real*8 :: alpha=-3 - real*8 :: beta=0 - ! 1 0 - ! 0 0 - - ! declaration of VA,IA,JA - integer :: nnz=1 - integer :: m=2 - integer :: k=2 - integer :: IA(1)=(/1/) - integer :: JA(1)=(/1/) - real*8 :: VA(1)=(/1/) - real*8 :: x(2)=(/1, 1/)! reference x - real*8 :: cy(2)=(/-3, 0/)! reference cy after - real*8 :: bcy(2)=(/3, 3/)! reference bcy before - real*8 :: y(2)=(/3, 3/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spmm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on d matrix 2 x 2 blocked 1 x 1 usmv alpha=-3 beta= 0 incx=1 incy=1 trans=t is not ok" - if(res == 0)print*,"on d matrix 2 x 2 blocked 1 x 1 usmv alpha=-3 beta= 0 incx=1 incy=1 trans=t is ok" -end subroutine d_usmv_2_t_am3_bm0_ix1_iy1 -! - -subroutine d_usmv_2_c_am3_bm0_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_d_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='c' - integer :: incx=1 - integer :: incy=1 - real*8 :: alpha=-3 - real*8 :: beta=0 - ! 1 0 - ! 0 0 - - ! declaration of VA,IA,JA - integer :: nnz=1 - integer :: m=2 - integer :: k=2 - integer :: IA(1)=(/1/) - integer :: JA(1)=(/1/) - real*8 :: VA(1)=(/1/) - real*8 :: x(2)=(/1, 1/)! reference x - real*8 :: cy(2)=(/-3, 0/)! reference cy after - real*8 :: bcy(2)=(/3, 3/)! reference bcy before - real*8 :: y(2)=(/3, 3/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spmm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on d matrix 2 x 2 blocked 1 x 1 usmv alpha=-3 beta= 0 incx=1 incy=1 trans=c is not ok" - if(res == 0)print*,"on d matrix 2 x 2 blocked 1 x 1 usmv alpha=-3 beta= 0 incx=1 incy=1 trans=c is ok" -end subroutine d_usmv_2_c_am3_bm0_ix1_iy1 -! - -subroutine d_ussv_2_n_ap3_bm0_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_d_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='n' - integer :: incx=1 - real*8 :: alpha=3 - real*8 :: beta=0 - ! 1 0 - ! 3 1 - - ! declaration of VA,IA,JA - integer :: nnz=3 - integer :: m=2 - integer :: k=2 - integer :: IA(3)=(/1, 2, 2/) - integer :: JA(3)=(/1, 1, 2/) - real*8 :: VA(3)=(/1, 3, 1/) - real*8 :: x(2)=(/3, 12/)! reference x - real*8 :: cy(2)=(/9, 9/)! reference cy after - real*8 :: bcy(2)=(/0, 0/)! reference bcy before - real*8 :: y(2)=(/0, 0/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call a%set_triangle() - call a%set_lower() - call a%set_unit(.false.) - - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spsm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spsm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on d matrix 2 x 2 blocked 1 x 1 ussv alpha= 3 beta= 0 incx=1 incy=1 trans=n is not ok" - if(res == 0)print*,"on d matrix 2 x 2 blocked 1 x 1 ussv alpha= 3 beta= 0 incx=1 incy=1 trans=n is ok" -end subroutine d_ussv_2_n_ap3_bm0_ix1_iy1 -! - -subroutine d_ussv_2_t_ap3_bm0_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_d_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='t' - integer :: incx=1 - real*8 :: alpha=3 - real*8 :: beta=0 - ! 1 0 - ! 2 1 - - ! declaration of VA,IA,JA - integer :: nnz=3 - integer :: m=2 - integer :: k=2 - integer :: IA(3)=(/1, 2, 2/) - integer :: JA(3)=(/1, 1, 2/) - real*8 :: VA(3)=(/1, 2, 1/) - real*8 :: x(2)=(/9, 3/)! reference x - real*8 :: cy(2)=(/9, 9/)! reference cy after - real*8 :: bcy(2)=(/0, 0/)! reference bcy before - real*8 :: y(2)=(/0, 0/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call a%set_triangle() - call a%set_lower() - call a%set_unit(.false.) - - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spsm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spsm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on d matrix 2 x 2 blocked 1 x 1 ussv alpha= 3 beta= 0 incx=1 incy=1 trans=t is not ok" - if(res == 0)print*,"on d matrix 2 x 2 blocked 1 x 1 ussv alpha= 3 beta= 0 incx=1 incy=1 trans=t is ok" -end subroutine d_ussv_2_t_ap3_bm0_ix1_iy1 -! - -subroutine d_ussv_2_c_ap3_bm0_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_d_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='c' - integer :: incx=1 - real*8 :: alpha=3 - real*8 :: beta=0 - ! 1 0 - ! 3 1 - - ! declaration of VA,IA,JA - integer :: nnz=3 - integer :: m=2 - integer :: k=2 - integer :: IA(3)=(/1, 2, 2/) - integer :: JA(3)=(/1, 1, 2/) - real*8 :: VA(3)=(/1, 3, 1/) - real*8 :: x(2)=(/12, 3/)! reference x - real*8 :: cy(2)=(/9, 9/)! reference cy after - real*8 :: bcy(2)=(/0, 0/)! reference bcy before - real*8 :: y(2)=(/0, 0/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call a%set_triangle() - call a%set_lower() - call a%set_unit(.false.) - - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spsm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spsm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on d matrix 2 x 2 blocked 1 x 1 ussv alpha= 3 beta= 0 incx=1 incy=1 trans=c is not ok" - if(res == 0)print*,"on d matrix 2 x 2 blocked 1 x 1 ussv alpha= 3 beta= 0 incx=1 incy=1 trans=c is ok" -end subroutine d_ussv_2_c_ap3_bm0_ix1_iy1 -! - -subroutine d_ussv_2_n_ap1_bm0_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_d_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='n' - integer :: incx=1 - real*8 :: alpha=1 - real*8 :: beta=0 - ! 1 0 - ! 3 1 - - ! declaration of VA,IA,JA - integer :: nnz=3 - integer :: m=2 - integer :: k=2 - integer :: IA(3)=(/1, 2, 2/) - integer :: JA(3)=(/1, 1, 2/) - real*8 :: VA(3)=(/1, 3, 1/) - real*8 :: x(2)=(/1, 4/)! reference x - real*8 :: cy(2)=(/1, 1/)! reference cy after - real*8 :: bcy(2)=(/0, 0/)! reference bcy before - real*8 :: y(2)=(/0, 0/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call a%set_triangle() - call a%set_lower() - call a%set_unit(.false.) - - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spsm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spsm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on d matrix 2 x 2 blocked 1 x 1 ussv alpha= 1 beta= 0 incx=1 incy=1 trans=n is not ok" - if(res == 0)print*,"on d matrix 2 x 2 blocked 1 x 1 ussv alpha= 1 beta= 0 incx=1 incy=1 trans=n is ok" -end subroutine d_ussv_2_n_ap1_bm0_ix1_iy1 -! - -subroutine d_ussv_2_t_ap1_bm0_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_d_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='t' - integer :: incx=1 - real*8 :: alpha=1 - real*8 :: beta=0 - ! 1 0 - ! 1 1 - - ! declaration of VA,IA,JA - integer :: nnz=3 - integer :: m=2 - integer :: k=2 - integer :: IA(3)=(/1, 2, 2/) - integer :: JA(3)=(/1, 1, 2/) - real*8 :: VA(3)=(/1, 1, 1/) - real*8 :: x(2)=(/2, 1/)! reference x - real*8 :: cy(2)=(/1, 1/)! reference cy after - real*8 :: bcy(2)=(/0, 0/)! reference bcy before - real*8 :: y(2)=(/0, 0/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call a%set_triangle() - call a%set_lower() - call a%set_unit(.false.) - - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spsm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spsm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on d matrix 2 x 2 blocked 1 x 1 ussv alpha= 1 beta= 0 incx=1 incy=1 trans=t is not ok" - if(res == 0)print*,"on d matrix 2 x 2 blocked 1 x 1 ussv alpha= 1 beta= 0 incx=1 incy=1 trans=t is ok" -end subroutine d_ussv_2_t_ap1_bm0_ix1_iy1 -! - -subroutine d_ussv_2_c_ap1_bm0_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_d_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='c' - integer :: incx=1 - real*8 :: alpha=1 - real*8 :: beta=0 - ! 1 0 - ! 0 1 - - ! declaration of VA,IA,JA - integer :: nnz=2 - integer :: m=2 - integer :: k=2 - integer :: IA(2)=(/1, 2/) - integer :: JA(2)=(/1, 2/) - real*8 :: VA(2)=(/1, 1/) - real*8 :: x(2)=(/1, 1/)! reference x - real*8 :: cy(2)=(/1, 1/)! reference cy after - real*8 :: bcy(2)=(/0, 0/)! reference bcy before - real*8 :: y(2)=(/0, 0/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call a%set_triangle() - call a%set_lower() - call a%set_unit(.false.) - - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spsm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spsm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on d matrix 2 x 2 blocked 1 x 1 ussv alpha= 1 beta= 0 incx=1 incy=1 trans=c is not ok" - if(res == 0)print*,"on d matrix 2 x 2 blocked 1 x 1 ussv alpha= 1 beta= 0 incx=1 incy=1 trans=c is ok" -end subroutine d_ussv_2_c_ap1_bm0_ix1_iy1 -! - -subroutine d_ussv_2_n_am1_bm0_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_d_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='n' - integer :: incx=1 - real*8 :: alpha=-1 - real*8 :: beta=0 - ! 1 0 - ! 1 1 - - ! declaration of VA,IA,JA - integer :: nnz=3 - integer :: m=2 - integer :: k=2 - integer :: IA(3)=(/1, 2, 2/) - integer :: JA(3)=(/1, 1, 2/) - real*8 :: VA(3)=(/1, 1, 1/) - real*8 :: x(2)=(/-1, -2/)! reference x - real*8 :: cy(2)=(/1, 1/)! reference cy after - real*8 :: bcy(2)=(/0, 0/)! reference bcy before - real*8 :: y(2)=(/0, 0/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call a%set_triangle() - call a%set_lower() - call a%set_unit(.false.) - - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spsm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spsm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on d matrix 2 x 2 blocked 1 x 1 ussv alpha=-1 beta= 0 incx=1 incy=1 trans=n is not ok" - if(res == 0)print*,"on d matrix 2 x 2 blocked 1 x 1 ussv alpha=-1 beta= 0 incx=1 incy=1 trans=n is ok" -end subroutine d_ussv_2_n_am1_bm0_ix1_iy1 -! - -subroutine d_ussv_2_t_am1_bm0_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_d_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='t' - integer :: incx=1 - real*8 :: alpha=-1 - real*8 :: beta=0 - ! 1 0 - ! 6 1 - - ! declaration of VA,IA,JA - integer :: nnz=3 - integer :: m=2 - integer :: k=2 - integer :: IA(3)=(/1, 2, 2/) - integer :: JA(3)=(/1, 1, 2/) - real*8 :: VA(3)=(/1, 6, 1/) - real*8 :: x(2)=(/-7, -1/)! reference x - real*8 :: cy(2)=(/1, 1/)! reference cy after - real*8 :: bcy(2)=(/0, 0/)! reference bcy before - real*8 :: y(2)=(/0, 0/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call a%set_triangle() - call a%set_lower() - call a%set_unit(.false.) - - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spsm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spsm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on d matrix 2 x 2 blocked 1 x 1 ussv alpha=-1 beta= 0 incx=1 incy=1 trans=t is not ok" - if(res == 0)print*,"on d matrix 2 x 2 blocked 1 x 1 ussv alpha=-1 beta= 0 incx=1 incy=1 trans=t is ok" -end subroutine d_ussv_2_t_am1_bm0_ix1_iy1 -! - -subroutine d_ussv_2_c_am1_bm0_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_d_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='c' - integer :: incx=1 - real*8 :: alpha=-1 - real*8 :: beta=0 - ! 1 0 - ! 2 1 - - ! declaration of VA,IA,JA - integer :: nnz=3 - integer :: m=2 - integer :: k=2 - integer :: IA(3)=(/1, 2, 2/) - integer :: JA(3)=(/1, 1, 2/) - real*8 :: VA(3)=(/1, 2, 1/) - real*8 :: x(2)=(/-3, -1/)! reference x - real*8 :: cy(2)=(/1, 1/)! reference cy after - real*8 :: bcy(2)=(/0, 0/)! reference bcy before - real*8 :: y(2)=(/0, 0/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call a%set_triangle() - call a%set_lower() - call a%set_unit(.false.) - - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spsm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spsm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on d matrix 2 x 2 blocked 1 x 1 ussv alpha=-1 beta= 0 incx=1 incy=1 trans=c is not ok" - if(res == 0)print*,"on d matrix 2 x 2 blocked 1 x 1 ussv alpha=-1 beta= 0 incx=1 incy=1 trans=c is ok" -end subroutine d_ussv_2_c_am1_bm0_ix1_iy1 -! - -subroutine d_ussv_2_n_am3_bm0_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_d_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='n' - integer :: incx=1 - real*8 :: alpha=-3 - real*8 :: beta=0 - ! 1 0 - ! 1 1 - - ! declaration of VA,IA,JA - integer :: nnz=3 - integer :: m=2 - integer :: k=2 - integer :: IA(3)=(/1, 2, 2/) - integer :: JA(3)=(/1, 1, 2/) - real*8 :: VA(3)=(/1, 1, 1/) - real*8 :: x(2)=(/-3, -6/)! reference x - real*8 :: cy(2)=(/9, 9/)! reference cy after - real*8 :: bcy(2)=(/0, 0/)! reference bcy before - real*8 :: y(2)=(/0, 0/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call a%set_triangle() - call a%set_lower() - call a%set_unit(.false.) - - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spsm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spsm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on d matrix 2 x 2 blocked 1 x 1 ussv alpha=-3 beta= 0 incx=1 incy=1 trans=n is not ok" - if(res == 0)print*,"on d matrix 2 x 2 blocked 1 x 1 ussv alpha=-3 beta= 0 incx=1 incy=1 trans=n is ok" -end subroutine d_ussv_2_n_am3_bm0_ix1_iy1 -! - -subroutine d_ussv_2_t_am3_bm0_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_d_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='t' - integer :: incx=1 - real*8 :: alpha=-3 - real*8 :: beta=0 - ! 1 0 - ! 0 1 - - ! declaration of VA,IA,JA - integer :: nnz=2 - integer :: m=2 - integer :: k=2 - integer :: IA(2)=(/1, 2/) - integer :: JA(2)=(/1, 2/) - real*8 :: VA(2)=(/1, 1/) - real*8 :: x(2)=(/-3, -3/)! reference x - real*8 :: cy(2)=(/9, 9/)! reference cy after - real*8 :: bcy(2)=(/0, 0/)! reference bcy before - real*8 :: y(2)=(/0, 0/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call a%set_triangle() - call a%set_lower() - call a%set_unit(.false.) - - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spsm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spsm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on d matrix 2 x 2 blocked 1 x 1 ussv alpha=-3 beta= 0 incx=1 incy=1 trans=t is not ok" - if(res == 0)print*,"on d matrix 2 x 2 blocked 1 x 1 ussv alpha=-3 beta= 0 incx=1 incy=1 trans=t is ok" -end subroutine d_ussv_2_t_am3_bm0_ix1_iy1 -! - -subroutine d_ussv_2_c_am3_bm0_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_d_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='c' - integer :: incx=1 - real*8 :: alpha=-3 - real*8 :: beta=0 - ! 1 0 - ! 0 1 - - ! declaration of VA,IA,JA - integer :: nnz=2 - integer :: m=2 - integer :: k=2 - integer :: IA(2)=(/1, 2/) - integer :: JA(2)=(/1, 2/) - real*8 :: VA(2)=(/1, 1/) - real*8 :: x(2)=(/-3, -3/)! reference x - real*8 :: cy(2)=(/9, 9/)! reference cy after - real*8 :: bcy(2)=(/0, 0/)! reference bcy before - real*8 :: y(2)=(/0, 0/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call a%set_triangle() - call a%set_lower() - call a%set_unit(.false.) - - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spsm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spsm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on d matrix 2 x 2 blocked 1 x 1 ussv alpha=-3 beta= 0 incx=1 incy=1 trans=c is not ok" - if(res == 0)print*,"on d matrix 2 x 2 blocked 1 x 1 ussv alpha=-3 beta= 0 incx=1 incy=1 trans=c is ok" -end subroutine d_ussv_2_c_am3_bm0_ix1_iy1 -! - -subroutine c_usmv_2_n_ap3_bp1_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_c_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='n' - integer :: incx=1 - integer :: incy=1 - complex*8 :: alpha=3 - complex*8 :: beta=1 - ! 1+1i 0+0i - ! 1+1i 2+2i - - ! declaration of VA,IA,JA - integer :: nnz=3 - integer :: m=2 - integer :: k=2 - integer :: IA(3)=(/1, 2, 2/) - integer :: JA(3)=(/1, 1, 2/) - complex*8 :: VA(3)=(/(1.e0,1.e0), (1.e0,1.e0), (2,2)/) - complex*8 :: x(2)=(/1, 1/)! reference x - complex*8 :: cy(2)=(/(6.e0,3.e0), (12,9)/)! reference cy after - complex*8 :: bcy(2)=(/3, 3/)! reference bcy before - complex*8 :: y(2)=(/3, 3/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spmm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on c matrix 2 x 2 blocked 1 x 1 usmv alpha= 3 beta= 1 incx=1 incy=1 trans=n is not ok" - if(res == 0)print*,"on c matrix 2 x 2 blocked 1 x 1 usmv alpha= 3 beta= 1 incx=1 incy=1 trans=n is ok" -end subroutine c_usmv_2_n_ap3_bp1_ix1_iy1 -! - -subroutine c_usmv_2_t_ap3_bp1_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_c_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='t' - integer :: incx=1 - integer :: incy=1 - complex*8 :: alpha=3 - complex*8 :: beta=1 - ! 1+1i 0+0i - ! 0+1i 2+6i - - ! declaration of VA,IA,JA - integer :: nnz=3 - integer :: m=2 - integer :: k=2 - integer :: IA(3)=(/1, 2, 2/) - integer :: JA(3)=(/1, 1, 2/) - complex*8 :: VA(3)=(/(1.e0,1.e0), (0.e0,1.e0), (2,6)/) - complex*8 :: x(2)=(/1, 1/)! reference x - complex*8 :: cy(2)=(/(6.e0,6.e0), (9,18)/)! reference cy after - complex*8 :: bcy(2)=(/3, 3/)! reference bcy before - complex*8 :: y(2)=(/3, 3/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spmm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on c matrix 2 x 2 blocked 1 x 1 usmv alpha= 3 beta= 1 incx=1 incy=1 trans=t is not ok" - if(res == 0)print*,"on c matrix 2 x 2 blocked 1 x 1 usmv alpha= 3 beta= 1 incx=1 incy=1 trans=t is ok" -end subroutine c_usmv_2_t_ap3_bp1_ix1_iy1 -! - -subroutine c_usmv_2_c_ap3_bp1_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_c_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='c' - integer :: incx=1 - integer :: incy=1 - complex*8 :: alpha=3 - complex*8 :: beta=1 - ! 1+1i 3+2i - ! 0+3i 2+0i - - ! declaration of VA,IA,JA - integer :: nnz=4 - integer :: m=2 - integer :: k=2 - integer :: IA(4)=(/1, 1, 2, 2/) - integer :: JA(4)=(/1, 2, 1, 2/) - complex*8 :: VA(4)=(/(1.e0,1.e0), (3.e0,2.e0), (0.e0,3.e0), (2,0)/) - complex*8 :: x(2)=(/1, 1/)! reference x - complex*8 :: cy(2)=(/(6.e0,-12.e0), (18,-6)/)! reference cy after - complex*8 :: bcy(2)=(/3, 3/)! reference bcy before - complex*8 :: y(2)=(/3, 3/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spmm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on c matrix 2 x 2 blocked 1 x 1 usmv alpha= 3 beta= 1 incx=1 incy=1 trans=c is not ok" - if(res == 0)print*,"on c matrix 2 x 2 blocked 1 x 1 usmv alpha= 3 beta= 1 incx=1 incy=1 trans=c is ok" -end subroutine c_usmv_2_c_ap3_bp1_ix1_iy1 -! - -subroutine c_usmv_2_n_ap3_bm0_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_c_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='n' - integer :: incx=1 - integer :: incy=1 - complex*8 :: alpha=3 - complex*8 :: beta=0 - ! 1+1i 0+0i - ! 3+3i 6+0i - - ! declaration of VA,IA,JA - integer :: nnz=3 - integer :: m=2 - integer :: k=2 - integer :: IA(3)=(/1, 2, 2/) - integer :: JA(3)=(/1, 1, 2/) - complex*8 :: VA(3)=(/(1.e0,1.e0), (3.e0,3.e0), (6,0)/) - complex*8 :: x(2)=(/1, 1/)! reference x - complex*8 :: cy(2)=(/(3.e0,3.e0), (27,9)/)! reference cy after - complex*8 :: bcy(2)=(/3, 3/)! reference bcy before - complex*8 :: y(2)=(/3, 3/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spmm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on c matrix 2 x 2 blocked 1 x 1 usmv alpha= 3 beta= 0 incx=1 incy=1 trans=n is not ok" - if(res == 0)print*,"on c matrix 2 x 2 blocked 1 x 1 usmv alpha= 3 beta= 0 incx=1 incy=1 trans=n is ok" -end subroutine c_usmv_2_n_ap3_bm0_ix1_iy1 -! - -subroutine c_usmv_2_t_ap3_bm0_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_c_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='t' - integer :: incx=1 - integer :: incy=1 - complex*8 :: alpha=3 - complex*8 :: beta=0 - ! 1+1i 0+0i - ! 1+2i 2+0i - - ! declaration of VA,IA,JA - integer :: nnz=3 - integer :: m=2 - integer :: k=2 - integer :: IA(3)=(/1, 2, 2/) - integer :: JA(3)=(/1, 1, 2/) - complex*8 :: VA(3)=(/(1.e0,1.e0), (1.e0,2.e0), (2,0)/) - complex*8 :: x(2)=(/1, 1/)! reference x - complex*8 :: cy(2)=(/(6.e0,9.e0), (6,0)/)! reference cy after - complex*8 :: bcy(2)=(/3, 3/)! reference bcy before - complex*8 :: y(2)=(/3, 3/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spmm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on c matrix 2 x 2 blocked 1 x 1 usmv alpha= 3 beta= 0 incx=1 incy=1 trans=t is not ok" - if(res == 0)print*,"on c matrix 2 x 2 blocked 1 x 1 usmv alpha= 3 beta= 0 incx=1 incy=1 trans=t is ok" -end subroutine c_usmv_2_t_ap3_bm0_ix1_iy1 -! - -subroutine c_usmv_2_c_ap3_bm0_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_c_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='c' - integer :: incx=1 - integer :: incy=1 - complex*8 :: alpha=3 - complex*8 :: beta=0 - ! 1+1i 1+0i - ! 0+0i 2+0i - - ! declaration of VA,IA,JA - integer :: nnz=3 - integer :: m=2 - integer :: k=2 - integer :: IA(3)=(/1, 1, 2/) - integer :: JA(3)=(/1, 2, 2/) - complex*8 :: VA(3)=(/(1.e0,1.e0), (1.e0,0.e0), (2,0)/) - complex*8 :: x(2)=(/1, 1/)! reference x - complex*8 :: cy(2)=(/(3.e0,-3.e0), (9,0)/)! reference cy after - complex*8 :: bcy(2)=(/3, 3/)! reference bcy before - complex*8 :: y(2)=(/3, 3/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spmm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on c matrix 2 x 2 blocked 1 x 1 usmv alpha= 3 beta= 0 incx=1 incy=1 trans=c is not ok" - if(res == 0)print*,"on c matrix 2 x 2 blocked 1 x 1 usmv alpha= 3 beta= 0 incx=1 incy=1 trans=c is ok" -end subroutine c_usmv_2_c_ap3_bm0_ix1_iy1 -! - -subroutine c_usmv_2_n_ap1_bp1_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_c_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='n' - integer :: incx=1 - integer :: incy=1 - complex*8 :: alpha=1 - complex*8 :: beta=1 - ! 1+1i 0+0i - ! 5+1i 0+0i - - ! declaration of VA,IA,JA - integer :: nnz=2 - integer :: m=2 - integer :: k=2 - integer :: IA(2)=(/1, 2/) - integer :: JA(2)=(/1, 1/) - complex*8 :: VA(2)=(/(1.e0,1.e0), (5,1)/) - complex*8 :: x(2)=(/1, 1/)! reference x - complex*8 :: cy(2)=(/(4.e0,1.e0), (8,1)/)! reference cy after - complex*8 :: bcy(2)=(/3, 3/)! reference bcy before - complex*8 :: y(2)=(/3, 3/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spmm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on c matrix 2 x 2 blocked 1 x 1 usmv alpha= 1 beta= 1 incx=1 incy=1 trans=n is not ok" - if(res == 0)print*,"on c matrix 2 x 2 blocked 1 x 1 usmv alpha= 1 beta= 1 incx=1 incy=1 trans=n is ok" -end subroutine c_usmv_2_n_ap1_bp1_ix1_iy1 -! - -subroutine c_usmv_2_t_ap1_bp1_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_c_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='t' - integer :: incx=1 - integer :: incy=1 - complex*8 :: alpha=1 - complex*8 :: beta=1 - ! 1+1i 1+0i - ! 0+1i 0+1i - - ! declaration of VA,IA,JA - integer :: nnz=4 - integer :: m=2 - integer :: k=2 - integer :: IA(4)=(/1, 1, 2, 2/) - integer :: JA(4)=(/1, 2, 1, 2/) - complex*8 :: VA(4)=(/(1.e0,1.e0), (1.e0,0.e0), (0.e0,1.e0), (0,1)/) - complex*8 :: x(2)=(/1, 1/)! reference x - complex*8 :: cy(2)=(/(4.e0,2.e0), (4,1)/)! reference cy after - complex*8 :: bcy(2)=(/3, 3/)! reference bcy before - complex*8 :: y(2)=(/3, 3/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spmm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on c matrix 2 x 2 blocked 1 x 1 usmv alpha= 1 beta= 1 incx=1 incy=1 trans=t is not ok" - if(res == 0)print*,"on c matrix 2 x 2 blocked 1 x 1 usmv alpha= 1 beta= 1 incx=1 incy=1 trans=t is ok" -end subroutine c_usmv_2_t_ap1_bp1_ix1_iy1 -! - -subroutine c_usmv_2_c_ap1_bp1_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_c_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='c' - integer :: incx=1 - integer :: incy=1 - complex*8 :: alpha=1 - complex*8 :: beta=1 - ! 1+1i 0+2i - ! 0+3i 2+0i - - ! declaration of VA,IA,JA - integer :: nnz=4 - integer :: m=2 - integer :: k=2 - integer :: IA(4)=(/1, 1, 2, 2/) - integer :: JA(4)=(/1, 2, 1, 2/) - complex*8 :: VA(4)=(/(1.e0,1.e0), (0.e0,2.e0), (0.e0,3.e0), (2,0)/) - complex*8 :: x(2)=(/1, 1/)! reference x - complex*8 :: cy(2)=(/(4.e0,-4.e0), (5,-2)/)! reference cy after - complex*8 :: bcy(2)=(/3, 3/)! reference bcy before - complex*8 :: y(2)=(/3, 3/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spmm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on c matrix 2 x 2 blocked 1 x 1 usmv alpha= 1 beta= 1 incx=1 incy=1 trans=c is not ok" - if(res == 0)print*,"on c matrix 2 x 2 blocked 1 x 1 usmv alpha= 1 beta= 1 incx=1 incy=1 trans=c is ok" -end subroutine c_usmv_2_c_ap1_bp1_ix1_iy1 -! - -subroutine c_usmv_2_n_ap1_bm0_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_c_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='n' - integer :: incx=1 - integer :: incy=1 - complex*8 :: alpha=1 - complex*8 :: beta=0 - ! 1+1i 1+0i - ! 0+0i 3+1i - - ! declaration of VA,IA,JA - integer :: nnz=3 - integer :: m=2 - integer :: k=2 - integer :: IA(3)=(/1, 1, 2/) - integer :: JA(3)=(/1, 2, 2/) - complex*8 :: VA(3)=(/(1.e0,1.e0), (1.e0,0.e0), (3,1)/) - complex*8 :: x(2)=(/1, 1/)! reference x - complex*8 :: cy(2)=(/(2.e0,1.e0), (3,1)/)! reference cy after - complex*8 :: bcy(2)=(/3, 3/)! reference bcy before - complex*8 :: y(2)=(/3, 3/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spmm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on c matrix 2 x 2 blocked 1 x 1 usmv alpha= 1 beta= 0 incx=1 incy=1 trans=n is not ok" - if(res == 0)print*,"on c matrix 2 x 2 blocked 1 x 1 usmv alpha= 1 beta= 0 incx=1 incy=1 trans=n is ok" -end subroutine c_usmv_2_n_ap1_bm0_ix1_iy1 -! - -subroutine c_usmv_2_t_ap1_bm0_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_c_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='t' - integer :: incx=1 - integer :: incy=1 - complex*8 :: alpha=1 - complex*8 :: beta=0 - ! 1+1i 0+1i - ! 0+1i 3+5i - - ! declaration of VA,IA,JA - integer :: nnz=4 - integer :: m=2 - integer :: k=2 - integer :: IA(4)=(/1, 1, 2, 2/) - integer :: JA(4)=(/1, 2, 1, 2/) - complex*8 :: VA(4)=(/(1.e0,1.e0), (0.e0,1.e0), (0.e0,1.e0), (3,5)/) - complex*8 :: x(2)=(/1, 1/)! reference x - complex*8 :: cy(2)=(/(1.e0,2.e0), (3,6)/)! reference cy after - complex*8 :: bcy(2)=(/3, 3/)! reference bcy before - complex*8 :: y(2)=(/3, 3/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spmm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on c matrix 2 x 2 blocked 1 x 1 usmv alpha= 1 beta= 0 incx=1 incy=1 trans=t is not ok" - if(res == 0)print*,"on c matrix 2 x 2 blocked 1 x 1 usmv alpha= 1 beta= 0 incx=1 incy=1 trans=t is ok" -end subroutine c_usmv_2_t_ap1_bm0_ix1_iy1 -! - -subroutine c_usmv_2_c_ap1_bm0_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_c_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='c' - integer :: incx=1 - integer :: incy=1 - complex*8 :: alpha=1 - complex*8 :: beta=0 - ! 1+1i 0+1i - ! 0+0i 0+0i - - ! declaration of VA,IA,JA - integer :: nnz=2 - integer :: m=2 - integer :: k=2 - integer :: IA(2)=(/1, 1/) - integer :: JA(2)=(/1, 2/) - complex*8 :: VA(2)=(/(1.e0,1.e0), (0,1)/) - complex*8 :: x(2)=(/1, 1/)! reference x - complex*8 :: cy(2)=(/(1.e0,-1.e0), (0,-1)/)! reference cy after - complex*8 :: bcy(2)=(/3, 3/)! reference bcy before - complex*8 :: y(2)=(/3, 3/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spmm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on c matrix 2 x 2 blocked 1 x 1 usmv alpha= 1 beta= 0 incx=1 incy=1 trans=c is not ok" - if(res == 0)print*,"on c matrix 2 x 2 blocked 1 x 1 usmv alpha= 1 beta= 0 incx=1 incy=1 trans=c is ok" -end subroutine c_usmv_2_c_ap1_bm0_ix1_iy1 -! - -subroutine c_usmv_2_n_am1_bp1_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_c_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='n' - integer :: incx=1 - integer :: incy=1 - complex*8 :: alpha=-1 - complex*8 :: beta=1 - ! 1+1i 0+0i - ! 0+0i 1+0i - - ! declaration of VA,IA,JA - integer :: nnz=2 - integer :: m=2 - integer :: k=2 - integer :: IA(2)=(/1, 2/) - integer :: JA(2)=(/1, 2/) - complex*8 :: VA(2)=(/(1.e0,1.e0), (1,0)/) - complex*8 :: x(2)=(/1, 1/)! reference x - complex*8 :: cy(2)=(/(2.e0,-1.e0), (2,0)/)! reference cy after - complex*8 :: bcy(2)=(/3, 3/)! reference bcy before - complex*8 :: y(2)=(/3, 3/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spmm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on c matrix 2 x 2 blocked 1 x 1 usmv alpha=-1 beta= 1 incx=1 incy=1 trans=n is not ok" - if(res == 0)print*,"on c matrix 2 x 2 blocked 1 x 1 usmv alpha=-1 beta= 1 incx=1 incy=1 trans=n is ok" -end subroutine c_usmv_2_n_am1_bp1_ix1_iy1 -! - -subroutine c_usmv_2_t_am1_bp1_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_c_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='t' - integer :: incx=1 - integer :: incy=1 - complex*8 :: alpha=-1 - complex*8 :: beta=1 - ! 1+1i 3+0i - ! 1+3i 0+2i - - ! declaration of VA,IA,JA - integer :: nnz=4 - integer :: m=2 - integer :: k=2 - integer :: IA(4)=(/1, 1, 2, 2/) - integer :: JA(4)=(/1, 2, 1, 2/) - complex*8 :: VA(4)=(/(1.e0,1.e0), (3.e0,0.e0), (1.e0,3.e0), (0,2)/) - complex*8 :: x(2)=(/1, 1/)! reference x - complex*8 :: cy(2)=(/(1.e0,-4.e0), (0,-2)/)! reference cy after - complex*8 :: bcy(2)=(/3, 3/)! reference bcy before - complex*8 :: y(2)=(/3, 3/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spmm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on c matrix 2 x 2 blocked 1 x 1 usmv alpha=-1 beta= 1 incx=1 incy=1 trans=t is not ok" - if(res == 0)print*,"on c matrix 2 x 2 blocked 1 x 1 usmv alpha=-1 beta= 1 incx=1 incy=1 trans=t is ok" -end subroutine c_usmv_2_t_am1_bp1_ix1_iy1 -! - -subroutine c_usmv_2_c_am1_bp1_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_c_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='c' - integer :: incx=1 - integer :: incy=1 - complex*8 :: alpha=-1 - complex*8 :: beta=1 - ! 1+1i 0+0i - ! 1+2i 0+0i - - ! declaration of VA,IA,JA - integer :: nnz=2 - integer :: m=2 - integer :: k=2 - integer :: IA(2)=(/1, 2/) - integer :: JA(2)=(/1, 1/) - complex*8 :: VA(2)=(/(1.e0,1.e0), (1,2)/) - complex*8 :: x(2)=(/1, 1/)! reference x - complex*8 :: cy(2)=(/(1.e0,3.e0), (3,0)/)! reference cy after - complex*8 :: bcy(2)=(/3, 3/)! reference bcy before - complex*8 :: y(2)=(/3, 3/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spmm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on c matrix 2 x 2 blocked 1 x 1 usmv alpha=-1 beta= 1 incx=1 incy=1 trans=c is not ok" - if(res == 0)print*,"on c matrix 2 x 2 blocked 1 x 1 usmv alpha=-1 beta= 1 incx=1 incy=1 trans=c is ok" -end subroutine c_usmv_2_c_am1_bp1_ix1_iy1 -! - -subroutine c_usmv_2_n_am1_bm0_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_c_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='n' - integer :: incx=1 - integer :: incy=1 - complex*8 :: alpha=-1 - complex*8 :: beta=0 - ! 1+1i 1+0i - ! 2+0i 1+1i - - ! declaration of VA,IA,JA - integer :: nnz=4 - integer :: m=2 - integer :: k=2 - integer :: IA(4)=(/1, 1, 2, 2/) - integer :: JA(4)=(/1, 2, 1, 2/) - complex*8 :: VA(4)=(/(1.e0,1.e0), (1.e0,0.e0), (2.e0,0.e0), (1,1)/) - complex*8 :: x(2)=(/1, 1/)! reference x - complex*8 :: cy(2)=(/(-2.e0,-1.e0), (-3,-1)/)! reference cy after - complex*8 :: bcy(2)=(/3, 3/)! reference bcy before - complex*8 :: y(2)=(/3, 3/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spmm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on c matrix 2 x 2 blocked 1 x 1 usmv alpha=-1 beta= 0 incx=1 incy=1 trans=n is not ok" - if(res == 0)print*,"on c matrix 2 x 2 blocked 1 x 1 usmv alpha=-1 beta= 0 incx=1 incy=1 trans=n is ok" -end subroutine c_usmv_2_n_am1_bm0_ix1_iy1 -! - -subroutine c_usmv_2_t_am1_bm0_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_c_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='t' - integer :: incx=1 - integer :: incy=1 - complex*8 :: alpha=-1 - complex*8 :: beta=0 - ! 1+1i 1+3i - ! 0+0i 0+0i - - ! declaration of VA,IA,JA - integer :: nnz=2 - integer :: m=2 - integer :: k=2 - integer :: IA(2)=(/1, 1/) - integer :: JA(2)=(/1, 2/) - complex*8 :: VA(2)=(/(1.e0,1.e0), (1,3)/) - complex*8 :: x(2)=(/1, 1/)! reference x - complex*8 :: cy(2)=(/(-1.e0,-1.e0), (-1,-3)/)! reference cy after - complex*8 :: bcy(2)=(/3, 3/)! reference bcy before - complex*8 :: y(2)=(/3, 3/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spmm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on c matrix 2 x 2 blocked 1 x 1 usmv alpha=-1 beta= 0 incx=1 incy=1 trans=t is not ok" - if(res == 0)print*,"on c matrix 2 x 2 blocked 1 x 1 usmv alpha=-1 beta= 0 incx=1 incy=1 trans=t is ok" -end subroutine c_usmv_2_t_am1_bm0_ix1_iy1 -! - -subroutine c_usmv_2_c_am1_bm0_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_c_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='c' - integer :: incx=1 - integer :: incy=1 - complex*8 :: alpha=-1 - complex*8 :: beta=0 - ! 1+1i 1+0i - ! 0+1i 5+1i - - ! declaration of VA,IA,JA - integer :: nnz=4 - integer :: m=2 - integer :: k=2 - integer :: IA(4)=(/1, 1, 2, 2/) - integer :: JA(4)=(/1, 2, 1, 2/) - complex*8 :: VA(4)=(/(1.e0,1.e0), (1.e0,0.e0), (0.e0,1.e0), (5,1)/) - complex*8 :: x(2)=(/1, 1/)! reference x - complex*8 :: cy(2)=(/(-1.e0,2.e0), (-6,1)/)! reference cy after - complex*8 :: bcy(2)=(/3, 3/)! reference bcy before - complex*8 :: y(2)=(/3, 3/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spmm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on c matrix 2 x 2 blocked 1 x 1 usmv alpha=-1 beta= 0 incx=1 incy=1 trans=c is not ok" - if(res == 0)print*,"on c matrix 2 x 2 blocked 1 x 1 usmv alpha=-1 beta= 0 incx=1 incy=1 trans=c is ok" -end subroutine c_usmv_2_c_am1_bm0_ix1_iy1 -! - -subroutine c_usmv_2_n_am3_bp1_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_c_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='n' - integer :: incx=1 - integer :: incy=1 - complex*8 :: alpha=-3 - complex*8 :: beta=1 - ! 1+1i 0+0i - ! 3+1i 2+4i - - ! declaration of VA,IA,JA - integer :: nnz=3 - integer :: m=2 - integer :: k=2 - integer :: IA(3)=(/1, 2, 2/) - integer :: JA(3)=(/1, 1, 2/) - complex*8 :: VA(3)=(/(1.e0,1.e0), (3.e0,1.e0), (2,4)/) - complex*8 :: x(2)=(/1, 1/)! reference x - complex*8 :: cy(2)=(/(0.e0,-3.e0), (-12,-15)/)! reference cy after - complex*8 :: bcy(2)=(/3, 3/)! reference bcy before - complex*8 :: y(2)=(/3, 3/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spmm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on c matrix 2 x 2 blocked 1 x 1 usmv alpha=-3 beta= 1 incx=1 incy=1 trans=n is not ok" - if(res == 0)print*,"on c matrix 2 x 2 blocked 1 x 1 usmv alpha=-3 beta= 1 incx=1 incy=1 trans=n is ok" -end subroutine c_usmv_2_n_am3_bp1_ix1_iy1 -! - -subroutine c_usmv_2_t_am3_bp1_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_c_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='t' - integer :: incx=1 - integer :: incy=1 - complex*8 :: alpha=-3 - complex*8 :: beta=1 - ! 1+1i 0+1i - ! 0+0i 0+0i - - ! declaration of VA,IA,JA - integer :: nnz=2 - integer :: m=2 - integer :: k=2 - integer :: IA(2)=(/1, 1/) - integer :: JA(2)=(/1, 2/) - complex*8 :: VA(2)=(/(1.e0,1.e0), (0,1)/) - complex*8 :: x(2)=(/1, 1/)! reference x - complex*8 :: cy(2)=(/(0.e0,-3.e0), (3,-3)/)! reference cy after - complex*8 :: bcy(2)=(/3, 3/)! reference bcy before - complex*8 :: y(2)=(/3, 3/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spmm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on c matrix 2 x 2 blocked 1 x 1 usmv alpha=-3 beta= 1 incx=1 incy=1 trans=t is not ok" - if(res == 0)print*,"on c matrix 2 x 2 blocked 1 x 1 usmv alpha=-3 beta= 1 incx=1 incy=1 trans=t is ok" -end subroutine c_usmv_2_t_am3_bp1_ix1_iy1 -! - -subroutine c_usmv_2_c_am3_bp1_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_c_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='c' - integer :: incx=1 - integer :: incy=1 - complex*8 :: alpha=-3 - complex*8 :: beta=1 - ! 1+1i 1+0i - ! 1+1i 0+0i - - ! declaration of VA,IA,JA - integer :: nnz=3 - integer :: m=2 - integer :: k=2 - integer :: IA(3)=(/1, 1, 2/) - integer :: JA(3)=(/1, 2, 1/) - complex*8 :: VA(3)=(/(1.e0,1.e0), (1.e0,0.e0), (1,1)/) - complex*8 :: x(2)=(/1, 1/)! reference x - complex*8 :: cy(2)=(/(-3.e0,6.e0), (0,0)/)! reference cy after - complex*8 :: bcy(2)=(/3, 3/)! reference bcy before - complex*8 :: y(2)=(/3, 3/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spmm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on c matrix 2 x 2 blocked 1 x 1 usmv alpha=-3 beta= 1 incx=1 incy=1 trans=c is not ok" - if(res == 0)print*,"on c matrix 2 x 2 blocked 1 x 1 usmv alpha=-3 beta= 1 incx=1 incy=1 trans=c is ok" -end subroutine c_usmv_2_c_am3_bp1_ix1_iy1 -! - -subroutine c_usmv_2_n_am3_bm0_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_c_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='n' - integer :: incx=1 - integer :: incy=1 - complex*8 :: alpha=-3 - complex*8 :: beta=0 - ! 1+1i 0+0i - ! 0+2i 0+2i - - ! declaration of VA,IA,JA - integer :: nnz=3 - integer :: m=2 - integer :: k=2 - integer :: IA(3)=(/1, 2, 2/) - integer :: JA(3)=(/1, 1, 2/) - complex*8 :: VA(3)=(/(1.e0,1.e0), (0.e0,2.e0), (0,2)/) - complex*8 :: x(2)=(/1, 1/)! reference x - complex*8 :: cy(2)=(/(-3.e0,-3.e0), (0,-12)/)! reference cy after - complex*8 :: bcy(2)=(/3, 3/)! reference bcy before - complex*8 :: y(2)=(/3, 3/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spmm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on c matrix 2 x 2 blocked 1 x 1 usmv alpha=-3 beta= 0 incx=1 incy=1 trans=n is not ok" - if(res == 0)print*,"on c matrix 2 x 2 blocked 1 x 1 usmv alpha=-3 beta= 0 incx=1 incy=1 trans=n is ok" -end subroutine c_usmv_2_n_am3_bm0_ix1_iy1 -! - -subroutine c_usmv_2_t_am3_bm0_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_c_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='t' - integer :: incx=1 - integer :: incy=1 - complex*8 :: alpha=-3 - complex*8 :: beta=0 - ! 1+1i 0+0i - ! 1+3i 3+0i - - ! declaration of VA,IA,JA - integer :: nnz=3 - integer :: m=2 - integer :: k=2 - integer :: IA(3)=(/1, 2, 2/) - integer :: JA(3)=(/1, 1, 2/) - complex*8 :: VA(3)=(/(1.e0,1.e0), (1.e0,3.e0), (3,0)/) - complex*8 :: x(2)=(/1, 1/)! reference x - complex*8 :: cy(2)=(/(-6.e0,-12.e0), (-9,0)/)! reference cy after - complex*8 :: bcy(2)=(/3, 3/)! reference bcy before - complex*8 :: y(2)=(/3, 3/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spmm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on c matrix 2 x 2 blocked 1 x 1 usmv alpha=-3 beta= 0 incx=1 incy=1 trans=t is not ok" - if(res == 0)print*,"on c matrix 2 x 2 blocked 1 x 1 usmv alpha=-3 beta= 0 incx=1 incy=1 trans=t is ok" -end subroutine c_usmv_2_t_am3_bm0_ix1_iy1 -! - -subroutine c_usmv_2_c_am3_bm0_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_c_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='c' - integer :: incx=1 - integer :: incy=1 - complex*8 :: alpha=-3 - complex*8 :: beta=0 - ! 1+1i 3+1i - ! 0+1i 3+1i - - ! declaration of VA,IA,JA - integer :: nnz=4 - integer :: m=2 - integer :: k=2 - integer :: IA(4)=(/1, 1, 2, 2/) - integer :: JA(4)=(/1, 2, 1, 2/) - complex*8 :: VA(4)=(/(1.e0,1.e0), (3.e0,1.e0), (0.e0,1.e0), (3,1)/) - complex*8 :: x(2)=(/1, 1/)! reference x - complex*8 :: cy(2)=(/(-3.e0,6.e0), (-18,6)/)! reference cy after - complex*8 :: bcy(2)=(/3, 3/)! reference bcy before - complex*8 :: y(2)=(/3, 3/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spmm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on c matrix 2 x 2 blocked 1 x 1 usmv alpha=-3 beta= 0 incx=1 incy=1 trans=c is not ok" - if(res == 0)print*,"on c matrix 2 x 2 blocked 1 x 1 usmv alpha=-3 beta= 0 incx=1 incy=1 trans=c is ok" -end subroutine c_usmv_2_c_am3_bm0_ix1_iy1 -! - -subroutine c_ussv_2_n_ap3_bm0_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_c_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='n' - integer :: incx=1 - complex*8 :: alpha=3 - complex*8 :: beta=0 - ! 1 0 - ! 1 1 - - ! declaration of VA,IA,JA - integer :: nnz=3 - integer :: m=2 - integer :: k=2 - integer :: IA(3)=(/1, 2, 2/) - integer :: JA(3)=(/1, 1, 2/) - complex*8 :: VA(3)=(/1, 1, 1/) - complex*8 :: x(2)=(/3, 6/)! reference x - complex*8 :: cy(2)=(/9, 9/)! reference cy after - complex*8 :: bcy(2)=(/0, 0/)! reference bcy before - complex*8 :: y(2)=(/0, 0/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call a%set_triangle() - call a%set_lower() - call a%set_unit(.false.) - - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spsm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spsm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on c matrix 2 x 2 blocked 1 x 1 ussv alpha= 3 beta= 0 incx=1 incy=1 trans=n is not ok" - if(res == 0)print*,"on c matrix 2 x 2 blocked 1 x 1 ussv alpha= 3 beta= 0 incx=1 incy=1 trans=n is ok" -end subroutine c_ussv_2_n_ap3_bm0_ix1_iy1 -! - -subroutine c_ussv_2_t_ap3_bm0_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_c_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='t' - integer :: incx=1 - complex*8 :: alpha=3 - complex*8 :: beta=0 - ! 1+0i 0+0i - ! 0+2i 1+0i - - ! declaration of VA,IA,JA - integer :: nnz=3 - integer :: m=2 - integer :: k=2 - integer :: IA(3)=(/1, 2, 2/) - integer :: JA(3)=(/1, 1, 2/) - complex*8 :: VA(3)=(/(1.e0,0.e0), (0.e0,2.e0), (1,0)/) - complex*8 :: x(2)=(/(3.e0,6.e0), (3,0)/)! reference x - complex*8 :: cy(2)=(/9, 9/)! reference cy after - complex*8 :: bcy(2)=(/0, 0/)! reference bcy before - complex*8 :: y(2)=(/0, 0/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call a%set_triangle() - call a%set_lower() - call a%set_unit(.false.) - - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spsm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spsm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on c matrix 2 x 2 blocked 1 x 1 ussv alpha= 3 beta= 0 incx=1 incy=1 trans=t is not ok" - if(res == 0)print*,"on c matrix 2 x 2 blocked 1 x 1 ussv alpha= 3 beta= 0 incx=1 incy=1 trans=t is ok" -end subroutine c_ussv_2_t_ap3_bm0_ix1_iy1 -! - -subroutine c_ussv_2_c_ap3_bm0_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_c_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='c' - integer :: incx=1 - complex*8 :: alpha=3 - complex*8 :: beta=0 - ! 1+0i 0+0i - ! 0+4i 1+0i - - ! declaration of VA,IA,JA - integer :: nnz=3 - integer :: m=2 - integer :: k=2 - integer :: IA(3)=(/1, 2, 2/) - integer :: JA(3)=(/1, 1, 2/) - complex*8 :: VA(3)=(/(1.e0,0.e0), (0.e0,4.e0), (1,0)/) - complex*8 :: x(2)=(/(3.e0,-12.e0), (3,0)/)! reference x - complex*8 :: cy(2)=(/9, 9/)! reference cy after - complex*8 :: bcy(2)=(/0, 0/)! reference bcy before - complex*8 :: y(2)=(/0, 0/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call a%set_triangle() - call a%set_lower() - call a%set_unit(.false.) - - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spsm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spsm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on c matrix 2 x 2 blocked 1 x 1 ussv alpha= 3 beta= 0 incx=1 incy=1 trans=c is not ok" - if(res == 0)print*,"on c matrix 2 x 2 blocked 1 x 1 ussv alpha= 3 beta= 0 incx=1 incy=1 trans=c is ok" -end subroutine c_ussv_2_c_ap3_bm0_ix1_iy1 -! - -subroutine c_ussv_2_n_ap1_bm0_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_c_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='n' - integer :: incx=1 - complex*8 :: alpha=1 - complex*8 :: beta=0 - ! 1+0i 0+0i - ! 0+1i 1+0i - - ! declaration of VA,IA,JA - integer :: nnz=3 - integer :: m=2 - integer :: k=2 - integer :: IA(3)=(/1, 2, 2/) - integer :: JA(3)=(/1, 1, 2/) - complex*8 :: VA(3)=(/(1.e0,0.e0), (0.e0,1.e0), (1,0)/) - complex*8 :: x(2)=(/(1.e0,0.e0), (1,1)/)! reference x - complex*8 :: cy(2)=(/1, 1/)! reference cy after - complex*8 :: bcy(2)=(/0, 0/)! reference bcy before - complex*8 :: y(2)=(/0, 0/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call a%set_triangle() - call a%set_lower() - call a%set_unit(.false.) - - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spsm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spsm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on c matrix 2 x 2 blocked 1 x 1 ussv alpha= 1 beta= 0 incx=1 incy=1 trans=n is not ok" - if(res == 0)print*,"on c matrix 2 x 2 blocked 1 x 1 ussv alpha= 1 beta= 0 incx=1 incy=1 trans=n is ok" -end subroutine c_ussv_2_n_ap1_bm0_ix1_iy1 -! - -subroutine c_ussv_2_t_ap1_bm0_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_c_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='t' - integer :: incx=1 - complex*8 :: alpha=1 - complex*8 :: beta=0 - ! 1 0 - ! 0 1 - - ! declaration of VA,IA,JA - integer :: nnz=2 - integer :: m=2 - integer :: k=2 - integer :: IA(2)=(/1, 2/) - integer :: JA(2)=(/1, 2/) - complex*8 :: VA(2)=(/1, 1/) - complex*8 :: x(2)=(/1, 1/)! reference x - complex*8 :: cy(2)=(/1, 1/)! reference cy after - complex*8 :: bcy(2)=(/0, 0/)! reference bcy before - complex*8 :: y(2)=(/0, 0/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call a%set_triangle() - call a%set_lower() - call a%set_unit(.false.) - - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spsm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spsm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on c matrix 2 x 2 blocked 1 x 1 ussv alpha= 1 beta= 0 incx=1 incy=1 trans=t is not ok" - if(res == 0)print*,"on c matrix 2 x 2 blocked 1 x 1 ussv alpha= 1 beta= 0 incx=1 incy=1 trans=t is ok" -end subroutine c_ussv_2_t_ap1_bm0_ix1_iy1 -! - -subroutine c_ussv_2_c_ap1_bm0_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_c_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='c' - integer :: incx=1 - complex*8 :: alpha=1 - complex*8 :: beta=0 - ! 1+0i 0+0i - ! 3+3i 1+0i - - ! declaration of VA,IA,JA - integer :: nnz=3 - integer :: m=2 - integer :: k=2 - integer :: IA(3)=(/1, 2, 2/) - integer :: JA(3)=(/1, 1, 2/) - complex*8 :: VA(3)=(/(1.e0,0.e0), (3.e0,3.e0), (1,0)/) - complex*8 :: x(2)=(/(4.e0,-3.e0), (1,0)/)! reference x - complex*8 :: cy(2)=(/1, 1/)! reference cy after - complex*8 :: bcy(2)=(/0, 0/)! reference bcy before - complex*8 :: y(2)=(/0, 0/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call a%set_triangle() - call a%set_lower() - call a%set_unit(.false.) - - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spsm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spsm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on c matrix 2 x 2 blocked 1 x 1 ussv alpha= 1 beta= 0 incx=1 incy=1 trans=c is not ok" - if(res == 0)print*,"on c matrix 2 x 2 blocked 1 x 1 ussv alpha= 1 beta= 0 incx=1 incy=1 trans=c is ok" -end subroutine c_ussv_2_c_ap1_bm0_ix1_iy1 -! - -subroutine c_ussv_2_n_am1_bm0_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_c_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='n' - integer :: incx=1 - complex*8 :: alpha=-1 - complex*8 :: beta=0 - ! 1 0 - ! 5 1 - - ! declaration of VA,IA,JA - integer :: nnz=3 - integer :: m=2 - integer :: k=2 - integer :: IA(3)=(/1, 2, 2/) - integer :: JA(3)=(/1, 1, 2/) - complex*8 :: VA(3)=(/1, 5, 1/) - complex*8 :: x(2)=(/-1, -6/)! reference x - complex*8 :: cy(2)=(/1, 1/)! reference cy after - complex*8 :: bcy(2)=(/0, 0/)! reference bcy before - complex*8 :: y(2)=(/0, 0/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call a%set_triangle() - call a%set_lower() - call a%set_unit(.false.) - - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spsm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spsm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on c matrix 2 x 2 blocked 1 x 1 ussv alpha=-1 beta= 0 incx=1 incy=1 trans=n is not ok" - if(res == 0)print*,"on c matrix 2 x 2 blocked 1 x 1 ussv alpha=-1 beta= 0 incx=1 incy=1 trans=n is ok" -end subroutine c_ussv_2_n_am1_bm0_ix1_iy1 -! - -subroutine c_ussv_2_t_am1_bm0_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_c_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='t' - integer :: incx=1 - complex*8 :: alpha=-1 - complex*8 :: beta=0 - ! 1+0i 0+0i - ! 1+2i 1+0i - - ! declaration of VA,IA,JA - integer :: nnz=3 - integer :: m=2 - integer :: k=2 - integer :: IA(3)=(/1, 2, 2/) - integer :: JA(3)=(/1, 1, 2/) - complex*8 :: VA(3)=(/(1.e0,0.e0), (1.e0,2.e0), (1,0)/) - complex*8 :: x(2)=(/(-2.e0,-2.e0), (-1,0)/)! reference x - complex*8 :: cy(2)=(/1, 1/)! reference cy after - complex*8 :: bcy(2)=(/0, 0/)! reference bcy before - complex*8 :: y(2)=(/0, 0/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call a%set_triangle() - call a%set_lower() - call a%set_unit(.false.) - - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spsm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spsm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on c matrix 2 x 2 blocked 1 x 1 ussv alpha=-1 beta= 0 incx=1 incy=1 trans=t is not ok" - if(res == 0)print*,"on c matrix 2 x 2 blocked 1 x 1 ussv alpha=-1 beta= 0 incx=1 incy=1 trans=t is ok" -end subroutine c_ussv_2_t_am1_bm0_ix1_iy1 -! - -subroutine c_ussv_2_c_am1_bm0_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_c_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='c' - integer :: incx=1 - complex*8 :: alpha=-1 - complex*8 :: beta=0 - ! 1+0i 0+0i - ! 0+4i 1+0i - - ! declaration of VA,IA,JA - integer :: nnz=3 - integer :: m=2 - integer :: k=2 - integer :: IA(3)=(/1, 2, 2/) - integer :: JA(3)=(/1, 1, 2/) - complex*8 :: VA(3)=(/(1.e0,0.e0), (0.e0,4.e0), (1,0)/) - complex*8 :: x(2)=(/(-1.e0,4.e0), (-1,0)/)! reference x - complex*8 :: cy(2)=(/1, 1/)! reference cy after - complex*8 :: bcy(2)=(/0, 0/)! reference bcy before - complex*8 :: y(2)=(/0, 0/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call a%set_triangle() - call a%set_lower() - call a%set_unit(.false.) - - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spsm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spsm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on c matrix 2 x 2 blocked 1 x 1 ussv alpha=-1 beta= 0 incx=1 incy=1 trans=c is not ok" - if(res == 0)print*,"on c matrix 2 x 2 blocked 1 x 1 ussv alpha=-1 beta= 0 incx=1 incy=1 trans=c is ok" -end subroutine c_ussv_2_c_am1_bm0_ix1_iy1 -! - -subroutine c_ussv_2_n_am3_bm0_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_c_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='n' - integer :: incx=1 - complex*8 :: alpha=-3 - complex*8 :: beta=0 - ! 1+0i 0+0i - ! 1+1i 1+0i - - ! declaration of VA,IA,JA - integer :: nnz=3 - integer :: m=2 - integer :: k=2 - integer :: IA(3)=(/1, 2, 2/) - integer :: JA(3)=(/1, 1, 2/) - complex*8 :: VA(3)=(/(1.e0,0.e0), (1.e0,1.e0), (1,0)/) - complex*8 :: x(2)=(/(-3.e0,0.e0), (-6,-3)/)! reference x - complex*8 :: cy(2)=(/9, 9/)! reference cy after - complex*8 :: bcy(2)=(/0, 0/)! reference bcy before - complex*8 :: y(2)=(/0, 0/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call a%set_triangle() - call a%set_lower() - call a%set_unit(.false.) - - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spsm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spsm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on c matrix 2 x 2 blocked 1 x 1 ussv alpha=-3 beta= 0 incx=1 incy=1 trans=n is not ok" - if(res == 0)print*,"on c matrix 2 x 2 blocked 1 x 1 ussv alpha=-3 beta= 0 incx=1 incy=1 trans=n is ok" -end subroutine c_ussv_2_n_am3_bm0_ix1_iy1 -! - -subroutine c_ussv_2_t_am3_bm0_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_c_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='t' - integer :: incx=1 - complex*8 :: alpha=-3 - complex*8 :: beta=0 - ! 1 0 - ! 0 1 - - ! declaration of VA,IA,JA - integer :: nnz=2 - integer :: m=2 - integer :: k=2 - integer :: IA(2)=(/1, 2/) - integer :: JA(2)=(/1, 2/) - complex*8 :: VA(2)=(/1, 1/) - complex*8 :: x(2)=(/-3, -3/)! reference x - complex*8 :: cy(2)=(/9, 9/)! reference cy after - complex*8 :: bcy(2)=(/0, 0/)! reference bcy before - complex*8 :: y(2)=(/0, 0/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call a%set_triangle() - call a%set_lower() - call a%set_unit(.false.) - - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spsm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spsm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on c matrix 2 x 2 blocked 1 x 1 ussv alpha=-3 beta= 0 incx=1 incy=1 trans=t is not ok" - if(res == 0)print*,"on c matrix 2 x 2 blocked 1 x 1 ussv alpha=-3 beta= 0 incx=1 incy=1 trans=t is ok" -end subroutine c_ussv_2_t_am3_bm0_ix1_iy1 -! - -subroutine c_ussv_2_c_am3_bm0_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_c_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='c' - integer :: incx=1 - complex*8 :: alpha=-3 - complex*8 :: beta=0 - ! 1 0 - ! 0 1 - - ! declaration of VA,IA,JA - integer :: nnz=2 - integer :: m=2 - integer :: k=2 - integer :: IA(2)=(/1, 2/) - integer :: JA(2)=(/1, 2/) - complex*8 :: VA(2)=(/1, 1/) - complex*8 :: x(2)=(/-3, -3/)! reference x - complex*8 :: cy(2)=(/9, 9/)! reference cy after - complex*8 :: bcy(2)=(/0, 0/)! reference bcy before - complex*8 :: y(2)=(/0, 0/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call a%set_triangle() - call a%set_lower() - call a%set_unit(.false.) - - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spsm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spsm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on c matrix 2 x 2 blocked 1 x 1 ussv alpha=-3 beta= 0 incx=1 incy=1 trans=c is not ok" - if(res == 0)print*,"on c matrix 2 x 2 blocked 1 x 1 ussv alpha=-3 beta= 0 incx=1 incy=1 trans=c is ok" -end subroutine c_ussv_2_c_am3_bm0_ix1_iy1 -! - -subroutine z_usmv_2_n_ap3_bp1_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_z_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='n' - integer :: incx=1 - integer :: incy=1 - complex*16 :: alpha=3 - complex*16 :: beta=1 - ! 1+1i 1+0i - ! 5+1i 1+1i - - ! declaration of VA,IA,JA - integer :: nnz=4 - integer :: m=2 - integer :: k=2 - integer :: IA(4)=(/1, 1, 2, 2/) - integer :: JA(4)=(/1, 2, 1, 2/) - complex*16 :: VA(4)=(/(1.e0,1.e0), (1.e0,0.e0), (5.e0,1.e0), (1,1)/) - complex*16 :: x(2)=(/1, 1/)! reference x - complex*16 :: cy(2)=(/(9.e0,3.e0), (21,6)/)! reference cy after - complex*16 :: bcy(2)=(/3, 3/)! reference bcy before - complex*16 :: y(2)=(/3, 3/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spmm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on z matrix 2 x 2 blocked 1 x 1 usmv alpha= 3 beta= 1 incx=1 incy=1 trans=n is not ok" - if(res == 0)print*,"on z matrix 2 x 2 blocked 1 x 1 usmv alpha= 3 beta= 1 incx=1 incy=1 trans=n is ok" -end subroutine z_usmv_2_n_ap3_bp1_ix1_iy1 -! - -subroutine z_usmv_2_t_ap3_bp1_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_z_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='t' - integer :: incx=1 - integer :: incy=1 - complex*16 :: alpha=3 - complex*16 :: beta=1 - ! 1+1i 0+0i - ! 2+3i 2+2i - - ! declaration of VA,IA,JA - integer :: nnz=3 - integer :: m=2 - integer :: k=2 - integer :: IA(3)=(/1, 2, 2/) - integer :: JA(3)=(/1, 1, 2/) - complex*16 :: VA(3)=(/(1.e0,1.e0), (2.e0,3.e0), (2,2)/) - complex*16 :: x(2)=(/1, 1/)! reference x - complex*16 :: cy(2)=(/(12.e0,12.e0), (9,6)/)! reference cy after - complex*16 :: bcy(2)=(/3, 3/)! reference bcy before - complex*16 :: y(2)=(/3, 3/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spmm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on z matrix 2 x 2 blocked 1 x 1 usmv alpha= 3 beta= 1 incx=1 incy=1 trans=t is not ok" - if(res == 0)print*,"on z matrix 2 x 2 blocked 1 x 1 usmv alpha= 3 beta= 1 incx=1 incy=1 trans=t is ok" -end subroutine z_usmv_2_t_ap3_bp1_ix1_iy1 -! - -subroutine z_usmv_2_c_ap3_bp1_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_z_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='c' - integer :: incx=1 - integer :: incy=1 - complex*16 :: alpha=3 - complex*16 :: beta=1 - ! 1+1i 0+0i - ! 2+0i 1+3i - - ! declaration of VA,IA,JA - integer :: nnz=3 - integer :: m=2 - integer :: k=2 - integer :: IA(3)=(/1, 2, 2/) - integer :: JA(3)=(/1, 1, 2/) - complex*16 :: VA(3)=(/(1.e0,1.e0), (2.e0,0.e0), (1,3)/) - complex*16 :: x(2)=(/1, 1/)! reference x - complex*16 :: cy(2)=(/(12.e0,-3.e0), (6,-9)/)! reference cy after - complex*16 :: bcy(2)=(/3, 3/)! reference bcy before - complex*16 :: y(2)=(/3, 3/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spmm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on z matrix 2 x 2 blocked 1 x 1 usmv alpha= 3 beta= 1 incx=1 incy=1 trans=c is not ok" - if(res == 0)print*,"on z matrix 2 x 2 blocked 1 x 1 usmv alpha= 3 beta= 1 incx=1 incy=1 trans=c is ok" -end subroutine z_usmv_2_c_ap3_bp1_ix1_iy1 -! - -subroutine z_usmv_2_n_ap3_bm0_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_z_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='n' - integer :: incx=1 - integer :: incy=1 - complex*16 :: alpha=3 - complex*16 :: beta=0 - ! 1+1i 0+0i - ! 0+0i 0+2i - - ! declaration of VA,IA,JA - integer :: nnz=2 - integer :: m=2 - integer :: k=2 - integer :: IA(2)=(/1, 2/) - integer :: JA(2)=(/1, 2/) - complex*16 :: VA(2)=(/(1.e0,1.e0), (0,2)/) - complex*16 :: x(2)=(/1, 1/)! reference x - complex*16 :: cy(2)=(/(3.e0,3.e0), (0,6)/)! reference cy after - complex*16 :: bcy(2)=(/3, 3/)! reference bcy before - complex*16 :: y(2)=(/3, 3/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spmm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on z matrix 2 x 2 blocked 1 x 1 usmv alpha= 3 beta= 0 incx=1 incy=1 trans=n is not ok" - if(res == 0)print*,"on z matrix 2 x 2 blocked 1 x 1 usmv alpha= 3 beta= 0 incx=1 incy=1 trans=n is ok" -end subroutine z_usmv_2_n_ap3_bm0_ix1_iy1 -! - -subroutine z_usmv_2_t_ap3_bm0_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_z_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='t' - integer :: incx=1 - integer :: incy=1 - complex*16 :: alpha=3 - complex*16 :: beta=0 - ! 1+1i 0+1i - ! 1+0i 3+0i - - ! declaration of VA,IA,JA - integer :: nnz=4 - integer :: m=2 - integer :: k=2 - integer :: IA(4)=(/1, 1, 2, 2/) - integer :: JA(4)=(/1, 2, 1, 2/) - complex*16 :: VA(4)=(/(1.e0,1.e0), (0.e0,1.e0), (1.e0,0.e0), (3,0)/) - complex*16 :: x(2)=(/1, 1/)! reference x - complex*16 :: cy(2)=(/(6.e0,3.e0), (9,3)/)! reference cy after - complex*16 :: bcy(2)=(/3, 3/)! reference bcy before - complex*16 :: y(2)=(/3, 3/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spmm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on z matrix 2 x 2 blocked 1 x 1 usmv alpha= 3 beta= 0 incx=1 incy=1 trans=t is not ok" - if(res == 0)print*,"on z matrix 2 x 2 blocked 1 x 1 usmv alpha= 3 beta= 0 incx=1 incy=1 trans=t is ok" -end subroutine z_usmv_2_t_ap3_bm0_ix1_iy1 -! - -subroutine z_usmv_2_c_ap3_bm0_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_z_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='c' - integer :: incx=1 - integer :: incy=1 - complex*16 :: alpha=3 - complex*16 :: beta=0 - ! 1+1i 0+0i - ! 1+3i 0+0i - - ! declaration of VA,IA,JA - integer :: nnz=2 - integer :: m=2 - integer :: k=2 - integer :: IA(2)=(/1, 2/) - integer :: JA(2)=(/1, 1/) - complex*16 :: VA(2)=(/(1.e0,1.e0), (1,3)/) - complex*16 :: x(2)=(/1, 1/)! reference x - complex*16 :: cy(2)=(/(6.e0,-12.e0), (0,0)/)! reference cy after - complex*16 :: bcy(2)=(/3, 3/)! reference bcy before - complex*16 :: y(2)=(/3, 3/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spmm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on z matrix 2 x 2 blocked 1 x 1 usmv alpha= 3 beta= 0 incx=1 incy=1 trans=c is not ok" - if(res == 0)print*,"on z matrix 2 x 2 blocked 1 x 1 usmv alpha= 3 beta= 0 incx=1 incy=1 trans=c is ok" -end subroutine z_usmv_2_c_ap3_bm0_ix1_iy1 -! - -subroutine z_usmv_2_n_ap1_bp1_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_z_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='n' - integer :: incx=1 - integer :: incy=1 - complex*16 :: alpha=1 - complex*16 :: beta=1 - ! 1+1i 0+0i - ! 0+3i 0+0i - - ! declaration of VA,IA,JA - integer :: nnz=2 - integer :: m=2 - integer :: k=2 - integer :: IA(2)=(/1, 2/) - integer :: JA(2)=(/1, 1/) - complex*16 :: VA(2)=(/(1.e0,1.e0), (0,3)/) - complex*16 :: x(2)=(/1, 1/)! reference x - complex*16 :: cy(2)=(/(4.e0,1.e0), (3,3)/)! reference cy after - complex*16 :: bcy(2)=(/3, 3/)! reference bcy before - complex*16 :: y(2)=(/3, 3/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spmm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on z matrix 2 x 2 blocked 1 x 1 usmv alpha= 1 beta= 1 incx=1 incy=1 trans=n is not ok" - if(res == 0)print*,"on z matrix 2 x 2 blocked 1 x 1 usmv alpha= 1 beta= 1 incx=1 incy=1 trans=n is ok" -end subroutine z_usmv_2_n_ap1_bp1_ix1_iy1 -! - -subroutine z_usmv_2_t_ap1_bp1_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_z_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='t' - integer :: incx=1 - integer :: incy=1 - complex*16 :: alpha=1 - complex*16 :: beta=1 - ! 1+1i 0+0i - ! 0+1i 1+3i - - ! declaration of VA,IA,JA - integer :: nnz=3 - integer :: m=2 - integer :: k=2 - integer :: IA(3)=(/1, 2, 2/) - integer :: JA(3)=(/1, 1, 2/) - complex*16 :: VA(3)=(/(1.e0,1.e0), (0.e0,1.e0), (1,3)/) - complex*16 :: x(2)=(/1, 1/)! reference x - complex*16 :: cy(2)=(/(4.e0,2.e0), (4,3)/)! reference cy after - complex*16 :: bcy(2)=(/3, 3/)! reference bcy before - complex*16 :: y(2)=(/3, 3/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spmm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on z matrix 2 x 2 blocked 1 x 1 usmv alpha= 1 beta= 1 incx=1 incy=1 trans=t is not ok" - if(res == 0)print*,"on z matrix 2 x 2 blocked 1 x 1 usmv alpha= 1 beta= 1 incx=1 incy=1 trans=t is ok" -end subroutine z_usmv_2_t_ap1_bp1_ix1_iy1 -! - -subroutine z_usmv_2_c_ap1_bp1_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_z_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='c' - integer :: incx=1 - integer :: incy=1 - complex*16 :: alpha=1 - complex*16 :: beta=1 - ! 1+1i 1+3i - ! 0+0i 0+2i - - ! declaration of VA,IA,JA - integer :: nnz=3 - integer :: m=2 - integer :: k=2 - integer :: IA(3)=(/1, 1, 2/) - integer :: JA(3)=(/1, 2, 2/) - complex*16 :: VA(3)=(/(1.e0,1.e0), (1.e0,3.e0), (0,2)/) - complex*16 :: x(2)=(/1, 1/)! reference x - complex*16 :: cy(2)=(/(4.e0,-1.e0), (4,-5)/)! reference cy after - complex*16 :: bcy(2)=(/3, 3/)! reference bcy before - complex*16 :: y(2)=(/3, 3/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spmm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on z matrix 2 x 2 blocked 1 x 1 usmv alpha= 1 beta= 1 incx=1 incy=1 trans=c is not ok" - if(res == 0)print*,"on z matrix 2 x 2 blocked 1 x 1 usmv alpha= 1 beta= 1 incx=1 incy=1 trans=c is ok" -end subroutine z_usmv_2_c_ap1_bp1_ix1_iy1 -! - -subroutine z_usmv_2_n_ap1_bm0_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_z_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='n' - integer :: incx=1 - integer :: incy=1 - complex*16 :: alpha=1 - complex*16 :: beta=0 - ! 1+1i 3+2i - ! 0+0i 0+4i - - ! declaration of VA,IA,JA - integer :: nnz=3 - integer :: m=2 - integer :: k=2 - integer :: IA(3)=(/1, 1, 2/) - integer :: JA(3)=(/1, 2, 2/) - complex*16 :: VA(3)=(/(1.e0,1.e0), (3.e0,2.e0), (0,4)/) - complex*16 :: x(2)=(/1, 1/)! reference x - complex*16 :: cy(2)=(/(4.e0,3.e0), (0,4)/)! reference cy after - complex*16 :: bcy(2)=(/3, 3/)! reference bcy before - complex*16 :: y(2)=(/3, 3/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spmm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on z matrix 2 x 2 blocked 1 x 1 usmv alpha= 1 beta= 0 incx=1 incy=1 trans=n is not ok" - if(res == 0)print*,"on z matrix 2 x 2 blocked 1 x 1 usmv alpha= 1 beta= 0 incx=1 incy=1 trans=n is ok" -end subroutine z_usmv_2_n_ap1_bm0_ix1_iy1 -! - -subroutine z_usmv_2_t_ap1_bm0_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_z_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='t' - integer :: incx=1 - integer :: incy=1 - complex*16 :: alpha=1 - complex*16 :: beta=0 - ! 1+1i 0+0i - ! 0+4i 1+0i - - ! declaration of VA,IA,JA - integer :: nnz=3 - integer :: m=2 - integer :: k=2 - integer :: IA(3)=(/1, 2, 2/) - integer :: JA(3)=(/1, 1, 2/) - complex*16 :: VA(3)=(/(1.e0,1.e0), (0.e0,4.e0), (1,0)/) - complex*16 :: x(2)=(/1, 1/)! reference x - complex*16 :: cy(2)=(/(1.e0,5.e0), (1,0)/)! reference cy after - complex*16 :: bcy(2)=(/3, 3/)! reference bcy before - complex*16 :: y(2)=(/3, 3/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spmm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on z matrix 2 x 2 blocked 1 x 1 usmv alpha= 1 beta= 0 incx=1 incy=1 trans=t is not ok" - if(res == 0)print*,"on z matrix 2 x 2 blocked 1 x 1 usmv alpha= 1 beta= 0 incx=1 incy=1 trans=t is ok" -end subroutine z_usmv_2_t_ap1_bm0_ix1_iy1 -! - -subroutine z_usmv_2_c_ap1_bm0_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_z_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='c' - integer :: incx=1 - integer :: incy=1 - complex*16 :: alpha=1 - complex*16 :: beta=0 - ! 1+1i 0+0i - ! 1+3i 0+0i - - ! declaration of VA,IA,JA - integer :: nnz=2 - integer :: m=2 - integer :: k=2 - integer :: IA(2)=(/1, 2/) - integer :: JA(2)=(/1, 1/) - complex*16 :: VA(2)=(/(1.e0,1.e0), (1,3)/) - complex*16 :: x(2)=(/1, 1/)! reference x - complex*16 :: cy(2)=(/(2.e0,-4.e0), (0,0)/)! reference cy after - complex*16 :: bcy(2)=(/3, 3/)! reference bcy before - complex*16 :: y(2)=(/3, 3/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spmm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on z matrix 2 x 2 blocked 1 x 1 usmv alpha= 1 beta= 0 incx=1 incy=1 trans=c is not ok" - if(res == 0)print*,"on z matrix 2 x 2 blocked 1 x 1 usmv alpha= 1 beta= 0 incx=1 incy=1 trans=c is ok" -end subroutine z_usmv_2_c_ap1_bm0_ix1_iy1 -! - -subroutine z_usmv_2_n_am1_bp1_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_z_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='n' - integer :: incx=1 - integer :: incy=1 - complex*16 :: alpha=-1 - complex*16 :: beta=1 - ! 1+1i 0+0i - ! 3+2i 1+1i - - ! declaration of VA,IA,JA - integer :: nnz=3 - integer :: m=2 - integer :: k=2 - integer :: IA(3)=(/1, 2, 2/) - integer :: JA(3)=(/1, 1, 2/) - complex*16 :: VA(3)=(/(1.e0,1.e0), (3.e0,2.e0), (1,1)/) - complex*16 :: x(2)=(/1, 1/)! reference x - complex*16 :: cy(2)=(/(2.e0,-1.e0), (-1,-3)/)! reference cy after - complex*16 :: bcy(2)=(/3, 3/)! reference bcy before - complex*16 :: y(2)=(/3, 3/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spmm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on z matrix 2 x 2 blocked 1 x 1 usmv alpha=-1 beta= 1 incx=1 incy=1 trans=n is not ok" - if(res == 0)print*,"on z matrix 2 x 2 blocked 1 x 1 usmv alpha=-1 beta= 1 incx=1 incy=1 trans=n is ok" -end subroutine z_usmv_2_n_am1_bp1_ix1_iy1 -! - -subroutine z_usmv_2_t_am1_bp1_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_z_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='t' - integer :: incx=1 - integer :: incy=1 - complex*16 :: alpha=-1 - complex*16 :: beta=1 - ! 1+1i 0+0i - ! 0+3i 0+1i - - ! declaration of VA,IA,JA - integer :: nnz=3 - integer :: m=2 - integer :: k=2 - integer :: IA(3)=(/1, 2, 2/) - integer :: JA(3)=(/1, 1, 2/) - complex*16 :: VA(3)=(/(1.e0,1.e0), (0.e0,3.e0), (0,1)/) - complex*16 :: x(2)=(/1, 1/)! reference x - complex*16 :: cy(2)=(/(2.e0,-4.e0), (3,-1)/)! reference cy after - complex*16 :: bcy(2)=(/3, 3/)! reference bcy before - complex*16 :: y(2)=(/3, 3/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spmm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on z matrix 2 x 2 blocked 1 x 1 usmv alpha=-1 beta= 1 incx=1 incy=1 trans=t is not ok" - if(res == 0)print*,"on z matrix 2 x 2 blocked 1 x 1 usmv alpha=-1 beta= 1 incx=1 incy=1 trans=t is ok" -end subroutine z_usmv_2_t_am1_bp1_ix1_iy1 -! - -subroutine z_usmv_2_c_am1_bp1_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_z_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='c' - integer :: incx=1 - integer :: incy=1 - complex*16 :: alpha=-1 - complex*16 :: beta=1 - ! 1+1i 0+0i - ! 0+4i 1+0i - - ! declaration of VA,IA,JA - integer :: nnz=3 - integer :: m=2 - integer :: k=2 - integer :: IA(3)=(/1, 2, 2/) - integer :: JA(3)=(/1, 1, 2/) - complex*16 :: VA(3)=(/(1.e0,1.e0), (0.e0,4.e0), (1,0)/) - complex*16 :: x(2)=(/1, 1/)! reference x - complex*16 :: cy(2)=(/(2.e0,5.e0), (2,0)/)! reference cy after - complex*16 :: bcy(2)=(/3, 3/)! reference bcy before - complex*16 :: y(2)=(/3, 3/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spmm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on z matrix 2 x 2 blocked 1 x 1 usmv alpha=-1 beta= 1 incx=1 incy=1 trans=c is not ok" - if(res == 0)print*,"on z matrix 2 x 2 blocked 1 x 1 usmv alpha=-1 beta= 1 incx=1 incy=1 trans=c is ok" -end subroutine z_usmv_2_c_am1_bp1_ix1_iy1 -! - -subroutine z_usmv_2_n_am1_bm0_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_z_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='n' - integer :: incx=1 - integer :: incy=1 - complex*16 :: alpha=-1 - complex*16 :: beta=0 - ! 1+1i 0+0i - ! 5+3i 2+2i - - ! declaration of VA,IA,JA - integer :: nnz=3 - integer :: m=2 - integer :: k=2 - integer :: IA(3)=(/1, 2, 2/) - integer :: JA(3)=(/1, 1, 2/) - complex*16 :: VA(3)=(/(1.e0,1.e0), (5.e0,3.e0), (2,2)/) - complex*16 :: x(2)=(/1, 1/)! reference x - complex*16 :: cy(2)=(/(-1.e0,-1.e0), (-7,-5)/)! reference cy after - complex*16 :: bcy(2)=(/3, 3/)! reference bcy before - complex*16 :: y(2)=(/3, 3/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spmm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on z matrix 2 x 2 blocked 1 x 1 usmv alpha=-1 beta= 0 incx=1 incy=1 trans=n is not ok" - if(res == 0)print*,"on z matrix 2 x 2 blocked 1 x 1 usmv alpha=-1 beta= 0 incx=1 incy=1 trans=n is ok" -end subroutine z_usmv_2_n_am1_bm0_ix1_iy1 -! - -subroutine z_usmv_2_t_am1_bm0_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_z_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='t' - integer :: incx=1 - integer :: incy=1 - complex*16 :: alpha=-1 - complex*16 :: beta=0 - ! 1+1i 1+0i - ! 0+3i 3+1i - - ! declaration of VA,IA,JA - integer :: nnz=4 - integer :: m=2 - integer :: k=2 - integer :: IA(4)=(/1, 1, 2, 2/) - integer :: JA(4)=(/1, 2, 1, 2/) - complex*16 :: VA(4)=(/(1.e0,1.e0), (1.e0,0.e0), (0.e0,3.e0), (3,1)/) - complex*16 :: x(2)=(/1, 1/)! reference x - complex*16 :: cy(2)=(/(-1.e0,-4.e0), (-4,-1)/)! reference cy after - complex*16 :: bcy(2)=(/3, 3/)! reference bcy before - complex*16 :: y(2)=(/3, 3/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spmm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on z matrix 2 x 2 blocked 1 x 1 usmv alpha=-1 beta= 0 incx=1 incy=1 trans=t is not ok" - if(res == 0)print*,"on z matrix 2 x 2 blocked 1 x 1 usmv alpha=-1 beta= 0 incx=1 incy=1 trans=t is ok" -end subroutine z_usmv_2_t_am1_bm0_ix1_iy1 -! - -subroutine z_usmv_2_c_am1_bm0_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_z_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='c' - integer :: incx=1 - integer :: incy=1 - complex*16 :: alpha=-1 - complex*16 :: beta=0 - ! 1+1i 2+0i - ! 1+0i 0+1i - - ! declaration of VA,IA,JA - integer :: nnz=4 - integer :: m=2 - integer :: k=2 - integer :: IA(4)=(/1, 1, 2, 2/) - integer :: JA(4)=(/1, 2, 1, 2/) - complex*16 :: VA(4)=(/(1.e0,1.e0), (2.e0,0.e0), (1.e0,0.e0), (0,1)/) - complex*16 :: x(2)=(/1, 1/)! reference x - complex*16 :: cy(2)=(/(-2.e0,1.e0), (-2,1)/)! reference cy after - complex*16 :: bcy(2)=(/3, 3/)! reference bcy before - complex*16 :: y(2)=(/3, 3/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spmm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on z matrix 2 x 2 blocked 1 x 1 usmv alpha=-1 beta= 0 incx=1 incy=1 trans=c is not ok" - if(res == 0)print*,"on z matrix 2 x 2 blocked 1 x 1 usmv alpha=-1 beta= 0 incx=1 incy=1 trans=c is ok" -end subroutine z_usmv_2_c_am1_bm0_ix1_iy1 -! - -subroutine z_usmv_2_n_am3_bp1_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_z_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='n' - integer :: incx=1 - integer :: incy=1 - complex*16 :: alpha=-3 - complex*16 :: beta=1 - ! 1+1i 0+0i - ! 2+3i 0+1i - - ! declaration of VA,IA,JA - integer :: nnz=3 - integer :: m=2 - integer :: k=2 - integer :: IA(3)=(/1, 2, 2/) - integer :: JA(3)=(/1, 1, 2/) - complex*16 :: VA(3)=(/(1.e0,1.e0), (2.e0,3.e0), (0,1)/) - complex*16 :: x(2)=(/1, 1/)! reference x - complex*16 :: cy(2)=(/(0.e0,-3.e0), (-3,-12)/)! reference cy after - complex*16 :: bcy(2)=(/3, 3/)! reference bcy before - complex*16 :: y(2)=(/3, 3/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spmm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on z matrix 2 x 2 blocked 1 x 1 usmv alpha=-3 beta= 1 incx=1 incy=1 trans=n is not ok" - if(res == 0)print*,"on z matrix 2 x 2 blocked 1 x 1 usmv alpha=-3 beta= 1 incx=1 incy=1 trans=n is ok" -end subroutine z_usmv_2_n_am3_bp1_ix1_iy1 -! - -subroutine z_usmv_2_t_am3_bp1_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_z_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='t' - integer :: incx=1 - integer :: incy=1 - complex*16 :: alpha=-3 - complex*16 :: beta=1 - ! 1+1i 0+0i - ! 1+4i 2+4i - - ! declaration of VA,IA,JA - integer :: nnz=3 - integer :: m=2 - integer :: k=2 - integer :: IA(3)=(/1, 2, 2/) - integer :: JA(3)=(/1, 1, 2/) - complex*16 :: VA(3)=(/(1.e0,1.e0), (1.e0,4.e0), (2,4)/) - complex*16 :: x(2)=(/1, 1/)! reference x - complex*16 :: cy(2)=(/(-3.e0,-15.e0), (-3,-12)/)! reference cy after - complex*16 :: bcy(2)=(/3, 3/)! reference bcy before - complex*16 :: y(2)=(/3, 3/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spmm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on z matrix 2 x 2 blocked 1 x 1 usmv alpha=-3 beta= 1 incx=1 incy=1 trans=t is not ok" - if(res == 0)print*,"on z matrix 2 x 2 blocked 1 x 1 usmv alpha=-3 beta= 1 incx=1 incy=1 trans=t is ok" -end subroutine z_usmv_2_t_am3_bp1_ix1_iy1 -! - -subroutine z_usmv_2_c_am3_bp1_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_z_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='c' - integer :: incx=1 - integer :: incy=1 - complex*16 :: alpha=-3 - complex*16 :: beta=1 - ! 1+1i 0+2i - ! 2+0i 0+0i - - ! declaration of VA,IA,JA - integer :: nnz=3 - integer :: m=2 - integer :: k=2 - integer :: IA(3)=(/1, 1, 2/) - integer :: JA(3)=(/1, 2, 1/) - complex*16 :: VA(3)=(/(1.e0,1.e0), (0.e0,2.e0), (2,0)/) - complex*16 :: x(2)=(/1, 1/)! reference x - complex*16 :: cy(2)=(/(-6.e0,3.e0), (3,6)/)! reference cy after - complex*16 :: bcy(2)=(/3, 3/)! reference bcy before - complex*16 :: y(2)=(/3, 3/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spmm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on z matrix 2 x 2 blocked 1 x 1 usmv alpha=-3 beta= 1 incx=1 incy=1 trans=c is not ok" - if(res == 0)print*,"on z matrix 2 x 2 blocked 1 x 1 usmv alpha=-3 beta= 1 incx=1 incy=1 trans=c is ok" -end subroutine z_usmv_2_c_am3_bp1_ix1_iy1 -! - -subroutine z_usmv_2_n_am3_bm0_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_z_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='n' - integer :: incx=1 - integer :: incy=1 - complex*16 :: alpha=-3 - complex*16 :: beta=0 - ! 1+1i 0+3i - ! 0+1i 1+1i - - ! declaration of VA,IA,JA - integer :: nnz=4 - integer :: m=2 - integer :: k=2 - integer :: IA(4)=(/1, 1, 2, 2/) - integer :: JA(4)=(/1, 2, 1, 2/) - complex*16 :: VA(4)=(/(1.e0,1.e0), (0.e0,3.e0), (0.e0,1.e0), (1,1)/) - complex*16 :: x(2)=(/1, 1/)! reference x - complex*16 :: cy(2)=(/(-3.e0,-12.e0), (-3,-6)/)! reference cy after - complex*16 :: bcy(2)=(/3, 3/)! reference bcy before - complex*16 :: y(2)=(/3, 3/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spmm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on z matrix 2 x 2 blocked 1 x 1 usmv alpha=-3 beta= 0 incx=1 incy=1 trans=n is not ok" - if(res == 0)print*,"on z matrix 2 x 2 blocked 1 x 1 usmv alpha=-3 beta= 0 incx=1 incy=1 trans=n is ok" -end subroutine z_usmv_2_n_am3_bm0_ix1_iy1 -! - -subroutine z_usmv_2_t_am3_bm0_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_z_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='t' - integer :: incx=1 - integer :: incy=1 - complex*16 :: alpha=-3 - complex*16 :: beta=0 - ! 1+1i 0+1i - ! 0+3i 1+5i - - ! declaration of VA,IA,JA - integer :: nnz=4 - integer :: m=2 - integer :: k=2 - integer :: IA(4)=(/1, 1, 2, 2/) - integer :: JA(4)=(/1, 2, 1, 2/) - complex*16 :: VA(4)=(/(1.e0,1.e0), (0.e0,1.e0), (0.e0,3.e0), (1,5)/) - complex*16 :: x(2)=(/1, 1/)! reference x - complex*16 :: cy(2)=(/(-3.e0,-12.e0), (-3,-18)/)! reference cy after - complex*16 :: bcy(2)=(/3, 3/)! reference bcy before - complex*16 :: y(2)=(/3, 3/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spmm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on z matrix 2 x 2 blocked 1 x 1 usmv alpha=-3 beta= 0 incx=1 incy=1 trans=t is not ok" - if(res == 0)print*,"on z matrix 2 x 2 blocked 1 x 1 usmv alpha=-3 beta= 0 incx=1 incy=1 trans=t is ok" -end subroutine z_usmv_2_t_am3_bm0_ix1_iy1 -! - -subroutine z_usmv_2_c_am3_bm0_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_z_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='c' - integer :: incx=1 - integer :: incy=1 - complex*16 :: alpha=-3 - complex*16 :: beta=0 - ! 1+1i 0+0i - ! 0+0i 0+0i - - ! declaration of VA,IA,JA - integer :: nnz=1 - integer :: m=2 - integer :: k=2 - integer :: IA(1)=(/1/) - integer :: JA(1)=(/1/) - complex*16 :: VA(1)=(/(1,1)/) - complex*16 :: x(2)=(/1, 1/)! reference x - complex*16 :: cy(2)=(/(-3.e0,3.e0), (0,0)/)! reference cy after - complex*16 :: bcy(2)=(/3, 3/)! reference bcy before - complex*16 :: y(2)=(/3, 3/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spmm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on z matrix 2 x 2 blocked 1 x 1 usmv alpha=-3 beta= 0 incx=1 incy=1 trans=c is not ok" - if(res == 0)print*,"on z matrix 2 x 2 blocked 1 x 1 usmv alpha=-3 beta= 0 incx=1 incy=1 trans=c is ok" -end subroutine z_usmv_2_c_am3_bm0_ix1_iy1 -! - -subroutine z_ussv_2_n_ap3_bm0_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_z_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='n' - integer :: incx=1 - complex*16 :: alpha=3 - complex*16 :: beta=0 - ! 1+0i 0+0i - ! 0+2i 1+0i - - ! declaration of VA,IA,JA - integer :: nnz=3 - integer :: m=2 - integer :: k=2 - integer :: IA(3)=(/1, 2, 2/) - integer :: JA(3)=(/1, 1, 2/) - complex*16 :: VA(3)=(/(1.e0,0.e0), (0.e0,2.e0), (1,0)/) - complex*16 :: x(2)=(/(3.e0,0.e0), (3,6)/)! reference x - complex*16 :: cy(2)=(/9, 9/)! reference cy after - complex*16 :: bcy(2)=(/0, 0/)! reference bcy before - complex*16 :: y(2)=(/0, 0/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call a%set_triangle() - call a%set_lower() - call a%set_unit(.false.) - - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spsm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spsm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on z matrix 2 x 2 blocked 1 x 1 ussv alpha= 3 beta= 0 incx=1 incy=1 trans=n is not ok" - if(res == 0)print*,"on z matrix 2 x 2 blocked 1 x 1 ussv alpha= 3 beta= 0 incx=1 incy=1 trans=n is ok" -end subroutine z_ussv_2_n_ap3_bm0_ix1_iy1 -! - -subroutine z_ussv_2_t_ap3_bm0_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_z_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='t' - integer :: incx=1 - complex*16 :: alpha=3 - complex*16 :: beta=0 - ! 1+0i 0+0i - ! 0+1i 1+0i - - ! declaration of VA,IA,JA - integer :: nnz=3 - integer :: m=2 - integer :: k=2 - integer :: IA(3)=(/1, 2, 2/) - integer :: JA(3)=(/1, 1, 2/) - complex*16 :: VA(3)=(/(1.e0,0.e0), (0.e0,1.e0), (1,0)/) - complex*16 :: x(2)=(/(3.e0,3.e0), (3,0)/)! reference x - complex*16 :: cy(2)=(/9, 9/)! reference cy after - complex*16 :: bcy(2)=(/0, 0/)! reference bcy before - complex*16 :: y(2)=(/0, 0/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call a%set_triangle() - call a%set_lower() - call a%set_unit(.false.) - - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spsm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spsm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on z matrix 2 x 2 blocked 1 x 1 ussv alpha= 3 beta= 0 incx=1 incy=1 trans=t is not ok" - if(res == 0)print*,"on z matrix 2 x 2 blocked 1 x 1 ussv alpha= 3 beta= 0 incx=1 incy=1 trans=t is ok" -end subroutine z_ussv_2_t_ap3_bm0_ix1_iy1 -! - -subroutine z_ussv_2_c_ap3_bm0_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_z_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='c' - integer :: incx=1 - complex*16 :: alpha=3 - complex*16 :: beta=0 - ! 1 0 - ! 1 1 - - ! declaration of VA,IA,JA - integer :: nnz=3 - integer :: m=2 - integer :: k=2 - integer :: IA(3)=(/1, 2, 2/) - integer :: JA(3)=(/1, 1, 2/) - complex*16 :: VA(3)=(/1, 1, 1/) - complex*16 :: x(2)=(/6, 3/)! reference x - complex*16 :: cy(2)=(/9, 9/)! reference cy after - complex*16 :: bcy(2)=(/0, 0/)! reference bcy before - complex*16 :: y(2)=(/0, 0/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call a%set_triangle() - call a%set_lower() - call a%set_unit(.false.) - - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spsm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spsm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on z matrix 2 x 2 blocked 1 x 1 ussv alpha= 3 beta= 0 incx=1 incy=1 trans=c is not ok" - if(res == 0)print*,"on z matrix 2 x 2 blocked 1 x 1 ussv alpha= 3 beta= 0 incx=1 incy=1 trans=c is ok" -end subroutine z_ussv_2_c_ap3_bm0_ix1_iy1 -! - -subroutine z_ussv_2_n_ap1_bm0_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_z_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='n' - integer :: incx=1 - complex*16 :: alpha=1 - complex*16 :: beta=0 - ! 1+0i 0+0i - ! 1+5i 1+0i - - ! declaration of VA,IA,JA - integer :: nnz=3 - integer :: m=2 - integer :: k=2 - integer :: IA(3)=(/1, 2, 2/) - integer :: JA(3)=(/1, 1, 2/) - complex*16 :: VA(3)=(/(1.e0,0.e0), (1.e0,5.e0), (1,0)/) - complex*16 :: x(2)=(/(1.e0,0.e0), (2,5)/)! reference x - complex*16 :: cy(2)=(/1, 1/)! reference cy after - complex*16 :: bcy(2)=(/0, 0/)! reference bcy before - complex*16 :: y(2)=(/0, 0/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call a%set_triangle() - call a%set_lower() - call a%set_unit(.false.) - - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spsm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spsm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on z matrix 2 x 2 blocked 1 x 1 ussv alpha= 1 beta= 0 incx=1 incy=1 trans=n is not ok" - if(res == 0)print*,"on z matrix 2 x 2 blocked 1 x 1 ussv alpha= 1 beta= 0 incx=1 incy=1 trans=n is ok" -end subroutine z_ussv_2_n_ap1_bm0_ix1_iy1 -! - -subroutine z_ussv_2_t_ap1_bm0_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_z_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='t' - integer :: incx=1 - complex*16 :: alpha=1 - complex*16 :: beta=0 - ! 1 0 - ! 0 1 - - ! declaration of VA,IA,JA - integer :: nnz=2 - integer :: m=2 - integer :: k=2 - integer :: IA(2)=(/1, 2/) - integer :: JA(2)=(/1, 2/) - complex*16 :: VA(2)=(/1, 1/) - complex*16 :: x(2)=(/1, 1/)! reference x - complex*16 :: cy(2)=(/1, 1/)! reference cy after - complex*16 :: bcy(2)=(/0, 0/)! reference bcy before - complex*16 :: y(2)=(/0, 0/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call a%set_triangle() - call a%set_lower() - call a%set_unit(.false.) - - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spsm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spsm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on z matrix 2 x 2 blocked 1 x 1 ussv alpha= 1 beta= 0 incx=1 incy=1 trans=t is not ok" - if(res == 0)print*,"on z matrix 2 x 2 blocked 1 x 1 ussv alpha= 1 beta= 0 incx=1 incy=1 trans=t is ok" -end subroutine z_ussv_2_t_ap1_bm0_ix1_iy1 -! - -subroutine z_ussv_2_c_ap1_bm0_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_z_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='c' - integer :: incx=1 - complex*16 :: alpha=1 - complex*16 :: beta=0 - ! 1 0 - ! 2 1 - - ! declaration of VA,IA,JA - integer :: nnz=3 - integer :: m=2 - integer :: k=2 - integer :: IA(3)=(/1, 2, 2/) - integer :: JA(3)=(/1, 1, 2/) - complex*16 :: VA(3)=(/1, 2, 1/) - complex*16 :: x(2)=(/3, 1/)! reference x - complex*16 :: cy(2)=(/1, 1/)! reference cy after - complex*16 :: bcy(2)=(/0, 0/)! reference bcy before - complex*16 :: y(2)=(/0, 0/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call a%set_triangle() - call a%set_lower() - call a%set_unit(.false.) - - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spsm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spsm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on z matrix 2 x 2 blocked 1 x 1 ussv alpha= 1 beta= 0 incx=1 incy=1 trans=c is not ok" - if(res == 0)print*,"on z matrix 2 x 2 blocked 1 x 1 ussv alpha= 1 beta= 0 incx=1 incy=1 trans=c is ok" -end subroutine z_ussv_2_c_ap1_bm0_ix1_iy1 -! - -subroutine z_ussv_2_n_am1_bm0_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_z_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='n' - integer :: incx=1 - complex*16 :: alpha=-1 - complex*16 :: beta=0 - ! 1 0 - ! 2 1 - - ! declaration of VA,IA,JA - integer :: nnz=3 - integer :: m=2 - integer :: k=2 - integer :: IA(3)=(/1, 2, 2/) - integer :: JA(3)=(/1, 1, 2/) - complex*16 :: VA(3)=(/1, 2, 1/) - complex*16 :: x(2)=(/-1, -3/)! reference x - complex*16 :: cy(2)=(/1, 1/)! reference cy after - complex*16 :: bcy(2)=(/0, 0/)! reference bcy before - complex*16 :: y(2)=(/0, 0/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call a%set_triangle() - call a%set_lower() - call a%set_unit(.false.) - - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spsm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spsm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on z matrix 2 x 2 blocked 1 x 1 ussv alpha=-1 beta= 0 incx=1 incy=1 trans=n is not ok" - if(res == 0)print*,"on z matrix 2 x 2 blocked 1 x 1 ussv alpha=-1 beta= 0 incx=1 incy=1 trans=n is ok" -end subroutine z_ussv_2_n_am1_bm0_ix1_iy1 -! - -subroutine z_ussv_2_t_am1_bm0_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_z_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='t' - integer :: incx=1 - complex*16 :: alpha=-1 - complex*16 :: beta=0 - ! 1 0 - ! 0 1 - - ! declaration of VA,IA,JA - integer :: nnz=2 - integer :: m=2 - integer :: k=2 - integer :: IA(2)=(/1, 2/) - integer :: JA(2)=(/1, 2/) - complex*16 :: VA(2)=(/1, 1/) - complex*16 :: x(2)=(/-1, -1/)! reference x - complex*16 :: cy(2)=(/1, 1/)! reference cy after - complex*16 :: bcy(2)=(/0, 0/)! reference bcy before - complex*16 :: y(2)=(/0, 0/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call a%set_triangle() - call a%set_lower() - call a%set_unit(.false.) - - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spsm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spsm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on z matrix 2 x 2 blocked 1 x 1 ussv alpha=-1 beta= 0 incx=1 incy=1 trans=t is not ok" - if(res == 0)print*,"on z matrix 2 x 2 blocked 1 x 1 ussv alpha=-1 beta= 0 incx=1 incy=1 trans=t is ok" -end subroutine z_ussv_2_t_am1_bm0_ix1_iy1 -! - -subroutine z_ussv_2_c_am1_bm0_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_z_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='c' - integer :: incx=1 - complex*16 :: alpha=-1 - complex*16 :: beta=0 - ! 1 0 - ! 2 1 - - ! declaration of VA,IA,JA - integer :: nnz=3 - integer :: m=2 - integer :: k=2 - integer :: IA(3)=(/1, 2, 2/) - integer :: JA(3)=(/1, 1, 2/) - complex*16 :: VA(3)=(/1, 2, 1/) - complex*16 :: x(2)=(/-3, -1/)! reference x - complex*16 :: cy(2)=(/1, 1/)! reference cy after - complex*16 :: bcy(2)=(/0, 0/)! reference bcy before - complex*16 :: y(2)=(/0, 0/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call a%set_triangle() - call a%set_lower() - call a%set_unit(.false.) - - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spsm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spsm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on z matrix 2 x 2 blocked 1 x 1 ussv alpha=-1 beta= 0 incx=1 incy=1 trans=c is not ok" - if(res == 0)print*,"on z matrix 2 x 2 blocked 1 x 1 ussv alpha=-1 beta= 0 incx=1 incy=1 trans=c is ok" -end subroutine z_ussv_2_c_am1_bm0_ix1_iy1 -! - -subroutine z_ussv_2_n_am3_bm0_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_z_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='n' - integer :: incx=1 - complex*16 :: alpha=-3 - complex*16 :: beta=0 - ! 1 0 - ! 1 1 - - ! declaration of VA,IA,JA - integer :: nnz=3 - integer :: m=2 - integer :: k=2 - integer :: IA(3)=(/1, 2, 2/) - integer :: JA(3)=(/1, 1, 2/) - complex*16 :: VA(3)=(/1, 1, 1/) - complex*16 :: x(2)=(/-3, -6/)! reference x - complex*16 :: cy(2)=(/9, 9/)! reference cy after - complex*16 :: bcy(2)=(/0, 0/)! reference bcy before - complex*16 :: y(2)=(/0, 0/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call a%set_triangle() - call a%set_lower() - call a%set_unit(.false.) - - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spsm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spsm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on z matrix 2 x 2 blocked 1 x 1 ussv alpha=-3 beta= 0 incx=1 incy=1 trans=n is not ok" - if(res == 0)print*,"on z matrix 2 x 2 blocked 1 x 1 ussv alpha=-3 beta= 0 incx=1 incy=1 trans=n is ok" -end subroutine z_ussv_2_n_am3_bm0_ix1_iy1 -! - -subroutine z_ussv_2_t_am3_bm0_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_z_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='t' - integer :: incx=1 - complex*16 :: alpha=-3 - complex*16 :: beta=0 - ! 1+0i 0+0i - ! 1+3i 1+0i - - ! declaration of VA,IA,JA - integer :: nnz=3 - integer :: m=2 - integer :: k=2 - integer :: IA(3)=(/1, 2, 2/) - integer :: JA(3)=(/1, 1, 2/) - complex*16 :: VA(3)=(/(1.e0,0.e0), (1.e0,3.e0), (1,0)/) - complex*16 :: x(2)=(/(-6.e0,-9.e0), (-3,0)/)! reference x - complex*16 :: cy(2)=(/9, 9/)! reference cy after - complex*16 :: bcy(2)=(/0, 0/)! reference bcy before - complex*16 :: y(2)=(/0, 0/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call a%set_triangle() - call a%set_lower() - call a%set_unit(.false.) - - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spsm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spsm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on z matrix 2 x 2 blocked 1 x 1 ussv alpha=-3 beta= 0 incx=1 incy=1 trans=t is not ok" - if(res == 0)print*,"on z matrix 2 x 2 blocked 1 x 1 ussv alpha=-3 beta= 0 incx=1 incy=1 trans=t is ok" -end subroutine z_ussv_2_t_am3_bm0_ix1_iy1 -! - -subroutine z_ussv_2_c_am3_bm0_ix1_iy1(res,afmt,ictxt) - use psb_sparse_mod - implicit none - character(len=*) :: afmt - type(psb_z_sparse_mat) :: a - type(psb_desc_type) :: desc_a - integer :: ictxt, iam=-1, np=-1 - integer :: info=-1 - - integer::res,istat=0,i - character::transa='c' - integer :: incx=1 - complex*16 :: alpha=-3 - complex*16 :: beta=0 - ! 1+0i 0+0i - ! 2+3i 1+0i - - ! declaration of VA,IA,JA - integer :: nnz=3 - integer :: m=2 - integer :: k=2 - integer :: IA(3)=(/1, 2, 2/) - integer :: JA(3)=(/1, 1, 2/) - complex*16 :: VA(3)=(/(1.e0,0.e0), (2.e0,3.e0), (1,0)/) - complex*16 :: x(2)=(/(-9.e0,9.e0), (-3,0)/)! reference x - complex*16 :: cy(2)=(/9, 9/)! reference cy after - complex*16 :: bcy(2)=(/0, 0/)! reference bcy before - complex*16 :: y(2)=(/0, 0/)! y - - y=bcy - res=0 - call psb_info(ictxt,iam,np) - if(iam<0)then - info=-1 - goto 9999 - endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) - if (info /= psb_success_)goto 9996 - call psb_spall(a,desc_a,info,nnz=nnz) - if (info /= psb_success_)goto 9996 - call a%set_triangle() - call a%set_lower() - call a%set_unit(.false.) - - call psb_barrier(ictxt) - call psb_spins(nnz,IA,JA,VA,a,desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_cdasb(desc_a,info) - if (info /= psb_success_)goto 9996 - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - if(info.ne.0)print *,"matrix assembly failed" - if(info.ne.0)goto 9996 - - call psb_spsm(alpha,A,x,beta,y,desc_a,info,transa) - if(info.ne.0)print *,"psb_spsm failed" - if(info.ne.0)goto 9996 - do i=1,2 - if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy - if(y(i) /= cy(i))info=-1 - if(y(i) /= cy(i))goto 9996 - enddo -9996 continue - if(info /= psb_success_)res=res+1 - call psb_spfree(a,desc_a,info) - if (info /= psb_success_)goto 9997 -9997 continue - if(info /= psb_success_)res=res+1 - call psb_cdfree(desc_a,info) - if (info /= psb_success_)goto 9998 -9998 continue - if(info /= psb_success_)res=res+1 -9999 continue - if(info /= psb_success_)res=res+1 - if(res /= 0)print*,"on z matrix 2 x 2 blocked 1 x 1 ussv alpha=-3 beta= 0 incx=1 incy=1 trans=c is not ok" - if(res == 0)print*,"on z matrix 2 x 2 blocked 1 x 1 ussv alpha=-3 beta= 0 incx=1 incy=1 trans=c is ok" -end subroutine z_ussv_2_c_am3_bm0_ix1_iy1 + use psb_s_mvsv_tester + use psb_d_mvsv_tester + use psb_c_mvsv_tester + use psb_z_mvsv_tester end module psb_mvsv_tester