54
55
56
57
58
59
60 CHARACTER*3 PATH
61 INTEGER NUNIT
62
63
64
65
66
67 INTEGER NMAX
68 parameter( nmax = 2 )
69
70
71 CHARACTER*2 C2
72 INTEGER INFO
73
74
75 COMPLEX A( NMAX, NMAX ), TAU( NMAX ), W( NMAX )
76
77
78 LOGICAL LSAMEN
80
81
83
84
85 LOGICAL LERR, OK
86 CHARACTER*32 SRNAMT
87 INTEGER INFOT, NOUT
88
89
90 COMMON / infoc / infot, nout, ok, lerr
91 COMMON / srnamc / srnamt
92
93
94 INTRINSIC cmplx
95
96
97
98 nout = nunit
99 c2 = path( 2: 3 )
100 a( 1, 1 ) = cmplx( 1.e+0, -1.e+0 )
101 a( 1, 2 ) = cmplx( 2.e+0, -2.e+0 )
102 a( 2, 2 ) = cmplx( 3.e+0, -3.e+0 )
103 a( 2, 1 ) = cmplx( 4.e+0, -4.e+0 )
104 w( 1 ) = cmplx( 0.e+0, 0.e+0 )
105 w( 2 ) = cmplx( 0.e+0, 0.e+0 )
106 ok = .true.
107
108
109
110 WRITE( nout, fmt = * )
111 IF(
lsamen( 2, c2,
'TZ' ) )
THEN
112
113
114
115 srnamt = 'CTZRZF'
116 infot = 1
117 CALL ctzrzf( -1, 0, a, 1, tau, w, 1, info )
118 CALL chkxer(
'CTZRZF', infot, nout, lerr, ok )
119 infot = 2
120 CALL ctzrzf( 1, 0, a, 1, tau, w, 1, info )
121 CALL chkxer(
'CTZRZF', infot, nout, lerr, ok )
122 infot = 4
123 CALL ctzrzf( 2, 2, a, 1, tau, w, 1, info )
124 CALL chkxer(
'CTZRZF', infot, nout, lerr, ok )
125 infot = 7
126 CALL ctzrzf( 2, 2, a, 2, tau, w, 0, info )
127 CALL chkxer(
'CTZRZF', infot, nout, lerr, ok )
128 infot = 7
129 CALL ctzrzf( 2, 3, a, 2, tau, w, 1, info )
130 CALL chkxer(
'CTZRZF', infot, nout, lerr, ok )
131 END IF
132
133
134
135 CALL alaesm( path, ok, nout )
136
137 RETURN
138
139
140
subroutine alaesm(path, ok, nout)
ALAESM
subroutine chkxer(srnamt, infot, nout, lerr, ok)
logical function lsamen(n, ca, cb)
LSAMEN
subroutine ctzrzf(m, n, a, lda, tau, work, lwork, info)
CTZRZF