1 SUBROUTINE ZERRTZ( PATH, NUNIT )
2 *
3 * -- LAPACK test routine (version 3.3.1) --
4 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
5 * -- April 2011 --
6 *
7 * .. Scalar Arguments ..
8 CHARACTER*3 PATH
9 INTEGER NUNIT
10 * ..
11 *
12 * Purpose
13 * =======
14 *
15 * ZERRTZ tests the error exits for ZTZRQF and ZTZRZF.
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 = 2 )
31 * ..
32 * .. Local Scalars ..
33 CHARACTER*2 C2
34 INTEGER INFO
35 * ..
36 * .. Local Arrays ..
37 COMPLEX*16 A( NMAX, NMAX ), TAU( NMAX ), W( NMAX )
38 * ..
39 * .. External Functions ..
40 LOGICAL LSAMEN
41 EXTERNAL LSAMEN
42 * ..
43 * .. External Subroutines ..
44 EXTERNAL ALAESM, CHKXER, ZTZRQF, ZTZRZF
45 * ..
46 * .. Scalars in Common ..
47 LOGICAL LERR, OK
48 CHARACTER*32 SRNAMT
49 INTEGER INFOT, NOUT
50 * ..
51 * .. Common blocks ..
52 COMMON / INFOC / INFOT, NOUT, OK, LERR
53 COMMON / SRNAMC / SRNAMT
54 * ..
55 * .. Intrinsic Functions ..
56 INTRINSIC DCMPLX
57 * ..
58 * .. Executable Statements ..
59 *
60 NOUT = NUNIT
61 C2 = PATH( 2: 3 )
62 A( 1, 1 ) = DCMPLX( 1.D+0, -1.D+0 )
63 A( 1, 2 ) = DCMPLX( 2.D+0, -2.D+0 )
64 A( 2, 2 ) = DCMPLX( 3.D+0, -3.D+0 )
65 A( 2, 1 ) = DCMPLX( 4.D+0, -4.D+0 )
66 W( 1 ) = DCMPLX( 0.D+0, 0.D+0 )
67 W( 2 ) = DCMPLX( 0.D+0, 0.D+0 )
68 OK = .TRUE.
69 *
70 * Test error exits for the trapezoidal routines.
71 *
72 WRITE( NOUT, FMT = * )
73 IF( LSAMEN( 2, C2, 'TZ' ) ) THEN
74 *
75 * ZTZRQF
76 *
77 SRNAMT = 'ZTZRQF'
78 INFOT = 1
79 CALL ZTZRQF( -1, 0, A, 1, TAU, INFO )
80 CALL CHKXER( 'ZTZRQF', INFOT, NOUT, LERR, OK )
81 INFOT = 2
82 CALL ZTZRQF( 1, 0, A, 1, TAU, INFO )
83 CALL CHKXER( 'ZTZRQF', INFOT, NOUT, LERR, OK )
84 INFOT = 4
85 CALL ZTZRQF( 2, 2, A, 1, TAU, INFO )
86 CALL CHKXER( 'ZTZRQF', INFOT, NOUT, LERR, OK )
87 *
88 * ZTZRZF
89 *
90 SRNAMT = 'ZTZRZF'
91 INFOT = 1
92 CALL ZTZRZF( -1, 0, A, 1, TAU, W, 1, INFO )
93 CALL CHKXER( 'ZTZRZF', INFOT, NOUT, LERR, OK )
94 INFOT = 2
95 CALL ZTZRZF( 1, 0, A, 1, TAU, W, 1, INFO )
96 CALL CHKXER( 'ZTZRZF', INFOT, NOUT, LERR, OK )
97 INFOT = 4
98 CALL ZTZRZF( 2, 2, A, 1, TAU, W, 1, INFO )
99 CALL CHKXER( 'ZTZRZF', INFOT, NOUT, LERR, OK )
100 INFOT = 7
101 CALL ZTZRZF( 2, 2, A, 2, TAU, W, 0, INFO )
102 CALL CHKXER( 'ZTZRZF', INFOT, NOUT, LERR, OK )
103 INFOT = 7
104 CALL ZTZRZF( 2, 3, A, 2, TAU, W, 1, INFO )
105 CALL CHKXER( 'ZTZRZF', INFOT, NOUT, LERR, OK )
106 END IF
107 *
108 * Print a summary line.
109 *
110 CALL ALAESM( PATH, OK, NOUT )
111 *
112 RETURN
113 *
114 * End of ZERRTZ
115 *
116 END
2 *
3 * -- LAPACK test routine (version 3.3.1) --
4 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
5 * -- April 2011 --
6 *
7 * .. Scalar Arguments ..
8 CHARACTER*3 PATH
9 INTEGER NUNIT
10 * ..
11 *
12 * Purpose
13 * =======
14 *
15 * ZERRTZ tests the error exits for ZTZRQF and ZTZRZF.
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 = 2 )
31 * ..
32 * .. Local Scalars ..
33 CHARACTER*2 C2
34 INTEGER INFO
35 * ..
36 * .. Local Arrays ..
37 COMPLEX*16 A( NMAX, NMAX ), TAU( NMAX ), W( NMAX )
38 * ..
39 * .. External Functions ..
40 LOGICAL LSAMEN
41 EXTERNAL LSAMEN
42 * ..
43 * .. External Subroutines ..
44 EXTERNAL ALAESM, CHKXER, ZTZRQF, ZTZRZF
45 * ..
46 * .. Scalars in Common ..
47 LOGICAL LERR, OK
48 CHARACTER*32 SRNAMT
49 INTEGER INFOT, NOUT
50 * ..
51 * .. Common blocks ..
52 COMMON / INFOC / INFOT, NOUT, OK, LERR
53 COMMON / SRNAMC / SRNAMT
54 * ..
55 * .. Intrinsic Functions ..
56 INTRINSIC DCMPLX
57 * ..
58 * .. Executable Statements ..
59 *
60 NOUT = NUNIT
61 C2 = PATH( 2: 3 )
62 A( 1, 1 ) = DCMPLX( 1.D+0, -1.D+0 )
63 A( 1, 2 ) = DCMPLX( 2.D+0, -2.D+0 )
64 A( 2, 2 ) = DCMPLX( 3.D+0, -3.D+0 )
65 A( 2, 1 ) = DCMPLX( 4.D+0, -4.D+0 )
66 W( 1 ) = DCMPLX( 0.D+0, 0.D+0 )
67 W( 2 ) = DCMPLX( 0.D+0, 0.D+0 )
68 OK = .TRUE.
69 *
70 * Test error exits for the trapezoidal routines.
71 *
72 WRITE( NOUT, FMT = * )
73 IF( LSAMEN( 2, C2, 'TZ' ) ) THEN
74 *
75 * ZTZRQF
76 *
77 SRNAMT = 'ZTZRQF'
78 INFOT = 1
79 CALL ZTZRQF( -1, 0, A, 1, TAU, INFO )
80 CALL CHKXER( 'ZTZRQF', INFOT, NOUT, LERR, OK )
81 INFOT = 2
82 CALL ZTZRQF( 1, 0, A, 1, TAU, INFO )
83 CALL CHKXER( 'ZTZRQF', INFOT, NOUT, LERR, OK )
84 INFOT = 4
85 CALL ZTZRQF( 2, 2, A, 1, TAU, INFO )
86 CALL CHKXER( 'ZTZRQF', INFOT, NOUT, LERR, OK )
87 *
88 * ZTZRZF
89 *
90 SRNAMT = 'ZTZRZF'
91 INFOT = 1
92 CALL ZTZRZF( -1, 0, A, 1, TAU, W, 1, INFO )
93 CALL CHKXER( 'ZTZRZF', INFOT, NOUT, LERR, OK )
94 INFOT = 2
95 CALL ZTZRZF( 1, 0, A, 1, TAU, W, 1, INFO )
96 CALL CHKXER( 'ZTZRZF', INFOT, NOUT, LERR, OK )
97 INFOT = 4
98 CALL ZTZRZF( 2, 2, A, 1, TAU, W, 1, INFO )
99 CALL CHKXER( 'ZTZRZF', INFOT, NOUT, LERR, OK )
100 INFOT = 7
101 CALL ZTZRZF( 2, 2, A, 2, TAU, W, 0, INFO )
102 CALL CHKXER( 'ZTZRZF', INFOT, NOUT, LERR, OK )
103 INFOT = 7
104 CALL ZTZRZF( 2, 3, A, 2, TAU, W, 1, INFO )
105 CALL CHKXER( 'ZTZRZF', INFOT, NOUT, LERR, OK )
106 END IF
107 *
108 * Print a summary line.
109 *
110 CALL ALAESM( PATH, OK, NOUT )
111 *
112 RETURN
113 *
114 * End of ZERRTZ
115 *
116 END