LAPACK  3.4.2
LAPACK: Linear Algebra PACKage
 All Files Functions Groups
zerrpo.f
Go to the documentation of this file.
1 *> \brief \b ZERRPO
2 *
3 * =========== DOCUMENTATION ===========
4 *
5 * Online html documentation available at
6 * http://www.netlib.org/lapack/explore-html/
7 *
8 * Definition:
9 * ===========
10 *
11 * SUBROUTINE ZERRPO( PATH, NUNIT )
12 *
13 * .. Scalar Arguments ..
14 * CHARACTER*3 PATH
15 * INTEGER NUNIT
16 * ..
17 *
18 *
19 *> \par Purpose:
20 * =============
21 *>
22 *> \verbatim
23 *>
24 *> ZERRPO tests the error exits for the COMPLEX*16 routines
25 *> for Hermitian positive definite matrices.
26 *> \endverbatim
27 *
28 * Arguments:
29 * ==========
30 *
31 *> \param[in] PATH
32 *> \verbatim
33 *> PATH is CHARACTER*3
34 *> The LAPACK path name for the routines to be tested.
35 *> \endverbatim
36 *>
37 *> \param[in] NUNIT
38 *> \verbatim
39 *> NUNIT is INTEGER
40 *> The unit number for output.
41 *> \endverbatim
42 *
43 * Authors:
44 * ========
45 *
46 *> \author Univ. of Tennessee
47 *> \author Univ. of California Berkeley
48 *> \author Univ. of Colorado Denver
49 *> \author NAG Ltd.
50 *
51 *> \date November 2011
52 *
53 *> \ingroup complex16_lin
54 *
55 * =====================================================================
56  SUBROUTINE zerrpo( PATH, NUNIT )
57 *
58 * -- LAPACK test routine (version 3.4.0) --
59 * -- LAPACK is a software package provided by Univ. of Tennessee, --
60 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
61 * November 2011
62 *
63 * .. Scalar Arguments ..
64  CHARACTER*3 path
65  INTEGER nunit
66 * ..
67 *
68 * =====================================================================
69 *
70 * .. Parameters ..
71  INTEGER nmax
72  parameter( nmax = 4 )
73 * ..
74 * .. Local Scalars ..
75  CHARACTER*2 c2
76  INTEGER i, info, j
77  DOUBLE PRECISION anrm, rcond
78 * ..
79 * .. Local Arrays ..
80  DOUBLE PRECISION r( nmax ), r1( nmax ), r2( nmax )
81  COMPLEX*16 a( nmax, nmax ), af( nmax, nmax ), b( nmax ),
82  $ w( 2*nmax ), x( nmax )
83 * ..
84 * .. External Functions ..
85  LOGICAL lsamen
86  EXTERNAL lsamen
87 * ..
88 * .. External Subroutines ..
89  EXTERNAL alaesm, chkxer, zpbcon, zpbequ, zpbrfs, zpbtf2,
90  $ zpbtrf, zpbtrs, zpocon, zpoequ, zporfs, zpotf2,
91  $ zpotrf, zpotri, zpotrs, zppcon, zppequ, zpprfs,
92  $ zpptrf, zpptri, zpptrs
93 * ..
94 * .. Scalars in Common ..
95  LOGICAL lerr, ok
96  CHARACTER*32 srnamt
97  INTEGER infot, nout
98 * ..
99 * .. Common blocks ..
100  common / infoc / infot, nout, ok, lerr
101  common / srnamc / srnamt
102 * ..
103 * .. Intrinsic Functions ..
104  INTRINSIC dble, dcmplx
105 * ..
106 * .. Executable Statements ..
107 *
108  nout = nunit
109  WRITE( nout, fmt = * )
110  c2 = path( 2: 3 )
111 *
112 * Set the variables to innocuous values.
113 *
114  DO 20 j = 1, nmax
115  DO 10 i = 1, nmax
116  a( i, j ) = dcmplx( 1.d0 / dble( i+j ),
117  $ -1.d0 / dble( i+j ) )
118  af( i, j ) = dcmplx( 1.d0 / dble( i+j ),
119  $ -1.d0 / dble( i+j ) )
120  10 continue
121  b( j ) = 0.d0
122  r1( j ) = 0.d0
123  r2( j ) = 0.d0
124  w( j ) = 0.d0
125  x( j ) = 0.d0
126  20 continue
127  anrm = 1.d0
128  ok = .true.
129 *
130 * Test error exits of the routines that use the Cholesky
131 * decomposition of a Hermitian positive definite matrix.
132 *
133  IF( lsamen( 2, c2, 'PO' ) ) THEN
134 *
135 * ZPOTRF
136 *
137  srnamt = 'ZPOTRF'
138  infot = 1
139  CALL zpotrf( '/', 0, a, 1, info )
140  CALL chkxer( 'ZPOTRF', infot, nout, lerr, ok )
141  infot = 2
142  CALL zpotrf( 'U', -1, a, 1, info )
143  CALL chkxer( 'ZPOTRF', infot, nout, lerr, ok )
144  infot = 4
145  CALL zpotrf( 'U', 2, a, 1, info )
146  CALL chkxer( 'ZPOTRF', infot, nout, lerr, ok )
147 *
148 * ZPOTF2
149 *
150  srnamt = 'ZPOTF2'
151  infot = 1
152  CALL zpotf2( '/', 0, a, 1, info )
153  CALL chkxer( 'ZPOTF2', infot, nout, lerr, ok )
154  infot = 2
155  CALL zpotf2( 'U', -1, a, 1, info )
156  CALL chkxer( 'ZPOTF2', infot, nout, lerr, ok )
157  infot = 4
158  CALL zpotf2( 'U', 2, a, 1, info )
159  CALL chkxer( 'ZPOTF2', infot, nout, lerr, ok )
160 *
161 * ZPOTRI
162 *
163  srnamt = 'ZPOTRI'
164  infot = 1
165  CALL zpotri( '/', 0, a, 1, info )
166  CALL chkxer( 'ZPOTRI', infot, nout, lerr, ok )
167  infot = 2
168  CALL zpotri( 'U', -1, a, 1, info )
169  CALL chkxer( 'ZPOTRI', infot, nout, lerr, ok )
170  infot = 4
171  CALL zpotri( 'U', 2, a, 1, info )
172  CALL chkxer( 'ZPOTRI', infot, nout, lerr, ok )
173 *
174 * ZPOTRS
175 *
176  srnamt = 'ZPOTRS'
177  infot = 1
178  CALL zpotrs( '/', 0, 0, a, 1, b, 1, info )
179  CALL chkxer( 'ZPOTRS', infot, nout, lerr, ok )
180  infot = 2
181  CALL zpotrs( 'U', -1, 0, a, 1, b, 1, info )
182  CALL chkxer( 'ZPOTRS', infot, nout, lerr, ok )
183  infot = 3
184  CALL zpotrs( 'U', 0, -1, a, 1, b, 1, info )
185  CALL chkxer( 'ZPOTRS', infot, nout, lerr, ok )
186  infot = 5
187  CALL zpotrs( 'U', 2, 1, a, 1, b, 2, info )
188  CALL chkxer( 'ZPOTRS', infot, nout, lerr, ok )
189  infot = 7
190  CALL zpotrs( 'U', 2, 1, a, 2, b, 1, info )
191  CALL chkxer( 'ZPOTRS', infot, nout, lerr, ok )
192 *
193 * ZPORFS
194 *
195  srnamt = 'ZPORFS'
196  infot = 1
197  CALL zporfs( '/', 0, 0, a, 1, af, 1, b, 1, x, 1, r1, r2, w, r,
198  $ info )
199  CALL chkxer( 'ZPORFS', infot, nout, lerr, ok )
200  infot = 2
201  CALL zporfs( 'U', -1, 0, a, 1, af, 1, b, 1, x, 1, r1, r2, w, r,
202  $ info )
203  CALL chkxer( 'ZPORFS', infot, nout, lerr, ok )
204  infot = 3
205  CALL zporfs( 'U', 0, -1, a, 1, af, 1, b, 1, x, 1, r1, r2, w, r,
206  $ info )
207  CALL chkxer( 'ZPORFS', infot, nout, lerr, ok )
208  infot = 5
209  CALL zporfs( 'U', 2, 1, a, 1, af, 2, b, 2, x, 2, r1, r2, w, r,
210  $ info )
211  CALL chkxer( 'ZPORFS', infot, nout, lerr, ok )
212  infot = 7
213  CALL zporfs( 'U', 2, 1, a, 2, af, 1, b, 2, x, 2, r1, r2, w, r,
214  $ info )
215  CALL chkxer( 'ZPORFS', infot, nout, lerr, ok )
216  infot = 9
217  CALL zporfs( 'U', 2, 1, a, 2, af, 2, b, 1, x, 2, r1, r2, w, r,
218  $ info )
219  CALL chkxer( 'ZPORFS', infot, nout, lerr, ok )
220  infot = 11
221  CALL zporfs( 'U', 2, 1, a, 2, af, 2, b, 2, x, 1, r1, r2, w, r,
222  $ info )
223  CALL chkxer( 'ZPORFS', infot, nout, lerr, ok )
224 *
225 * ZPOCON
226 *
227  srnamt = 'ZPOCON'
228  infot = 1
229  CALL zpocon( '/', 0, a, 1, anrm, rcond, w, r, info )
230  CALL chkxer( 'ZPOCON', infot, nout, lerr, ok )
231  infot = 2
232  CALL zpocon( 'U', -1, a, 1, anrm, rcond, w, r, info )
233  CALL chkxer( 'ZPOCON', infot, nout, lerr, ok )
234  infot = 4
235  CALL zpocon( 'U', 2, a, 1, anrm, rcond, w, r, info )
236  CALL chkxer( 'ZPOCON', infot, nout, lerr, ok )
237  infot = 5
238  CALL zpocon( 'U', 1, a, 1, -anrm, rcond, w, r, info )
239  CALL chkxer( 'ZPOCON', infot, nout, lerr, ok )
240 *
241 * ZPOEQU
242 *
243  srnamt = 'ZPOEQU'
244  infot = 1
245  CALL zpoequ( -1, a, 1, r1, rcond, anrm, info )
246  CALL chkxer( 'ZPOEQU', infot, nout, lerr, ok )
247  infot = 3
248  CALL zpoequ( 2, a, 1, r1, rcond, anrm, info )
249  CALL chkxer( 'ZPOEQU', infot, nout, lerr, ok )
250 *
251 * Test error exits of the routines that use the Cholesky
252 * decomposition of a Hermitian positive definite packed matrix.
253 *
254  ELSE IF( lsamen( 2, c2, 'PP' ) ) THEN
255 *
256 * ZPPTRF
257 *
258  srnamt = 'ZPPTRF'
259  infot = 1
260  CALL zpptrf( '/', 0, a, info )
261  CALL chkxer( 'ZPPTRF', infot, nout, lerr, ok )
262  infot = 2
263  CALL zpptrf( 'U', -1, a, info )
264  CALL chkxer( 'ZPPTRF', infot, nout, lerr, ok )
265 *
266 * ZPPTRI
267 *
268  srnamt = 'ZPPTRI'
269  infot = 1
270  CALL zpptri( '/', 0, a, info )
271  CALL chkxer( 'ZPPTRI', infot, nout, lerr, ok )
272  infot = 2
273  CALL zpptri( 'U', -1, a, info )
274  CALL chkxer( 'ZPPTRI', infot, nout, lerr, ok )
275 *
276 * ZPPTRS
277 *
278  srnamt = 'ZPPTRS'
279  infot = 1
280  CALL zpptrs( '/', 0, 0, a, b, 1, info )
281  CALL chkxer( 'ZPPTRS', infot, nout, lerr, ok )
282  infot = 2
283  CALL zpptrs( 'U', -1, 0, a, b, 1, info )
284  CALL chkxer( 'ZPPTRS', infot, nout, lerr, ok )
285  infot = 3
286  CALL zpptrs( 'U', 0, -1, a, b, 1, info )
287  CALL chkxer( 'ZPPTRS', infot, nout, lerr, ok )
288  infot = 6
289  CALL zpptrs( 'U', 2, 1, a, b, 1, info )
290  CALL chkxer( 'ZPPTRS', infot, nout, lerr, ok )
291 *
292 * ZPPRFS
293 *
294  srnamt = 'ZPPRFS'
295  infot = 1
296  CALL zpprfs( '/', 0, 0, a, af, b, 1, x, 1, r1, r2, w, r, info )
297  CALL chkxer( 'ZPPRFS', infot, nout, lerr, ok )
298  infot = 2
299  CALL zpprfs( 'U', -1, 0, a, af, b, 1, x, 1, r1, r2, w, r,
300  $ info )
301  CALL chkxer( 'ZPPRFS', infot, nout, lerr, ok )
302  infot = 3
303  CALL zpprfs( 'U', 0, -1, a, af, b, 1, x, 1, r1, r2, w, r,
304  $ info )
305  CALL chkxer( 'ZPPRFS', infot, nout, lerr, ok )
306  infot = 7
307  CALL zpprfs( 'U', 2, 1, a, af, b, 1, x, 2, r1, r2, w, r, info )
308  CALL chkxer( 'ZPPRFS', infot, nout, lerr, ok )
309  infot = 9
310  CALL zpprfs( 'U', 2, 1, a, af, b, 2, x, 1, r1, r2, w, r, info )
311  CALL chkxer( 'ZPPRFS', infot, nout, lerr, ok )
312 *
313 * ZPPCON
314 *
315  srnamt = 'ZPPCON'
316  infot = 1
317  CALL zppcon( '/', 0, a, anrm, rcond, w, r, info )
318  CALL chkxer( 'ZPPCON', infot, nout, lerr, ok )
319  infot = 2
320  CALL zppcon( 'U', -1, a, anrm, rcond, w, r, info )
321  CALL chkxer( 'ZPPCON', infot, nout, lerr, ok )
322  infot = 4
323  CALL zppcon( 'U', 1, a, -anrm, rcond, w, r, info )
324  CALL chkxer( 'ZPPCON', infot, nout, lerr, ok )
325 *
326 * ZPPEQU
327 *
328  srnamt = 'ZPPEQU'
329  infot = 1
330  CALL zppequ( '/', 0, a, r1, rcond, anrm, info )
331  CALL chkxer( 'ZPPEQU', infot, nout, lerr, ok )
332  infot = 2
333  CALL zppequ( 'U', -1, a, r1, rcond, anrm, info )
334  CALL chkxer( 'ZPPEQU', infot, nout, lerr, ok )
335 *
336 * Test error exits of the routines that use the Cholesky
337 * decomposition of a Hermitian positive definite band matrix.
338 *
339  ELSE IF( lsamen( 2, c2, 'PB' ) ) THEN
340 *
341 * ZPBTRF
342 *
343  srnamt = 'ZPBTRF'
344  infot = 1
345  CALL zpbtrf( '/', 0, 0, a, 1, info )
346  CALL chkxer( 'ZPBTRF', infot, nout, lerr, ok )
347  infot = 2
348  CALL zpbtrf( 'U', -1, 0, a, 1, info )
349  CALL chkxer( 'ZPBTRF', infot, nout, lerr, ok )
350  infot = 3
351  CALL zpbtrf( 'U', 1, -1, a, 1, info )
352  CALL chkxer( 'ZPBTRF', infot, nout, lerr, ok )
353  infot = 5
354  CALL zpbtrf( 'U', 2, 1, a, 1, info )
355  CALL chkxer( 'ZPBTRF', infot, nout, lerr, ok )
356 *
357 * ZPBTF2
358 *
359  srnamt = 'ZPBTF2'
360  infot = 1
361  CALL zpbtf2( '/', 0, 0, a, 1, info )
362  CALL chkxer( 'ZPBTF2', infot, nout, lerr, ok )
363  infot = 2
364  CALL zpbtf2( 'U', -1, 0, a, 1, info )
365  CALL chkxer( 'ZPBTF2', infot, nout, lerr, ok )
366  infot = 3
367  CALL zpbtf2( 'U', 1, -1, a, 1, info )
368  CALL chkxer( 'ZPBTF2', infot, nout, lerr, ok )
369  infot = 5
370  CALL zpbtf2( 'U', 2, 1, a, 1, info )
371  CALL chkxer( 'ZPBTF2', infot, nout, lerr, ok )
372 *
373 * ZPBTRS
374 *
375  srnamt = 'ZPBTRS'
376  infot = 1
377  CALL zpbtrs( '/', 0, 0, 0, a, 1, b, 1, info )
378  CALL chkxer( 'ZPBTRS', infot, nout, lerr, ok )
379  infot = 2
380  CALL zpbtrs( 'U', -1, 0, 0, a, 1, b, 1, info )
381  CALL chkxer( 'ZPBTRS', infot, nout, lerr, ok )
382  infot = 3
383  CALL zpbtrs( 'U', 1, -1, 0, a, 1, b, 1, info )
384  CALL chkxer( 'ZPBTRS', infot, nout, lerr, ok )
385  infot = 4
386  CALL zpbtrs( 'U', 0, 0, -1, a, 1, b, 1, info )
387  CALL chkxer( 'ZPBTRS', infot, nout, lerr, ok )
388  infot = 6
389  CALL zpbtrs( 'U', 2, 1, 1, a, 1, b, 1, info )
390  CALL chkxer( 'ZPBTRS', infot, nout, lerr, ok )
391  infot = 8
392  CALL zpbtrs( 'U', 2, 0, 1, a, 1, b, 1, info )
393  CALL chkxer( 'ZPBTRS', infot, nout, lerr, ok )
394 *
395 * ZPBRFS
396 *
397  srnamt = 'ZPBRFS'
398  infot = 1
399  CALL zpbrfs( '/', 0, 0, 0, a, 1, af, 1, b, 1, x, 1, r1, r2, w,
400  $ r, info )
401  CALL chkxer( 'ZPBRFS', infot, nout, lerr, ok )
402  infot = 2
403  CALL zpbrfs( 'U', -1, 0, 0, a, 1, af, 1, b, 1, x, 1, r1, r2, w,
404  $ r, info )
405  CALL chkxer( 'ZPBRFS', infot, nout, lerr, ok )
406  infot = 3
407  CALL zpbrfs( 'U', 1, -1, 0, a, 1, af, 1, b, 1, x, 1, r1, r2, w,
408  $ r, info )
409  CALL chkxer( 'ZPBRFS', infot, nout, lerr, ok )
410  infot = 4
411  CALL zpbrfs( 'U', 0, 0, -1, a, 1, af, 1, b, 1, x, 1, r1, r2, w,
412  $ r, info )
413  CALL chkxer( 'ZPBRFS', infot, nout, lerr, ok )
414  infot = 6
415  CALL zpbrfs( 'U', 2, 1, 1, a, 1, af, 2, b, 2, x, 2, r1, r2, w,
416  $ r, info )
417  CALL chkxer( 'ZPBRFS', infot, nout, lerr, ok )
418  infot = 8
419  CALL zpbrfs( 'U', 2, 1, 1, a, 2, af, 1, b, 2, x, 2, r1, r2, w,
420  $ r, info )
421  CALL chkxer( 'ZPBRFS', infot, nout, lerr, ok )
422  infot = 10
423  CALL zpbrfs( 'U', 2, 0, 1, a, 1, af, 1, b, 1, x, 2, r1, r2, w,
424  $ r, info )
425  CALL chkxer( 'ZPBRFS', infot, nout, lerr, ok )
426  infot = 12
427  CALL zpbrfs( 'U', 2, 0, 1, a, 1, af, 1, b, 2, x, 1, r1, r2, w,
428  $ r, info )
429  CALL chkxer( 'ZPBRFS', infot, nout, lerr, ok )
430 *
431 * ZPBCON
432 *
433  srnamt = 'ZPBCON'
434  infot = 1
435  CALL zpbcon( '/', 0, 0, a, 1, anrm, rcond, w, r, info )
436  CALL chkxer( 'ZPBCON', infot, nout, lerr, ok )
437  infot = 2
438  CALL zpbcon( 'U', -1, 0, a, 1, anrm, rcond, w, r, info )
439  CALL chkxer( 'ZPBCON', infot, nout, lerr, ok )
440  infot = 3
441  CALL zpbcon( 'U', 1, -1, a, 1, anrm, rcond, w, r, info )
442  CALL chkxer( 'ZPBCON', infot, nout, lerr, ok )
443  infot = 5
444  CALL zpbcon( 'U', 2, 1, a, 1, anrm, rcond, w, r, info )
445  CALL chkxer( 'ZPBCON', infot, nout, lerr, ok )
446  infot = 6
447  CALL zpbcon( 'U', 1, 0, a, 1, -anrm, rcond, w, r, info )
448  CALL chkxer( 'ZPBCON', infot, nout, lerr, ok )
449 *
450 * ZPBEQU
451 *
452  srnamt = 'ZPBEQU'
453  infot = 1
454  CALL zpbequ( '/', 0, 0, a, 1, r1, rcond, anrm, info )
455  CALL chkxer( 'ZPBEQU', infot, nout, lerr, ok )
456  infot = 2
457  CALL zpbequ( 'U', -1, 0, a, 1, r1, rcond, anrm, info )
458  CALL chkxer( 'ZPBEQU', infot, nout, lerr, ok )
459  infot = 3
460  CALL zpbequ( 'U', 1, -1, a, 1, r1, rcond, anrm, info )
461  CALL chkxer( 'ZPBEQU', infot, nout, lerr, ok )
462  infot = 5
463  CALL zpbequ( 'U', 2, 1, a, 1, r1, rcond, anrm, info )
464  CALL chkxer( 'ZPBEQU', infot, nout, lerr, ok )
465  END IF
466 *
467 * Print a summary line.
468 *
469  CALL alaesm( path, ok, nout )
470 *
471  return
472 *
473 * End of ZERRPO
474 *
475  END