1 SUBROUTINE SERRQP( 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 * SERRQP tests the error exits for SGEQPF and SGEQP3.
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 REAL A( NMAX, NMAX ), TAU( NMAX ), W( 3*NMAX+1 )
39 * ..
40 * .. External Functions ..
41 LOGICAL LSAMEN
42 EXTERNAL LSAMEN
43 * ..
44 * .. External Subroutines ..
45 EXTERNAL ALAESM, CHKXER, SGEQP3, SGEQPF
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 * .. Executable Statements ..
57 *
58 NOUT = NUNIT
59 WRITE( NOUT, FMT = * )
60 C2 = PATH( 2: 3 )
61 LW = 3*NMAX + 1
62 A( 1, 1 ) = 1.0E+0
63 A( 1, 2 ) = 2.0E+0
64 A( 2, 2 ) = 3.0E+0
65 A( 2, 1 ) = 4.0E+0
66 OK = .TRUE.
67 *
68 IF( LSAMEN( 2, C2, 'QP' ) ) THEN
69 *
70 * Test error exits for QR factorization with pivoting
71 *
72 * SGEQPF
73 *
74 SRNAMT = 'SGEQPF'
75 INFOT = 1
76 CALL SGEQPF( -1, 0, A, 1, IP, TAU, W, INFO )
77 CALL CHKXER( 'SGEQPF', INFOT, NOUT, LERR, OK )
78 INFOT = 2
79 CALL SGEQPF( 0, -1, A, 1, IP, TAU, W, INFO )
80 CALL CHKXER( 'SGEQPF', INFOT, NOUT, LERR, OK )
81 INFOT = 4
82 CALL SGEQPF( 2, 0, A, 1, IP, TAU, W, INFO )
83 CALL CHKXER( 'SGEQPF', INFOT, NOUT, LERR, OK )
84 *
85 * SGEQP3
86 *
87 SRNAMT = 'SGEQP3'
88 INFOT = 1
89 CALL SGEQP3( -1, 0, A, 1, IP, TAU, W, LW, INFO )
90 CALL CHKXER( 'SGEQP3', INFOT, NOUT, LERR, OK )
91 INFOT = 2
92 CALL SGEQP3( 1, -1, A, 1, IP, TAU, W, LW, INFO )
93 CALL CHKXER( 'SGEQP3', INFOT, NOUT, LERR, OK )
94 INFOT = 4
95 CALL SGEQP3( 2, 3, A, 1, IP, TAU, W, LW, INFO )
96 CALL CHKXER( 'SGEQP3', INFOT, NOUT, LERR, OK )
97 INFOT = 8
98 CALL SGEQP3( 2, 2, A, 2, IP, TAU, W, LW-10, INFO )
99 CALL CHKXER( 'SGEQP3', INFOT, NOUT, LERR, OK )
100 END IF
101 *
102 * Print a summary line.
103 *
104 CALL ALAESM( PATH, OK, NOUT )
105 *
106 RETURN
107 *
108 * End of SERRQP
109 *
110 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 * SERRQP tests the error exits for SGEQPF and SGEQP3.
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 REAL A( NMAX, NMAX ), TAU( NMAX ), W( 3*NMAX+1 )
39 * ..
40 * .. External Functions ..
41 LOGICAL LSAMEN
42 EXTERNAL LSAMEN
43 * ..
44 * .. External Subroutines ..
45 EXTERNAL ALAESM, CHKXER, SGEQP3, SGEQPF
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 * .. Executable Statements ..
57 *
58 NOUT = NUNIT
59 WRITE( NOUT, FMT = * )
60 C2 = PATH( 2: 3 )
61 LW = 3*NMAX + 1
62 A( 1, 1 ) = 1.0E+0
63 A( 1, 2 ) = 2.0E+0
64 A( 2, 2 ) = 3.0E+0
65 A( 2, 1 ) = 4.0E+0
66 OK = .TRUE.
67 *
68 IF( LSAMEN( 2, C2, 'QP' ) ) THEN
69 *
70 * Test error exits for QR factorization with pivoting
71 *
72 * SGEQPF
73 *
74 SRNAMT = 'SGEQPF'
75 INFOT = 1
76 CALL SGEQPF( -1, 0, A, 1, IP, TAU, W, INFO )
77 CALL CHKXER( 'SGEQPF', INFOT, NOUT, LERR, OK )
78 INFOT = 2
79 CALL SGEQPF( 0, -1, A, 1, IP, TAU, W, INFO )
80 CALL CHKXER( 'SGEQPF', INFOT, NOUT, LERR, OK )
81 INFOT = 4
82 CALL SGEQPF( 2, 0, A, 1, IP, TAU, W, INFO )
83 CALL CHKXER( 'SGEQPF', INFOT, NOUT, LERR, OK )
84 *
85 * SGEQP3
86 *
87 SRNAMT = 'SGEQP3'
88 INFOT = 1
89 CALL SGEQP3( -1, 0, A, 1, IP, TAU, W, LW, INFO )
90 CALL CHKXER( 'SGEQP3', INFOT, NOUT, LERR, OK )
91 INFOT = 2
92 CALL SGEQP3( 1, -1, A, 1, IP, TAU, W, LW, INFO )
93 CALL CHKXER( 'SGEQP3', INFOT, NOUT, LERR, OK )
94 INFOT = 4
95 CALL SGEQP3( 2, 3, A, 1, IP, TAU, W, LW, INFO )
96 CALL CHKXER( 'SGEQP3', INFOT, NOUT, LERR, OK )
97 INFOT = 8
98 CALL SGEQP3( 2, 2, A, 2, IP, TAU, W, LW-10, INFO )
99 CALL CHKXER( 'SGEQP3', INFOT, NOUT, LERR, OK )
100 END IF
101 *
102 * Print a summary line.
103 *
104 CALL ALAESM( PATH, OK, NOUT )
105 *
106 RETURN
107 *
108 * End of SERRQP
109 *
110 END