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
81
82
83 LOGICAL LERR, OK
84 CHARACTER*32 SRNAMT
85 INTEGER INFOT, NOUT
86
87
88 COMMON / infoc / infot, nout, ok, lerr
89 COMMON / srnamc / srnamt
90
91
92 INTRINSIC cmplx, real
93
94
95
96 nout = nunit
97 WRITE( nout, fmt = * )
98
99
100
101 DO 20 j = 1, nmax
102 DO 10 i = 1, nmax
103 a( i, j ) = cmplx( 1. / real( i+j ), -1. / real( i+j ) )
104 af( i, j ) = cmplx( 1. / real( i+j ), -1. / real( i+j ) )
105 10 CONTINUE
106 b( j ) = 0.
107 w( j ) = 0.
108 x( j ) = 0.
109 20 CONTINUE
110 ok = .true.
111
112
113
114
115
116 srnamt = 'CGERQF'
117 infot = 1
118 CALL cgerqf( -1, 0, a, 1, b, w, 1, info )
119 CALL chkxer(
'CGERQF', infot, nout, lerr, ok )
120 infot = 2
121 CALL cgerqf( 0, -1, a, 1, b, w, 1, info )
122 CALL chkxer(
'CGERQF', infot, nout, lerr, ok )
123 infot = 4
124 CALL cgerqf( 2, 1, a, 1, b, w, 2, info )
125 CALL chkxer(
'CGERQF', infot, nout, lerr, ok )
126 infot = 7
127 CALL cgerqf( 2, 1, a, 2, b, w, 1, info )
128 CALL chkxer(
'CGERQF', infot, nout, lerr, ok )
129
130
131
132 srnamt = 'CGERQ2'
133 infot = 1
134 CALL cgerq2( -1, 0, a, 1, b, w, info )
135 CALL chkxer(
'CGERQ2', infot, nout, lerr, ok )
136 infot = 2
137 CALL cgerq2( 0, -1, a, 1, b, w, info )
138 CALL chkxer(
'CGERQ2', infot, nout, lerr, ok )
139 infot = 4
140 CALL cgerq2( 2, 1, a, 1, b, w, info )
141 CALL chkxer(
'CGERQ2', infot, nout, lerr, ok )
142
143
144
145 srnamt = 'CGERQS'
146 infot = 1
147 CALL cgerqs( -1, 0, 0, a, 1, x, b, 1, w, 1, info )
148 CALL chkxer(
'CGERQS', infot, nout, lerr, ok )
149 infot = 2
150 CALL cgerqs( 0, -1, 0, a, 1, x, b, 1, w, 1, info )
151 CALL chkxer(
'CGERQS', infot, nout, lerr, ok )
152 infot = 2
153 CALL cgerqs( 2, 1, 0, a, 2, x, b, 1, w, 1, info )
154 CALL chkxer(
'CGERQS', infot, nout, lerr, ok )
155 infot = 3
156 CALL cgerqs( 0, 0, -1, a, 1, x, b, 1, w, 1, info )
157 CALL chkxer(
'CGERQS', infot, nout, lerr, ok )
158 infot = 5
159 CALL cgerqs( 2, 2, 0, a, 1, x, b, 2, w, 1, info )
160 CALL chkxer(
'CGERQS', infot, nout, lerr, ok )
161 infot = 8
162 CALL cgerqs( 2, 2, 0, a, 2, x, b, 1, w, 1, info )
163 CALL chkxer(
'CGERQS', infot, nout, lerr, ok )
164 infot = 10
165 CALL cgerqs( 1, 1, 2, a, 1, x, b, 1, w, 1, info )
166 CALL chkxer(
'CGERQS', infot, nout, lerr, ok )
167
168
169
170 srnamt = 'CUNGRQ'
171 infot = 1
172 CALL cungrq( -1, 0, 0, a, 1, x, w, 1, info )
173 CALL chkxer(
'CUNGRQ', infot, nout, lerr, ok )
174 infot = 2
175 CALL cungrq( 0, -1, 0, a, 1, x, w, 1, info )
176 CALL chkxer(
'CUNGRQ', infot, nout, lerr, ok )
177 infot = 2
178 CALL cungrq( 2, 1, 0, a, 2, x, w, 2, info )
179 CALL chkxer(
'CUNGRQ', infot, nout, lerr, ok )
180 infot = 3
181 CALL cungrq( 0, 0, -1, a, 1, x, w, 1, info )
182 CALL chkxer(
'CUNGRQ', infot, nout, lerr, ok )
183 infot = 3
184 CALL cungrq( 1, 2, 2, a, 1, x, w, 1, info )
185 CALL chkxer(
'CUNGRQ', infot, nout, lerr, ok )
186 infot = 5
187 CALL cungrq( 2, 2, 0, a, 1, x, w, 2, info )
188 CALL chkxer(
'CUNGRQ', infot, nout, lerr, ok )
189 infot = 8
190 CALL cungrq( 2, 2, 0, a, 2, x, w, 1, info )
191 CALL chkxer(
'CUNGRQ', infot, nout, lerr, ok )
192
193
194
195 srnamt = 'CUNGR2'
196 infot = 1
197 CALL cungr2( -1, 0, 0, a, 1, x, w, info )
198 CALL chkxer(
'CUNGR2', infot, nout, lerr, ok )
199 infot = 2
200 CALL cungr2( 0, -1, 0, a, 1, x, w, info )
201 CALL chkxer(
'CUNGR2', infot, nout, lerr, ok )
202 infot = 2
203 CALL cungr2( 2, 1, 0, a, 2, x, w, info )
204 CALL chkxer(
'CUNGR2', infot, nout, lerr, ok )
205 infot = 3
206 CALL cungr2( 0, 0, -1, a, 1, x, w, info )
207 CALL chkxer(
'CUNGR2', infot, nout, lerr, ok )
208 infot = 3
209 CALL cungr2( 1, 2, 2, a, 2, x, w, info )
210 CALL chkxer(
'CUNGR2', infot, nout, lerr, ok )
211 infot = 5
212 CALL cungr2( 2, 2, 0, a, 1, x, w, info )
213 CALL chkxer(
'CUNGR2', infot, nout, lerr, ok )
214
215
216
217 srnamt = 'CUNMRQ'
218 infot = 1
219 CALL cunmrq(
'/',
'N', 0, 0, 0, a, 1, x, af, 1, w, 1, info )
220 CALL chkxer(
'CUNMRQ', infot, nout, lerr, ok )
221 infot = 2
222 CALL cunmrq(
'L',
'/', 0, 0, 0, a, 1, x, af, 1, w, 1, info )
223 CALL chkxer(
'CUNMRQ', infot, nout, lerr, ok )
224 infot = 3
225 CALL cunmrq(
'L',
'N', -1, 0, 0, a, 1, x, af, 1, w, 1, info )
226 CALL chkxer(
'CUNMRQ', infot, nout, lerr, ok )
227 infot = 4
228 CALL cunmrq(
'L',
'N', 0, -1, 0, a, 1, x, af, 1, w, 1, info )
229 CALL chkxer(
'CUNMRQ', infot, nout, lerr, ok )
230 infot = 5
231 CALL cunmrq(
'L',
'N', 0, 0, -1, a, 1, x, af, 1, w, 1, info )
232 CALL chkxer(
'CUNMRQ', infot, nout, lerr, ok )
233 infot = 5
234 CALL cunmrq(
'L',
'N', 0, 1, 1, a, 1, x, af, 1, w, 1, info )
235 CALL chkxer(
'CUNMRQ', infot, nout, lerr, ok )
236 infot = 5
237 CALL cunmrq(
'R',
'N', 1, 0, 1, a, 1, x, af, 1, w, 1, info )
238 CALL chkxer(
'CUNMRQ', infot, nout, lerr, ok )
239 infot = 7
240 CALL cunmrq(
'L',
'N', 2, 1, 2, a, 1, x, af, 2, w, 1, info )
241 CALL chkxer(
'CUNMRQ', infot, nout, lerr, ok )
242 infot = 7
243 CALL cunmrq(
'R',
'N', 1, 2, 2, a, 1, x, af, 1, w, 1, info )
244 CALL chkxer(
'CUNMRQ', infot, nout, lerr, ok )
245 infot = 10
246 CALL cunmrq(
'L',
'N', 2, 1, 0, a, 1, x, af, 1, w, 1, info )
247 CALL chkxer(
'CUNMRQ', infot, nout, lerr, ok )
248 infot = 12
249 CALL cunmrq(
'L',
'N', 1, 2, 0, a, 1, x, af, 1, w, 1, info )
250 CALL chkxer(
'CUNMRQ', infot, nout, lerr, ok )
251 infot = 12
252 CALL cunmrq(
'R',
'N', 2, 1, 0, a, 1, x, af, 2, w, 1, info )
253 CALL chkxer(
'CUNMRQ', infot, nout, lerr, ok )
254
255
256
257 srnamt = 'CUNMR2'
258 infot = 1
259 CALL cunmr2(
'/',
'N', 0, 0, 0, a, 1, x, af, 1, w, info )
260 CALL chkxer(
'CUNMR2', infot, nout, lerr, ok )
261 infot = 2
262 CALL cunmr2(
'L',
'/', 0, 0, 0, a, 1, x, af, 1, w, info )
263 CALL chkxer(
'CUNMR2', infot, nout, lerr, ok )
264 infot = 3
265 CALL cunmr2(
'L',
'N', -1, 0, 0, a, 1, x, af, 1, w, info )
266 CALL chkxer(
'CUNMR2', infot, nout, lerr, ok )
267 infot = 4
268 CALL cunmr2(
'L',
'N', 0, -1, 0, a, 1, x, af, 1, w, info )
269 CALL chkxer(
'CUNMR2', infot, nout, lerr, ok )
270 infot = 5
271 CALL cunmr2(
'L',
'N', 0, 0, -1, a, 1, x, af, 1, w, info )
272 CALL chkxer(
'CUNMR2', infot, nout, lerr, ok )
273 infot = 5
274 CALL cunmr2(
'L',
'N', 0, 1, 1, a, 1, x, af, 1, w, info )
275 CALL chkxer(
'CUNMR2', infot, nout, lerr, ok )
276 infot = 5
277 CALL cunmr2(
'R',
'N', 1, 0, 1, a, 1, x, af, 1, w, info )
278 CALL chkxer(
'CUNMR2', infot, nout, lerr, ok )
279 infot = 7
280 CALL cunmr2(
'L',
'N', 2, 1, 2, a, 1, x, af, 2, w, info )
281 CALL chkxer(
'CUNMR2', infot, nout, lerr, ok )
282 infot = 7
283 CALL cunmr2(
'R',
'N', 1, 2, 2, a, 1, x, af, 1, w, info )
284 CALL chkxer(
'CUNMR2', infot, nout, lerr, ok )
285 infot = 10
286 CALL cunmr2(
'L',
'N', 2, 1, 0, a, 1, x, af, 1, w, info )
287 CALL chkxer(
'CUNMR2', infot, nout, lerr, ok )
288
289
290
291 CALL alaesm( path, ok, nout )
292
293 RETURN
294
295
296
subroutine alaesm(path, ok, nout)
ALAESM
subroutine chkxer(srnamt, infot, nout, lerr, ok)
subroutine cgerqs(m, n, nrhs, a, lda, tau, b, ldb, work, lwork, info)
CGERQS
subroutine cgerq2(m, n, a, lda, tau, work, info)
CGERQ2 computes the RQ factorization of a general rectangular matrix using an unblocked algorithm.
subroutine cgerqf(m, n, a, lda, tau, work, lwork, info)
CGERQF
subroutine cungr2(m, n, k, a, lda, tau, work, info)
CUNGR2 generates all or part of the unitary matrix Q from an RQ factorization determined by cgerqf (u...
subroutine cungrq(m, n, k, a, lda, tau, work, lwork, info)
CUNGRQ
subroutine cunmr2(side, trans, m, n, k, a, lda, tau, c, ldc, work, info)
CUNMR2 multiplies a general matrix by the unitary matrix from a RQ factorization determined by cgerqf...
subroutine cunmrq(side, trans, m, n, k, a, lda, tau, c, ldc, work, lwork, info)
CUNMRQ