55
56
57
58
59
60
61 CHARACTER*3 PATH
62 INTEGER NUNIT
63
64
65
66
67
68 INTEGER NMAX
69 parameter( nmax = 2 )
70
71
72 INTEGER I, INFO, J
73
74
75 COMPLEX A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
76 $ W( NMAX ), X( NMAX )
77
78
82
83
84 LOGICAL LERR, OK
85 CHARACTER*32 SRNAMT
86 INTEGER INFOT, NOUT
87
88
89 COMMON / infoc / infot, nout, ok, lerr
90 COMMON / srnamc / srnamt
91
92
93 INTRINSIC cmplx, real
94
95
96
97 nout = nunit
98 WRITE( nout, fmt = * )
99
100
101
102 DO 20 j = 1, nmax
103 DO 10 i = 1, nmax
104 a( i, j ) = cmplx( 1. / real( i+j ), -1. / real( i+j ) )
105 af( i, j ) = cmplx( 1. / real( i+j ), -1. / real( i+j ) )
106 10 CONTINUE
107 b( j ) = 0.
108 w( j ) = 0.
109 x( j ) = 0.
110 20 CONTINUE
111 ok = .true.
112
113
114
115
116
117 srnamt = 'CGEQRF'
118 infot = 1
119 CALL cgeqrf( -1, 0, a, 1, b, w, 1, info )
120 CALL chkxer(
'CGEQRF', infot, nout, lerr, ok )
121 infot = 2
122 CALL cgeqrf( 0, -1, a, 1, b, w, 1, info )
123 CALL chkxer(
'CGEQRF', infot, nout, lerr, ok )
124 infot = 4
125 CALL cgeqrf( 2, 1, a, 1, b, w, 1, info )
126 CALL chkxer(
'CGEQRF', infot, nout, lerr, ok )
127 infot = 7
128 CALL cgeqrf( 1, 2, a, 1, b, w, 1, info )
129 CALL chkxer(
'CGEQRF', infot, nout, lerr, ok )
130
131
132
133 srnamt = 'CGEQRFP'
134 infot = 1
135 CALL cgeqrfp( -1, 0, a, 1, b, w, 1, info )
136 CALL chkxer(
'CGEQRFP', infot, nout, lerr, ok )
137 infot = 2
138 CALL cgeqrfp( 0, -1, a, 1, b, w, 1, info )
139 CALL chkxer(
'CGEQRFP', infot, nout, lerr, ok )
140 infot = 4
141 CALL cgeqrfp( 2, 1, a, 1, b, w, 1, info )
142 CALL chkxer(
'CGEQRFP', infot, nout, lerr, ok )
143 infot = 7
144 CALL cgeqrfp( 1, 2, a, 1, b, w, 1, info )
145 CALL chkxer(
'CGEQRFP', infot, nout, lerr, ok )
146
147
148
149 srnamt = 'CGEQR2'
150 infot = 1
151 CALL cgeqr2( -1, 0, a, 1, b, w, info )
152 CALL chkxer(
'CGEQR2', infot, nout, lerr, ok )
153 infot = 2
154 CALL cgeqr2( 0, -1, a, 1, b, w, info )
155 CALL chkxer(
'CGEQR2', infot, nout, lerr, ok )
156 infot = 4
157 CALL cgeqr2( 2, 1, a, 1, b, w, info )
158 CALL chkxer(
'CGEQR2', infot, nout, lerr, ok )
159
160
161
162 srnamt = 'CGEQR2P'
163 infot = 1
164 CALL cgeqr2p( -1, 0, a, 1, b, w, info )
165 CALL chkxer(
'CGEQR2P', infot, nout, lerr, ok )
166 infot = 2
167 CALL cgeqr2p( 0, -1, a, 1, b, w, info )
168 CALL chkxer(
'CGEQR2P', infot, nout, lerr, ok )
169 infot = 4
170 CALL cgeqr2p( 2, 1, a, 1, b, w, info )
171 CALL chkxer(
'CGEQR2P', infot, nout, lerr, ok )
172
173
174
175 srnamt = 'CUNGQR'
176 infot = 1
177 CALL cungqr( -1, 0, 0, a, 1, x, w, 1, info )
178 CALL chkxer(
'CUNGQR', infot, nout, lerr, ok )
179 infot = 2
180 CALL cungqr( 0, -1, 0, a, 1, x, w, 1, info )
181 CALL chkxer(
'CUNGQR', infot, nout, lerr, ok )
182 infot = 2
183 CALL cungqr( 1, 2, 0, a, 1, x, w, 2, info )
184 CALL chkxer(
'CUNGQR', infot, nout, lerr, ok )
185 infot = 3
186 CALL cungqr( 0, 0, -1, a, 1, x, w, 1, info )
187 CALL chkxer(
'CUNGQR', infot, nout, lerr, ok )
188 infot = 3
189 CALL cungqr( 1, 1, 2, a, 1, x, w, 1, info )
190 CALL chkxer(
'CUNGQR', infot, nout, lerr, ok )
191 infot = 5
192 CALL cungqr( 2, 2, 0, a, 1, x, w, 2, info )
193 CALL chkxer(
'CUNGQR', infot, nout, lerr, ok )
194 infot = 8
195 CALL cungqr( 2, 2, 0, a, 2, x, w, 1, info )
196 CALL chkxer(
'CUNGQR', infot, nout, lerr, ok )
197
198
199
200 srnamt = 'CUNG2R'
201 infot = 1
202 CALL cung2r( -1, 0, 0, a, 1, x, w, info )
203 CALL chkxer(
'CUNG2R', infot, nout, lerr, ok )
204 infot = 2
205 CALL cung2r( 0, -1, 0, a, 1, x, w, info )
206 CALL chkxer(
'CUNG2R', infot, nout, lerr, ok )
207 infot = 2
208 CALL cung2r( 1, 2, 0, a, 1, x, w, info )
209 CALL chkxer(
'CUNG2R', infot, nout, lerr, ok )
210 infot = 3
211 CALL cung2r( 0, 0, -1, a, 1, x, w, info )
212 CALL chkxer(
'CUNG2R', infot, nout, lerr, ok )
213 infot = 3
214 CALL cung2r( 2, 1, 2, a, 2, x, w, info )
215 CALL chkxer(
'CUNG2R', infot, nout, lerr, ok )
216 infot = 5
217 CALL cung2r( 2, 1, 0, a, 1, x, w, info )
218 CALL chkxer(
'CUNG2R', infot, nout, lerr, ok )
219
220
221
222 srnamt = 'CUNMQR'
223 infot = 1
224 CALL cunmqr(
'/',
'N', 0, 0, 0, a, 1, x, af, 1, w, 1, info )
225 CALL chkxer(
'CUNMQR', infot, nout, lerr, ok )
226 infot = 2
227 CALL cunmqr(
'L',
'/', 0, 0, 0, a, 1, x, af, 1, w, 1, info )
228 CALL chkxer(
'CUNMQR', infot, nout, lerr, ok )
229 infot = 3
230 CALL cunmqr(
'L',
'N', -1, 0, 0, a, 1, x, af, 1, w, 1, info )
231 CALL chkxer(
'CUNMQR', infot, nout, lerr, ok )
232 infot = 4
233 CALL cunmqr(
'L',
'N', 0, -1, 0, a, 1, x, af, 1, w, 1, info )
234 CALL chkxer(
'CUNMQR', infot, nout, lerr, ok )
235 infot = 5
236 CALL cunmqr(
'L',
'N', 0, 0, -1, a, 1, x, af, 1, w, 1, info )
237 CALL chkxer(
'CUNMQR', infot, nout, lerr, ok )
238 infot = 5
239 CALL cunmqr(
'L',
'N', 0, 1, 1, a, 1, x, af, 1, w, 1, info )
240 CALL chkxer(
'CUNMQR', infot, nout, lerr, ok )
241 infot = 5
242 CALL cunmqr(
'R',
'N', 1, 0, 1, a, 1, x, af, 1, w, 1, info )
243 CALL chkxer(
'CUNMQR', infot, nout, lerr, ok )
244 infot = 7
245 CALL cunmqr(
'L',
'N', 2, 1, 0, a, 1, x, af, 2, w, 1, info )
246 CALL chkxer(
'CUNMQR', infot, nout, lerr, ok )
247 infot = 7
248 CALL cunmqr(
'R',
'N', 1, 2, 0, a, 1, x, af, 1, w, 1, info )
249 CALL chkxer(
'CUNMQR', infot, nout, lerr, ok )
250 infot = 10
251 CALL cunmqr(
'L',
'N', 2, 1, 0, a, 2, x, af, 1, w, 1, info )
252 CALL chkxer(
'CUNMQR', infot, nout, lerr, ok )
253 infot = 12
254 CALL cunmqr(
'L',
'N', 1, 2, 0, a, 1, x, af, 1, w, 1, info )
255 CALL chkxer(
'CUNMQR', infot, nout, lerr, ok )
256 infot = 12
257 CALL cunmqr(
'R',
'N', 2, 1, 0, a, 1, x, af, 2, w, 1, info )
258 CALL chkxer(
'CUNMQR', infot, nout, lerr, ok )
259
260
261
262 srnamt = 'CUNM2R'
263 infot = 1
264 CALL cunm2r(
'/',
'N', 0, 0, 0, a, 1, x, af, 1, w, info )
265 CALL chkxer(
'CUNM2R', infot, nout, lerr, ok )
266 infot = 2
267 CALL cunm2r(
'L',
'/', 0, 0, 0, a, 1, x, af, 1, w, info )
268 CALL chkxer(
'CUNM2R', infot, nout, lerr, ok )
269 infot = 3
270 CALL cunm2r(
'L',
'N', -1, 0, 0, a, 1, x, af, 1, w, info )
271 CALL chkxer(
'CUNM2R', infot, nout, lerr, ok )
272 infot = 4
273 CALL cunm2r(
'L',
'N', 0, -1, 0, a, 1, x, af, 1, w, info )
274 CALL chkxer(
'CUNM2R', infot, nout, lerr, ok )
275 infot = 5
276 CALL cunm2r(
'L',
'N', 0, 0, -1, a, 1, x, af, 1, w, info )
277 CALL chkxer(
'CUNM2R', infot, nout, lerr, ok )
278 infot = 5
279 CALL cunm2r(
'L',
'N', 0, 1, 1, a, 1, x, af, 1, w, info )
280 CALL chkxer(
'CUNM2R', infot, nout, lerr, ok )
281 infot = 5
282 CALL cunm2r(
'R',
'N', 1, 0, 1, a, 1, x, af, 1, w, info )
283 CALL chkxer(
'CUNM2R', infot, nout, lerr, ok )
284 infot = 7
285 CALL cunm2r(
'L',
'N', 2, 1, 0, a, 1, x, af, 2, w, info )
286 CALL chkxer(
'CUNM2R', infot, nout, lerr, ok )
287 infot = 7
288 CALL cunm2r(
'R',
'N', 1, 2, 0, a, 1, x, af, 1, w, info )
289 CALL chkxer(
'CUNM2R', infot, nout, lerr, ok )
290 infot = 10
291 CALL cunm2r(
'L',
'N', 2, 1, 0, a, 2, x, af, 1, w, info )
292 CALL chkxer(
'CUNM2R', infot, nout, lerr, ok )
293
294
295
296 CALL alaesm( path, ok, nout )
297
298 RETURN
299
300
301
subroutine alaesm(path, ok, nout)
ALAESM
subroutine chkxer(srnamt, infot, nout, lerr, ok)
subroutine cgeqr2(m, n, a, lda, tau, work, info)
CGEQR2 computes the QR factorization of a general rectangular matrix using an unblocked algorithm.
subroutine cgeqr2p(m, n, a, lda, tau, work, info)
CGEQR2P computes the QR factorization of a general rectangular matrix with non-negative diagonal elem...
subroutine cgeqrf(m, n, a, lda, tau, work, lwork, info)
CGEQRF
subroutine cgeqrfp(m, n, a, lda, tau, work, lwork, info)
CGEQRFP
subroutine cung2r(m, n, k, a, lda, tau, work, info)
CUNG2R
subroutine cungqr(m, n, k, a, lda, tau, work, lwork, info)
CUNGQR
subroutine cunm2r(side, trans, m, n, k, a, lda, tau, c, ldc, work, info)
CUNM2R multiplies a general matrix by the unitary matrix from a QR factorization determined by cgeqrf...
subroutine cunmqr(side, trans, m, n, k, a, lda, tau, c, ldc, work, lwork, info)
CUNMQR