1 SUBROUTINE ZERRQP( 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 * ZERRQP tests the error exits for ZGEQPF and CGEQP3.
16 *
17 * Arguments
18 * =========
19 *
20 * PATH (input) CHARACTER*3
21 * The LAPACK path name for the routines to be tested.
22 *
23 * NUNIT (input) INTEGER
24 * The unit number for output.
25 *
26 * =====================================================================
27 *
28 * .. Parameters ..
29 INTEGER NMAX
30 PARAMETER ( NMAX = 3 )
31 * ..
32 * .. Local Scalars ..
33 CHARACTER*2 C2
34 INTEGER INFO, LW
35 * ..
36 * .. Local Arrays ..
37 INTEGER IP( NMAX )
38 DOUBLE PRECISION RW( 2*NMAX )
39 COMPLEX*16 A( NMAX, NMAX ), TAU( NMAX ),
40 $ W( 2*NMAX+3*NMAX )
41 * ..
42 * .. External Functions ..
43 LOGICAL LSAMEN
44 EXTERNAL LSAMEN
45 * ..
46 * .. External Subroutines ..
47 EXTERNAL ALAESM, CHKXER, ZGEQP3, ZGEQPF
48 * ..
49 * .. Scalars in Common ..
50 LOGICAL LERR, OK
51 CHARACTER*32 SRNAMT
52 INTEGER INFOT, NOUT
53 * ..
54 * .. Common blocks ..
55 COMMON / INFOC / INFOT, NOUT, OK, LERR
56 COMMON / SRNAMC / SRNAMT
57 * ..
58 * .. Intrinsic Functions ..
59 INTRINSIC DCMPLX
60 * ..
61 * .. Executable Statements ..
62 *
63 NOUT = NUNIT
64 C2 = PATH( 2: 3 )
65 LW = NMAX + 1
66 A( 1, 1 ) = DCMPLX( 1.0D+0, -1.0D+0 )
67 A( 1, 2 ) = DCMPLX( 2.0D+0, -2.0D+0 )
68 A( 2, 2 ) = DCMPLX( 3.0D+0, -3.0D+0 )
69 A( 2, 1 ) = DCMPLX( 4.0D+0, -4.0D+0 )
70 OK = .TRUE.
71 WRITE( NOUT, FMT = * )
72 *
73 * Test error exits for QR factorization with pivoting
74 *
75 IF( LSAMEN( 2, C2, 'QP' ) ) THEN
76 *
77 * ZGEQPF
78 *
79 SRNAMT = 'ZGEQPF'
80 INFOT = 1
81 CALL ZGEQPF( -1, 0, A, 1, IP, TAU, W, RW, INFO )
82 CALL CHKXER( 'ZGEQPF', INFOT, NOUT, LERR, OK )
83 INFOT = 2
84 CALL ZGEQPF( 0, -1, A, 1, IP, TAU, W, RW, INFO )
85 CALL CHKXER( 'ZGEQPF', INFOT, NOUT, LERR, OK )
86 INFOT = 4
87 CALL ZGEQPF( 2, 0, A, 1, IP, TAU, W, RW, INFO )
88 CALL CHKXER( 'ZGEQPF', INFOT, NOUT, LERR, OK )
89 *
90 * ZGEQP3
91 *
92 SRNAMT = 'ZGEQP3'
93 INFOT = 1
94 CALL ZGEQP3( -1, 0, A, 1, IP, TAU, W, LW, RW, INFO )
95 CALL CHKXER( 'ZGEQP3', INFOT, NOUT, LERR, OK )
96 INFOT = 2
97 CALL ZGEQP3( 1, -1, A, 1, IP, TAU, W, LW, RW, INFO )
98 CALL CHKXER( 'ZGEQP3', INFOT, NOUT, LERR, OK )
99 INFOT = 4
100 CALL ZGEQP3( 2, 3, A, 1, IP, TAU, W, LW, RW, INFO )
101 CALL CHKXER( 'ZGEQP3', INFOT, NOUT, LERR, OK )
102 INFOT = 8
103 CALL ZGEQP3( 2, 2, A, 2, IP, TAU, W, LW-10, RW, INFO )
104 CALL CHKXER( 'ZGEQP3', INFOT, NOUT, LERR, OK )
105 END IF
106 *
107 * Print a summary line.
108 *
109 CALL ALAESM( PATH, OK, NOUT )
110 *
111 RETURN
112 *
113 * End of ZERRQP
114 *
115 END
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 * ZERRQP tests the error exits for ZGEQPF and CGEQP3.
16 *
17 * Arguments
18 * =========
19 *
20 * PATH (input) CHARACTER*3
21 * The LAPACK path name for the routines to be tested.
22 *
23 * NUNIT (input) INTEGER
24 * The unit number for output.
25 *
26 * =====================================================================
27 *
28 * .. Parameters ..
29 INTEGER NMAX
30 PARAMETER ( NMAX = 3 )
31 * ..
32 * .. Local Scalars ..
33 CHARACTER*2 C2
34 INTEGER INFO, LW
35 * ..
36 * .. Local Arrays ..
37 INTEGER IP( NMAX )
38 DOUBLE PRECISION RW( 2*NMAX )
39 COMPLEX*16 A( NMAX, NMAX ), TAU( NMAX ),
40 $ W( 2*NMAX+3*NMAX )
41 * ..
42 * .. External Functions ..
43 LOGICAL LSAMEN
44 EXTERNAL LSAMEN
45 * ..
46 * .. External Subroutines ..
47 EXTERNAL ALAESM, CHKXER, ZGEQP3, ZGEQPF
48 * ..
49 * .. Scalars in Common ..
50 LOGICAL LERR, OK
51 CHARACTER*32 SRNAMT
52 INTEGER INFOT, NOUT
53 * ..
54 * .. Common blocks ..
55 COMMON / INFOC / INFOT, NOUT, OK, LERR
56 COMMON / SRNAMC / SRNAMT
57 * ..
58 * .. Intrinsic Functions ..
59 INTRINSIC DCMPLX
60 * ..
61 * .. Executable Statements ..
62 *
63 NOUT = NUNIT
64 C2 = PATH( 2: 3 )
65 LW = NMAX + 1
66 A( 1, 1 ) = DCMPLX( 1.0D+0, -1.0D+0 )
67 A( 1, 2 ) = DCMPLX( 2.0D+0, -2.0D+0 )
68 A( 2, 2 ) = DCMPLX( 3.0D+0, -3.0D+0 )
69 A( 2, 1 ) = DCMPLX( 4.0D+0, -4.0D+0 )
70 OK = .TRUE.
71 WRITE( NOUT, FMT = * )
72 *
73 * Test error exits for QR factorization with pivoting
74 *
75 IF( LSAMEN( 2, C2, 'QP' ) ) THEN
76 *
77 * ZGEQPF
78 *
79 SRNAMT = 'ZGEQPF'
80 INFOT = 1
81 CALL ZGEQPF( -1, 0, A, 1, IP, TAU, W, RW, INFO )
82 CALL CHKXER( 'ZGEQPF', INFOT, NOUT, LERR, OK )
83 INFOT = 2
84 CALL ZGEQPF( 0, -1, A, 1, IP, TAU, W, RW, INFO )
85 CALL CHKXER( 'ZGEQPF', INFOT, NOUT, LERR, OK )
86 INFOT = 4
87 CALL ZGEQPF( 2, 0, A, 1, IP, TAU, W, RW, INFO )
88 CALL CHKXER( 'ZGEQPF', INFOT, NOUT, LERR, OK )
89 *
90 * ZGEQP3
91 *
92 SRNAMT = 'ZGEQP3'
93 INFOT = 1
94 CALL ZGEQP3( -1, 0, A, 1, IP, TAU, W, LW, RW, INFO )
95 CALL CHKXER( 'ZGEQP3', INFOT, NOUT, LERR, OK )
96 INFOT = 2
97 CALL ZGEQP3( 1, -1, A, 1, IP, TAU, W, LW, RW, INFO )
98 CALL CHKXER( 'ZGEQP3', INFOT, NOUT, LERR, OK )
99 INFOT = 4
100 CALL ZGEQP3( 2, 3, A, 1, IP, TAU, W, LW, RW, INFO )
101 CALL CHKXER( 'ZGEQP3', INFOT, NOUT, LERR, OK )
102 INFOT = 8
103 CALL ZGEQP3( 2, 2, A, 2, IP, TAU, W, LW-10, RW, INFO )
104 CALL CHKXER( 'ZGEQP3', INFOT, NOUT, LERR, OK )
105 END IF
106 *
107 * Print a summary line.
108 *
109 CALL ALAESM( PATH, OK, NOUT )
110 *
111 RETURN
112 *
113 * End of ZERRQP
114 *
115 END