PLASMA  2.4.5
PLASMA - Parallel Linear Algebra for Scalable Multi-core Architectures
 All Data Structures Namespaces Files Functions Variables Typedefs Enumerations Enumerator Macros Groups
serrlq.f
Go to the documentation of this file.
1  SUBROUTINE serrlq( PATH, NUNIT )
2 *
3  include 'plasmaf.h'
4 *
5 * -- LAPACK test routine (version 3.1) --
6 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
7 * November 2006
8 *
9 * .. Scalar Arguments ..
10  CHARACTER*3 path
11  INTEGER nunit
12 * ..
13 *
14 * Purpose
15 * =======
16 *
17 * SERRLQ tests the error exits for the REAL routines
18 * that use the LQ decomposition of a general matrix.
19 *
20 * Arguments
21 * =========
22 *
23 * PATH (input) CHARACTER*3
24 * The LAPACK path name for the routines to be tested.
25 *
26 * NUNIT (input) INTEGER
27 * The unit number for output.
28 *
29 * =====================================================================
30 *
31 * .. Parameters ..
32  INTEGER nmax
33  parameter( nmax = 2 )
34 * ..
35 * .. Local Scalars ..
36  INTEGER i, info, j
37 * ..
38 * .. Local Arrays ..
39  REAL a( nmax, nmax ), af( nmax, nmax ), b( nmax ),
40  $ w( nmax ), x( nmax )
41  INTEGER ht( 2 )
42 * ..
43 * .. External Subroutines ..
44  EXTERNAL alaesm, chkxer, sgelq2, sgelqf, sorgl2,
45  $ sorglq, sorml2, sormlq
46 * ..
47 * .. Scalars in Common ..
48  LOGICAL lerr, ok
49  CHARACTER*32 srnamt
50  INTEGER infot, nout
51 * ..
52 * .. Common blocks ..
53  common / infoc / infot, nout, ok, lerr
54  common / srnamc / srnamt
55 * ..
56 * .. Intrinsic Functions ..
57  INTRINSIC real
58 * ..
59 * .. Executable Statements ..
60 *
61  nout = nunit
62  WRITE( nout, fmt = * )
63 *
64 * Disable PLASMA warnings/errors
65 *
66  CALL plasma_disable( plasma_warnings, info )
67  CALL plasma_disable( plasma_errors, info )
68 *
69 * Set the variables to innocuous values.
70 *
71  DO 20 j = 1, nmax
72  DO 10 i = 1, nmax
73  a( i, j ) = 1. / REAL( i+j )
74  af( i, j ) = 1. / REAL( i+j )
75  10 continue
76  b( j ) = 0.
77  w( j ) = 0.
78  x( j ) = 0.
79  20 continue
80  ok = .true.
81 *
82 * Allocate HT
83 *
84  CALL plasma_alloc_workspace_sgelqf( 2, 2, ht, info )
85 *
86 * Error exits for LQ factorization
87 *
88 * SGELQF
89 *
90  srnamt = 'SGELQF'
91  infot = 1
92  CALL plasma_sgelqf( -1, 0, a, 1, ht, info )
93  CALL chkxer( 'SGELQF', infot, nout, info, ok )
94  infot = 2
95  CALL plasma_sgelqf( 0, -1, a, 1, ht, info )
96  CALL chkxer( 'SGELQF', infot, nout, info, ok )
97  infot = 4
98  CALL plasma_sgelqf( 2, 1, a, 1, ht, info )
99  CALL chkxer( 'SGELQF', infot, nout, info, ok )
100 *
101 * SGELQS
102 *
103  srnamt = 'SGELQS'
104  infot = 1
105  CALL plasma_sgelqs( -1, 0, 0, a, 1, ht, b, 1, info )
106  CALL chkxer( 'SGELQS', infot, nout, info, ok )
107  infot = 2
108  CALL plasma_sgelqs( 0, -1, 0, a, 1, ht, b, 1, info )
109  CALL chkxer( 'SGELQS', infot, nout, info, ok )
110  infot = 2
111  CALL plasma_sgelqs( 2, 1, 0, a, 2, ht, b, 1, info )
112  CALL chkxer( 'SGELQS', infot, nout, info, ok )
113  infot = 3
114  CALL plasma_sgelqs( 0, 0, -1, a, 1, ht, b, 1, info )
115  CALL chkxer( 'SGELQS', infot, nout, info, ok )
116  infot = 5
117  CALL plasma_sgelqs( 2, 2, 0, a, 1, ht, b, 2, info )
118  CALL chkxer( 'SGELQS', infot, nout, info, ok )
119  infot = 8
120  CALL plasma_sgelqs( 1, 2, 0, a, 1, ht, b, 1, info )
121  CALL chkxer( 'SGELQS', infot, nout, info, ok )
122 *
123 * SORGLQ
124 *
125  srnamt = 'SORGLQ'
126  infot = 1
127  CALL plasma_sorglq( -1, 0, 0, a, 1, ht, w, 1, info )
128  CALL chkxer( 'SORGLQ', infot, nout, info, ok )
129  infot = 2
130  CALL plasma_sorglq( 0, -1, 0, a, 1, ht, w, 1, info )
131  CALL chkxer( 'SORGLQ', infot, nout, info, ok )
132  infot = 2
133  CALL plasma_sorglq( 2, 1, 0, a, 2, ht, w, 2, info )
134  CALL chkxer( 'SORGLQ', infot, nout, info, ok )
135  infot = 3
136  CALL plasma_sorglq( 0, 0, -1, a, 1, ht, w, 1, info )
137  CALL chkxer( 'SORGLQ', infot, nout, info, ok )
138  infot = 3
139  CALL plasma_sorglq( 1, 1, 2, a, 1, ht, w, 1, info )
140  CALL chkxer( 'SORGLQ', infot, nout, info, ok )
141  infot = 5
142  CALL plasma_sorglq( 2, 2, 0, a, 1, ht, w, 2, info )
143  CALL chkxer( 'SORGLQ', infot, nout, info, ok )
144  infot = 8
145  CALL plasma_sorglq( 2, 2, 0, a, 2, ht, w, 1, info )
146  CALL chkxer( 'SORGLQ', infot, nout, info, ok )
147 *
148 * SORMLQ
149 *
150  srnamt = 'SORMLQ'
151  infot = 1
152  CALL plasma_sormlq( '/', plasmatrans, 0, 0, 0, a, 1, ht, af, 1,
153  $ info )
154  CALL chkxer( 'SORMLQ', infot, nout, info, ok )
155  infot = 2
156  CALL plasma_sormlq( plasmaleft, '/', 0, 0, 0, a, 1, ht, af, 1,
157  $ info )
158  CALL chkxer( 'SORMLQ', infot, nout, info, ok )
159  infot = 3
160  CALL plasma_sormlq( plasmaleft, plasmatrans, -1, 0, 0, a, 1, ht,
161  $ af, 1, info )
162  CALL chkxer( 'SORMLQ', infot, nout, info, ok )
163  infot = 4
164  CALL plasma_sormlq( plasmaleft, plasmatrans, 0, -1, 0, a, 1, ht,
165  $ af, 1, info )
166  CALL chkxer( 'SORMLQ', infot, nout, info, ok )
167  infot = 5
168  CALL plasma_sormlq( plasmaleft, plasmatrans, 0, 0, -1, a, 1, ht,
169  $ af, 1, info )
170  CALL chkxer( 'SORMLQ', infot, nout, info, ok )
171 * INFOT = 5
172 * CALL PLASMA_SORMLQ( PLASMALEFT, PLASMATRANS, 0, 1, 1, A, 1, HT, AF, 1, INFO )
173 * CALL CHKXER( 'SORMLQ', INFOT, NOUT, INFO, OK )
174 * INFOT = 5
175 * CALL PLASMA_SORMLQ( PLASMARIGHT, PLASMATRANS, 1, 0, 1, A, 1, HT, AF, 1, INFO )
176 * CALL CHKXER( 'SORMLQ', INFOT, NOUT, INFO, OK )
177 * INFOT = 7
178 * CALL PLASMA_SORMLQ( PLASMALEFT, PLASMATRANS, 2, 0, 2, A, 1, HT, AF, 2, INFO )
179 * CALL CHKXER( 'SORMLQ', INFOT, NOUT, INFO, OK )
180 * INFOT = 7
181 * CALL PLASMA_SORMLQ( PLASMARIGHT, PLASMATRANS, 0, 2, 2, A, 1, HT, AF, 1, INFO )
182 * CALL CHKXER( 'SORMLQ', INFOT, NOUT, INFO, OK )
183 * INFOT = 10
184 * CALL PLASMA_SORMLQ( PLASMALEFT, PLASMATRANS, 2, 1, 0, A, 2, HT, AF, 1, INFO )
185 * CALL CHKXER( 'SORMLQ', INFOT, NOUT, INFO, OK )
186 * INFOT = 12
187 * CALL PLASMA_SORMLQ( PLASMALEFT, PLASMATRANS, 1, 2, 0, A, 1, HT, AF, 1, INFO )
188 * CALL CHKXER( 'SORMLQ', INFOT, NOUT, INFO, OK )
189 * INFOT = 12
190 * CALL PLASMA_SORMLQ( PLASMARIGHT, PLASMATRANS, 2, 1, 0, A, 1, HT, AF, 2, INFO )
191 * CALL CHKXER( 'SORMLQ', INFOT, NOUT, INFO, OK )
192 *
193 * Print a summary line.
194 *
195  CALL alaesm( path, ok, nout )
196 *
197 * Deallocate HT
198 *
199  CALL plasma_dealloc_handle( ht, info )
200 *
201 * Enable PLASMA warnings/errors
202 *
203  CALL plasma_enable( plasma_warnings, info )
204  CALL plasma_enable( plasma_errors, info )
205 *
206  return
207 *
208 * End of SERRLQ
209 *
210  END