MAGMA  1.2.0
MatrixAlgebraonGPUandMulticoreArchitectures
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Macros Groups
cerpo.f
Go to the documentation of this file.
1  SUBROUTINE cerrpo( PATH, NUNIT )
2 *
3 * -- LAPACK test routine (version 3.1) --
4 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
5 * November 2006
6 *
7 * .. Scalar Arguments ..
8  CHARACTER*3 path
9  INTEGER nunit
10 * ..
11 *
12 * Purpose
13 * =======
14 *
15 * CERRPO tests the error exits for the COMPLEX routines
16 * for Hermitian positive definite matrices.
17 *
18 * Arguments
19 * =========
20 *
21 * PATH (input) CHARACTER*3
22 * The LAPACK path name for the routines to be tested.
23 *
24 * NUNIT (input) INTEGER
25 * The unit number for output.
26 *
27 * =====================================================================
28 *
29 * .. Parameters ..
30  INTEGER nmax
31  parameter( nmax = 4 )
32 * ..
33 * .. Local Scalars ..
34  CHARACTER*2 c2
35  INTEGER i, info, j
36  REAL anrm, rcond
37 * ..
38 * .. Local Arrays ..
39  REAL r( nmax ), r1( nmax ), r2( nmax )
40  COMPLEX a( nmax, nmax ), af( nmax, nmax ), b( nmax ),
41  $ w( 2*nmax ), x( nmax )
42 * ..
43 * .. External Functions ..
44  LOGICAL lsamen
45  EXTERNAL lsamen
46 * ..
47 * .. External Subroutines ..
48  EXTERNAL alaesm, chkxer, cpbcon, cpbequ, cpbrfs, cpbtf2,
49  $ cpbtrf, cpbtrs, cpocon, cpoequ, cporfs, cpotf2,
50  $ cpotrf, cpotri, cpotrs, cppcon, cppequ, cpprfs,
51  $ cpptrf, cpptri, cpptrs
52 * ..
53 * .. Scalars in Common ..
54  LOGICAL lerr, ok
55  CHARACTER*32 srnamt
56  INTEGER infot, nout
57 * ..
58 * .. Common blocks ..
59  common / infoc / infot, nout, ok, lerr
60  common / srnamc / srnamt
61 * ..
62 * .. Intrinsic Functions ..
63  INTRINSIC cmplx, real
64 * ..
65 * .. Executable Statements ..
66 *
67  nout = nunit
68  WRITE( nout, fmt = * )
69  c2 = path( 2: 3 )
70 *
71 * Set the variables to innocuous values.
72 *
73  DO 20 j = 1, nmax
74  DO 10 i = 1, nmax
75  a( i, j ) = cmplx( 1. / REAL( I+J ), -1. / REAL( I+J ) )
76  af( i, j ) = cmplx( 1. / REAL( I+J ), -1. / REAL( I+J ) )
77  10 continue
78  b( j ) = 0.
79  r1( j ) = 0.
80  r2( j ) = 0.
81  w( j ) = 0.
82  x( j ) = 0.
83  20 continue
84  anrm = 1.
85  ok = .true.
86 *
87 * Test error exits of the routines that use the Cholesky
88 * decomposition of a Hermitian positive definite matrix.
89 *
90  IF( lsamen( 2, c2, 'PO' ) ) THEN
91 *
92 * CPOTRF
93 *
94  srnamt = 'CPOTRF'
95  infot = 1
96  CALL magmaf_cpotrf( '/', 0, a, 1, info )
97  CALL chkxer( 'CPOTRF', infot, nout, lerr, ok )
98  infot = 2
99  CALL magmaf_cpotrf( 'U', -1, a, 1, info )
100  CALL chkxer( 'CPOTRF', infot, nout, lerr, ok )
101  infot = 4
102  CALL magmaf_cpotrf( 'U', 2, a, 1, info )
103  CALL chkxer( 'CPOTRF', infot, nout, lerr, ok )
104 *
105 * CPOTF2
106 *
107  srnamt = 'CPOTF2'
108  infot = 1
109  CALL cpotf2( '/', 0, a, 1, info )
110  CALL chkxer( 'CPOTF2', infot, nout, lerr, ok )
111  infot = 2
112  CALL cpotf2( 'U', -1, a, 1, info )
113  CALL chkxer( 'CPOTF2', infot, nout, lerr, ok )
114  infot = 4
115  CALL cpotf2( 'U', 2, a, 1, info )
116  CALL chkxer( 'CPOTF2', infot, nout, lerr, ok )
117 *
118 * CPOTRI
119 *
120  srnamt = 'CPOTRI'
121  infot = 1
122  CALL cpotri( '/', 0, a, 1, info )
123  CALL chkxer( 'CPOTRI', infot, nout, lerr, ok )
124  infot = 2
125  CALL cpotri( 'U', -1, a, 1, info )
126  CALL chkxer( 'CPOTRI', infot, nout, lerr, ok )
127  infot = 4
128  CALL cpotri( 'U', 2, a, 1, info )
129  CALL chkxer( 'CPOTRI', infot, nout, lerr, ok )
130 *
131 * CPOTRS
132 *
133  srnamt = 'CPOTRS'
134  infot = 1
135  CALL cpotrs( '/', 0, 0, a, 1, b, 1, info )
136  CALL chkxer( 'CPOTRS', infot, nout, lerr, ok )
137  infot = 2
138  CALL cpotrs( 'U', -1, 0, a, 1, b, 1, info )
139  CALL chkxer( 'CPOTRS', infot, nout, lerr, ok )
140  infot = 3
141  CALL cpotrs( 'U', 0, -1, a, 1, b, 1, info )
142  CALL chkxer( 'CPOTRS', infot, nout, lerr, ok )
143  infot = 5
144  CALL cpotrs( 'U', 2, 1, a, 1, b, 2, info )
145  CALL chkxer( 'CPOTRS', infot, nout, lerr, ok )
146  infot = 7
147  CALL cpotrs( 'U', 2, 1, a, 2, b, 1, info )
148  CALL chkxer( 'CPOTRS', infot, nout, lerr, ok )
149 *
150 * CPORFS
151 *
152  srnamt = 'CPORFS'
153  infot = 1
154  CALL cporfs( '/', 0, 0, a, 1, af, 1, b, 1, x, 1, r1, r2, w, r,
155  $ info )
156  CALL chkxer( 'CPORFS', infot, nout, lerr, ok )
157  infot = 2
158  CALL cporfs( 'U', -1, 0, a, 1, af, 1, b, 1, x, 1, r1, r2, w, r,
159  $ info )
160  CALL chkxer( 'CPORFS', infot, nout, lerr, ok )
161  infot = 3
162  CALL cporfs( 'U', 0, -1, a, 1, af, 1, b, 1, x, 1, r1, r2, w, r,
163  $ info )
164  CALL chkxer( 'CPORFS', infot, nout, lerr, ok )
165  infot = 5
166  CALL cporfs( 'U', 2, 1, a, 1, af, 2, b, 2, x, 2, r1, r2, w, r,
167  $ info )
168  CALL chkxer( 'CPORFS', infot, nout, lerr, ok )
169  infot = 7
170  CALL cporfs( 'U', 2, 1, a, 2, af, 1, b, 2, x, 2, r1, r2, w, r,
171  $ info )
172  CALL chkxer( 'CPORFS', infot, nout, lerr, ok )
173  infot = 9
174  CALL cporfs( 'U', 2, 1, a, 2, af, 2, b, 1, x, 2, r1, r2, w, r,
175  $ info )
176  CALL chkxer( 'CPORFS', infot, nout, lerr, ok )
177  infot = 11
178  CALL cporfs( 'U', 2, 1, a, 2, af, 2, b, 2, x, 1, r1, r2, w, r,
179  $ info )
180  CALL chkxer( 'CPORFS', infot, nout, lerr, ok )
181 *
182 * CPOCON
183 *
184  srnamt = 'CPOCON'
185  infot = 1
186  CALL cpocon( '/', 0, a, 1, anrm, rcond, w, r, info )
187  CALL chkxer( 'CPOCON', infot, nout, lerr, ok )
188  infot = 2
189  CALL cpocon( 'U', -1, a, 1, anrm, rcond, w, r, info )
190  CALL chkxer( 'CPOCON', infot, nout, lerr, ok )
191  infot = 4
192  CALL cpocon( 'U', 2, a, 1, anrm, rcond, w, r, info )
193  CALL chkxer( 'CPOCON', infot, nout, lerr, ok )
194  infot = 5
195  CALL cpocon( 'U', 1, a, 1, -anrm, rcond, w, r, info )
196  CALL chkxer( 'CPOCON', infot, nout, lerr, ok )
197 *
198 * CPOEQU
199 *
200  srnamt = 'CPOEQU'
201  infot = 1
202  CALL cpoequ( -1, a, 1, r1, rcond, anrm, info )
203  CALL chkxer( 'CPOEQU', infot, nout, lerr, ok )
204  infot = 3
205  CALL cpoequ( 2, a, 1, r1, rcond, anrm, info )
206  CALL chkxer( 'CPOEQU', infot, nout, lerr, ok )
207 *
208 * Test error exits of the routines that use the Cholesky
209 * decomposition of a Hermitian positive definite packed matrix.
210 *
211  ELSE IF( lsamen( 2, c2, 'PP' ) ) THEN
212 *
213 * CPPTRF
214 *
215  srnamt = 'CPPTRF'
216  infot = 1
217  CALL cpptrf( '/', 0, a, info )
218  CALL chkxer( 'CPPTRF', infot, nout, lerr, ok )
219  infot = 2
220  CALL cpptrf( 'U', -1, a, info )
221  CALL chkxer( 'CPPTRF', infot, nout, lerr, ok )
222 *
223 * CPPTRI
224 *
225  srnamt = 'CPPTRI'
226  infot = 1
227  CALL cpptri( '/', 0, a, info )
228  CALL chkxer( 'CPPTRI', infot, nout, lerr, ok )
229  infot = 2
230  CALL cpptri( 'U', -1, a, info )
231  CALL chkxer( 'CPPTRI', infot, nout, lerr, ok )
232 *
233 * CPPTRS
234 *
235  srnamt = 'CPPTRS'
236  infot = 1
237  CALL cpptrs( '/', 0, 0, a, b, 1, info )
238  CALL chkxer( 'CPPTRS', infot, nout, lerr, ok )
239  infot = 2
240  CALL cpptrs( 'U', -1, 0, a, b, 1, info )
241  CALL chkxer( 'CPPTRS', infot, nout, lerr, ok )
242  infot = 3
243  CALL cpptrs( 'U', 0, -1, a, b, 1, info )
244  CALL chkxer( 'CPPTRS', infot, nout, lerr, ok )
245  infot = 6
246  CALL cpptrs( 'U', 2, 1, a, b, 1, info )
247  CALL chkxer( 'CPPTRS', infot, nout, lerr, ok )
248 *
249 * CPPRFS
250 *
251  srnamt = 'CPPRFS'
252  infot = 1
253  CALL cpprfs( '/', 0, 0, a, af, b, 1, x, 1, r1, r2, w, r, info )
254  CALL chkxer( 'CPPRFS', infot, nout, lerr, ok )
255  infot = 2
256  CALL cpprfs( 'U', -1, 0, a, af, b, 1, x, 1, r1, r2, w, r,
257  $ info )
258  CALL chkxer( 'CPPRFS', infot, nout, lerr, ok )
259  infot = 3
260  CALL cpprfs( 'U', 0, -1, a, af, b, 1, x, 1, r1, r2, w, r,
261  $ info )
262  CALL chkxer( 'CPPRFS', infot, nout, lerr, ok )
263  infot = 7
264  CALL cpprfs( 'U', 2, 1, a, af, b, 1, x, 2, r1, r2, w, r, info )
265  CALL chkxer( 'CPPRFS', infot, nout, lerr, ok )
266  infot = 9
267  CALL cpprfs( 'U', 2, 1, a, af, b, 2, x, 1, r1, r2, w, r, info )
268  CALL chkxer( 'CPPRFS', infot, nout, lerr, ok )
269 *
270 * CPPCON
271 *
272  srnamt = 'CPPCON'
273  infot = 1
274  CALL cppcon( '/', 0, a, anrm, rcond, w, r, info )
275  CALL chkxer( 'CPPCON', infot, nout, lerr, ok )
276  infot = 2
277  CALL cppcon( 'U', -1, a, anrm, rcond, w, r, info )
278  CALL chkxer( 'CPPCON', infot, nout, lerr, ok )
279  infot = 4
280  CALL cppcon( 'U', 1, a, -anrm, rcond, w, r, info )
281  CALL chkxer( 'CPPCON', infot, nout, lerr, ok )
282 *
283 * CPPEQU
284 *
285  srnamt = 'CPPEQU'
286  infot = 1
287  CALL cppequ( '/', 0, a, r1, rcond, anrm, info )
288  CALL chkxer( 'CPPEQU', infot, nout, lerr, ok )
289  infot = 2
290  CALL cppequ( 'U', -1, a, r1, rcond, anrm, info )
291  CALL chkxer( 'CPPEQU', infot, nout, lerr, ok )
292 *
293 * Test error exits of the routines that use the Cholesky
294 * decomposition of a Hermitian positive definite band matrix.
295 *
296  ELSE IF( lsamen( 2, c2, 'PB' ) ) THEN
297 *
298 * CPBTRF
299 *
300  srnamt = 'CPBTRF'
301  infot = 1
302  CALL cpbtrf( '/', 0, 0, a, 1, info )
303  CALL chkxer( 'CPBTRF', infot, nout, lerr, ok )
304  infot = 2
305  CALL cpbtrf( 'U', -1, 0, a, 1, info )
306  CALL chkxer( 'CPBTRF', infot, nout, lerr, ok )
307  infot = 3
308  CALL cpbtrf( 'U', 1, -1, a, 1, info )
309  CALL chkxer( 'CPBTRF', infot, nout, lerr, ok )
310  infot = 5
311  CALL cpbtrf( 'U', 2, 1, a, 1, info )
312  CALL chkxer( 'CPBTRF', infot, nout, lerr, ok )
313 *
314 * CPBTF2
315 *
316  srnamt = 'CPBTF2'
317  infot = 1
318  CALL cpbtf2( '/', 0, 0, a, 1, info )
319  CALL chkxer( 'CPBTF2', infot, nout, lerr, ok )
320  infot = 2
321  CALL cpbtf2( 'U', -1, 0, a, 1, info )
322  CALL chkxer( 'CPBTF2', infot, nout, lerr, ok )
323  infot = 3
324  CALL cpbtf2( 'U', 1, -1, a, 1, info )
325  CALL chkxer( 'CPBTF2', infot, nout, lerr, ok )
326  infot = 5
327  CALL cpbtf2( 'U', 2, 1, a, 1, info )
328  CALL chkxer( 'CPBTF2', infot, nout, lerr, ok )
329 *
330 * CPBTRS
331 *
332  srnamt = 'CPBTRS'
333  infot = 1
334  CALL cpbtrs( '/', 0, 0, 0, a, 1, b, 1, info )
335  CALL chkxer( 'CPBTRS', infot, nout, lerr, ok )
336  infot = 2
337  CALL cpbtrs( 'U', -1, 0, 0, a, 1, b, 1, info )
338  CALL chkxer( 'CPBTRS', infot, nout, lerr, ok )
339  infot = 3
340  CALL cpbtrs( 'U', 1, -1, 0, a, 1, b, 1, info )
341  CALL chkxer( 'CPBTRS', infot, nout, lerr, ok )
342  infot = 4
343  CALL cpbtrs( 'U', 0, 0, -1, a, 1, b, 1, info )
344  CALL chkxer( 'CPBTRS', infot, nout, lerr, ok )
345  infot = 6
346  CALL cpbtrs( 'U', 2, 1, 1, a, 1, b, 1, info )
347  CALL chkxer( 'CPBTRS', infot, nout, lerr, ok )
348  infot = 8
349  CALL cpbtrs( 'U', 2, 0, 1, a, 1, b, 1, info )
350  CALL chkxer( 'CPBTRS', infot, nout, lerr, ok )
351 *
352 * CPBRFS
353 *
354  srnamt = 'CPBRFS'
355  infot = 1
356  CALL cpbrfs( '/', 0, 0, 0, a, 1, af, 1, b, 1, x, 1, r1, r2, w,
357  $ r, info )
358  CALL chkxer( 'CPBRFS', infot, nout, lerr, ok )
359  infot = 2
360  CALL cpbrfs( 'U', -1, 0, 0, a, 1, af, 1, b, 1, x, 1, r1, r2, w,
361  $ r, info )
362  CALL chkxer( 'CPBRFS', infot, nout, lerr, ok )
363  infot = 3
364  CALL cpbrfs( 'U', 1, -1, 0, a, 1, af, 1, b, 1, x, 1, r1, r2, w,
365  $ r, info )
366  CALL chkxer( 'CPBRFS', infot, nout, lerr, ok )
367  infot = 4
368  CALL cpbrfs( 'U', 0, 0, -1, a, 1, af, 1, b, 1, x, 1, r1, r2, w,
369  $ r, info )
370  CALL chkxer( 'CPBRFS', infot, nout, lerr, ok )
371  infot = 6
372  CALL cpbrfs( 'U', 2, 1, 1, a, 1, af, 2, b, 2, x, 2, r1, r2, w,
373  $ r, info )
374  CALL chkxer( 'CPBRFS', infot, nout, lerr, ok )
375  infot = 8
376  CALL cpbrfs( 'U', 2, 1, 1, a, 2, af, 1, b, 2, x, 2, r1, r2, w,
377  $ r, info )
378  CALL chkxer( 'CPBRFS', infot, nout, lerr, ok )
379  infot = 10
380  CALL cpbrfs( 'U', 2, 0, 1, a, 1, af, 1, b, 1, x, 2, r1, r2, w,
381  $ r, info )
382  CALL chkxer( 'CPBRFS', infot, nout, lerr, ok )
383  infot = 12
384  CALL cpbrfs( 'U', 2, 0, 1, a, 1, af, 1, b, 2, x, 1, r1, r2, w,
385  $ r, info )
386  CALL chkxer( 'CPBRFS', infot, nout, lerr, ok )
387 *
388 * CPBCON
389 *
390  srnamt = 'CPBCON'
391  infot = 1
392  CALL cpbcon( '/', 0, 0, a, 1, anrm, rcond, w, r, info )
393  CALL chkxer( 'CPBCON', infot, nout, lerr, ok )
394  infot = 2
395  CALL cpbcon( 'U', -1, 0, a, 1, anrm, rcond, w, r, info )
396  CALL chkxer( 'CPBCON', infot, nout, lerr, ok )
397  infot = 3
398  CALL cpbcon( 'U', 1, -1, a, 1, anrm, rcond, w, r, info )
399  CALL chkxer( 'CPBCON', infot, nout, lerr, ok )
400  infot = 5
401  CALL cpbcon( 'U', 2, 1, a, 1, anrm, rcond, w, r, info )
402  CALL chkxer( 'CPBCON', infot, nout, lerr, ok )
403  infot = 6
404  CALL cpbcon( 'U', 1, 0, a, 1, -anrm, rcond, w, r, info )
405  CALL chkxer( 'CPBCON', infot, nout, lerr, ok )
406 *
407 * CPBEQU
408 *
409  srnamt = 'CPBEQU'
410  infot = 1
411  CALL cpbequ( '/', 0, 0, a, 1, r1, rcond, anrm, info )
412  CALL chkxer( 'CPBEQU', infot, nout, lerr, ok )
413  infot = 2
414  CALL cpbequ( 'U', -1, 0, a, 1, r1, rcond, anrm, info )
415  CALL chkxer( 'CPBEQU', infot, nout, lerr, ok )
416  infot = 3
417  CALL cpbequ( 'U', 1, -1, a, 1, r1, rcond, anrm, info )
418  CALL chkxer( 'CPBEQU', infot, nout, lerr, ok )
419  infot = 5
420  CALL cpbequ( 'U', 2, 1, a, 1, r1, rcond, anrm, info )
421  CALL chkxer( 'CPBEQU', infot, nout, lerr, ok )
422  END IF
423 *
424 * Print a summary line.
425 *
426  CALL alaesm( path, ok, nout )
427 *
428  return
429 *
430 * End of CERRPO
431 *
432  END