1 SUBROUTINE CERRTZ( 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 * CERRTZ tests the error exits for CTZRQF and CTZRZF.
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 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, CTZRQF, CTZRZF
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 CMPLX
57 * ..
58 * .. Executable Statements ..
59 *
60 NOUT = NUNIT
61 C2 = PATH( 2: 3 )
62 A( 1, 1 ) = CMPLX( 1.E+0, -1.E+0 )
63 A( 1, 2 ) = CMPLX( 2.E+0, -2.E+0 )
64 A( 2, 2 ) = CMPLX( 3.E+0, -3.E+0 )
65 A( 2, 1 ) = CMPLX( 4.E+0, -4.E+0 )
66 W( 1 ) = CMPLX( 0.E+0, 0.E+0 )
67 W( 2 ) = CMPLX( 0.E+0, 0.E+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 * CTZRQF
76 *
77 SRNAMT = 'CTZRQF'
78 INFOT = 1
79 CALL CTZRQF( -1, 0, A, 1, TAU, INFO )
80 CALL CHKXER( 'CTZRQF', INFOT, NOUT, LERR, OK )
81 INFOT = 2
82 CALL CTZRQF( 1, 0, A, 1, TAU, INFO )
83 CALL CHKXER( 'CTZRQF', INFOT, NOUT, LERR, OK )
84 INFOT = 4
85 CALL CTZRQF( 2, 2, A, 1, TAU, INFO )
86 CALL CHKXER( 'CTZRQF', INFOT, NOUT, LERR, OK )
87 *
88 * CTZRZF
89 *
90 SRNAMT = 'CTZRZF'
91 INFOT = 1
92 CALL CTZRZF( -1, 0, A, 1, TAU, W, 1, INFO )
93 CALL CHKXER( 'CTZRZF', INFOT, NOUT, LERR, OK )
94 INFOT = 2
95 CALL CTZRZF( 1, 0, A, 1, TAU, W, 1, INFO )
96 CALL CHKXER( 'CTZRZF', INFOT, NOUT, LERR, OK )
97 INFOT = 4
98 CALL CTZRZF( 2, 2, A, 1, TAU, W, 1, INFO )
99 CALL CHKXER( 'CTZRZF', INFOT, NOUT, LERR, OK )
100 INFOT = 7
101 CALL CTZRZF( 2, 2, A, 2, TAU, W, 0, INFO )
102 CALL CHKXER( 'CTZRZF', INFOT, NOUT, LERR, OK )
103 INFOT = 7
104 CALL CTZRZF( 2, 3, A, 2, TAU, W, 1, INFO )
105 CALL CHKXER( 'CTZRZF', 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 CERRTZ
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 * CERRTZ tests the error exits for CTZRQF and CTZRZF.
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 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, CTZRQF, CTZRZF
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 CMPLX
57 * ..
58 * .. Executable Statements ..
59 *
60 NOUT = NUNIT
61 C2 = PATH( 2: 3 )
62 A( 1, 1 ) = CMPLX( 1.E+0, -1.E+0 )
63 A( 1, 2 ) = CMPLX( 2.E+0, -2.E+0 )
64 A( 2, 2 ) = CMPLX( 3.E+0, -3.E+0 )
65 A( 2, 1 ) = CMPLX( 4.E+0, -4.E+0 )
66 W( 1 ) = CMPLX( 0.E+0, 0.E+0 )
67 W( 2 ) = CMPLX( 0.E+0, 0.E+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 * CTZRQF
76 *
77 SRNAMT = 'CTZRQF'
78 INFOT = 1
79 CALL CTZRQF( -1, 0, A, 1, TAU, INFO )
80 CALL CHKXER( 'CTZRQF', INFOT, NOUT, LERR, OK )
81 INFOT = 2
82 CALL CTZRQF( 1, 0, A, 1, TAU, INFO )
83 CALL CHKXER( 'CTZRQF', INFOT, NOUT, LERR, OK )
84 INFOT = 4
85 CALL CTZRQF( 2, 2, A, 1, TAU, INFO )
86 CALL CHKXER( 'CTZRQF', INFOT, NOUT, LERR, OK )
87 *
88 * CTZRZF
89 *
90 SRNAMT = 'CTZRZF'
91 INFOT = 1
92 CALL CTZRZF( -1, 0, A, 1, TAU, W, 1, INFO )
93 CALL CHKXER( 'CTZRZF', INFOT, NOUT, LERR, OK )
94 INFOT = 2
95 CALL CTZRZF( 1, 0, A, 1, TAU, W, 1, INFO )
96 CALL CHKXER( 'CTZRZF', INFOT, NOUT, LERR, OK )
97 INFOT = 4
98 CALL CTZRZF( 2, 2, A, 1, TAU, W, 1, INFO )
99 CALL CHKXER( 'CTZRZF', INFOT, NOUT, LERR, OK )
100 INFOT = 7
101 CALL CTZRZF( 2, 2, A, 2, TAU, W, 0, INFO )
102 CALL CHKXER( 'CTZRZF', INFOT, NOUT, LERR, OK )
103 INFOT = 7
104 CALL CTZRZF( 2, 3, A, 2, TAU, W, 1, INFO )
105 CALL CHKXER( 'CTZRZF', 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 CERRTZ
115 *
116 END