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 REAL 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 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 ) = 1. / real( i+j )
105 af( 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 = 'SGEQRF'
118 infot = 1
119 CALL sgeqrf( -1, 0, a, 1, b, w, 1, info )
120 CALL chkxer(
'SGEQRF', infot, nout, lerr, ok )
121 infot = 2
122 CALL sgeqrf( 0, -1, a, 1, b, w, 1, info )
123 CALL chkxer(
'SGEQRF', infot, nout, lerr, ok )
124 infot = 4
125 CALL sgeqrf( 2, 1, a, 1, b, w, 1, info )
126 CALL chkxer(
'SGEQRF', infot, nout, lerr, ok )
127 infot = 7
128 CALL sgeqrf( 1, 2, a, 1, b, w, 1, info )
129 CALL chkxer(
'SGEQRF', infot, nout, lerr, ok )
130
131
132
133 srnamt = 'SGEQRFP'
134 infot = 1
135 CALL sgeqrfp( -1, 0, a, 1, b, w, 1, info )
136 CALL chkxer(
'SGEQRFP', infot, nout, lerr, ok )
137 infot = 2
138 CALL sgeqrfp( 0, -1, a, 1, b, w, 1, info )
139 CALL chkxer(
'SGEQRFP', infot, nout, lerr, ok )
140 infot = 4
141 CALL sgeqrfp( 2, 1, a, 1, b, w, 1, info )
142 CALL chkxer(
'SGEQRFP', infot, nout, lerr, ok )
143 infot = 7
144 CALL sgeqrfp( 1, 2, a, 1, b, w, 1, info )
145 CALL chkxer(
'SGEQRFP', infot, nout, lerr, ok )
146
147
148
149 srnamt = 'SGEQR2'
150 infot = 1
151 CALL sgeqr2( -1, 0, a, 1, b, w, info )
152 CALL chkxer(
'SGEQR2', infot, nout, lerr, ok )
153 infot = 2
154 CALL sgeqr2( 0, -1, a, 1, b, w, info )
155 CALL chkxer(
'SGEQR2', infot, nout, lerr, ok )
156 infot = 4
157 CALL sgeqr2( 2, 1, a, 1, b, w, info )
158 CALL chkxer(
'SGEQR2', infot, nout, lerr, ok )
159
160
161
162 srnamt = 'SGEQR2P'
163 infot = 1
164 CALL sgeqr2p( -1, 0, a, 1, b, w, info )
165 CALL chkxer(
'SGEQR2P', infot, nout, lerr, ok )
166 infot = 2
167 CALL sgeqr2p( 0, -1, a, 1, b, w, info )
168 CALL chkxer(
'SGEQR2P', infot, nout, lerr, ok )
169 infot = 4
170 CALL sgeqr2p( 2, 1, a, 1, b, w, info )
171 CALL chkxer(
'SGEQR2P', infot, nout, lerr, ok )
172
173
174
175 srnamt = 'SGEQRS'
176 infot = 1
177 CALL sgeqrs( -1, 0, 0, a, 1, x, b, 1, w, 1, info )
178 CALL chkxer(
'SGEQRS', infot, nout, lerr, ok )
179 infot = 2
180 CALL sgeqrs( 0, -1, 0, a, 1, x, b, 1, w, 1, info )
181 CALL chkxer(
'SGEQRS', infot, nout, lerr, ok )
182 infot = 2
183 CALL sgeqrs( 1, 2, 0, a, 2, x, b, 2, w, 1, info )
184 CALL chkxer(
'SGEQRS', infot, nout, lerr, ok )
185 infot = 3
186 CALL sgeqrs( 0, 0, -1, a, 1, x, b, 1, w, 1, info )
187 CALL chkxer(
'SGEQRS', infot, nout, lerr, ok )
188 infot = 5
189 CALL sgeqrs( 2, 1, 0, a, 1, x, b, 2, w, 1, info )
190 CALL chkxer(
'SGEQRS', infot, nout, lerr, ok )
191 infot = 8
192 CALL sgeqrs( 2, 1, 0, a, 2, x, b, 1, w, 1, info )
193 CALL chkxer(
'SGEQRS', infot, nout, lerr, ok )
194 infot = 10
195 CALL sgeqrs( 1, 1, 2, a, 1, x, b, 1, w, 1, info )
196 CALL chkxer(
'SGEQRS', infot, nout, lerr, ok )
197
198
199
200 srnamt = 'SORGQR'
201 infot = 1
202 CALL sorgqr( -1, 0, 0, a, 1, x, w, 1, info )
203 CALL chkxer(
'SORGQR', infot, nout, lerr, ok )
204 infot = 2
205 CALL sorgqr( 0, -1, 0, a, 1, x, w, 1, info )
206 CALL chkxer(
'SORGQR', infot, nout, lerr, ok )
207 infot = 2
208 CALL sorgqr( 1, 2, 0, a, 1, x, w, 2, info )
209 CALL chkxer(
'SORGQR', infot, nout, lerr, ok )
210 infot = 3
211 CALL sorgqr( 0, 0, -1, a, 1, x, w, 1, info )
212 CALL chkxer(
'SORGQR', infot, nout, lerr, ok )
213 infot = 3
214 CALL sorgqr( 1, 1, 2, a, 1, x, w, 1, info )
215 CALL chkxer(
'SORGQR', infot, nout, lerr, ok )
216 infot = 5
217 CALL sorgqr( 2, 2, 0, a, 1, x, w, 2, info )
218 CALL chkxer(
'SORGQR', infot, nout, lerr, ok )
219 infot = 8
220 CALL sorgqr( 2, 2, 0, a, 2, x, w, 1, info )
221 CALL chkxer(
'SORGQR', infot, nout, lerr, ok )
222
223
224
225 srnamt = 'SORG2R'
226 infot = 1
227 CALL sorg2r( -1, 0, 0, a, 1, x, w, info )
228 CALL chkxer(
'SORG2R', infot, nout, lerr, ok )
229 infot = 2
230 CALL sorg2r( 0, -1, 0, a, 1, x, w, info )
231 CALL chkxer(
'SORG2R', infot, nout, lerr, ok )
232 infot = 2
233 CALL sorg2r( 1, 2, 0, a, 1, x, w, info )
234 CALL chkxer(
'SORG2R', infot, nout, lerr, ok )
235 infot = 3
236 CALL sorg2r( 0, 0, -1, a, 1, x, w, info )
237 CALL chkxer(
'SORG2R', infot, nout, lerr, ok )
238 infot = 3
239 CALL sorg2r( 2, 1, 2, a, 2, x, w, info )
240 CALL chkxer(
'SORG2R', infot, nout, lerr, ok )
241 infot = 5
242 CALL sorg2r( 2, 1, 0, a, 1, x, w, info )
243 CALL chkxer(
'SORG2R', infot, nout, lerr, ok )
244
245
246
247 srnamt = 'SORMQR'
248 infot = 1
249 CALL sormqr(
'/',
'N', 0, 0, 0, a, 1, x, af, 1, w, 1, info )
250 CALL chkxer(
'SORMQR', infot, nout, lerr, ok )
251 infot = 2
252 CALL sormqr(
'L',
'/', 0, 0, 0, a, 1, x, af, 1, w, 1, info )
253 CALL chkxer(
'SORMQR', infot, nout, lerr, ok )
254 infot = 3
255 CALL sormqr(
'L',
'N', -1, 0, 0, a, 1, x, af, 1, w, 1, info )
256 CALL chkxer(
'SORMQR', infot, nout, lerr, ok )
257 infot = 4
258 CALL sormqr(
'L',
'N', 0, -1, 0, a, 1, x, af, 1, w, 1, info )
259 CALL chkxer(
'SORMQR', infot, nout, lerr, ok )
260 infot = 5
261 CALL sormqr(
'L',
'N', 0, 0, -1, a, 1, x, af, 1, w, 1, info )
262 CALL chkxer(
'SORMQR', infot, nout, lerr, ok )
263 infot = 5
264 CALL sormqr(
'L',
'N', 0, 1, 1, a, 1, x, af, 1, w, 1, info )
265 CALL chkxer(
'SORMQR', infot, nout, lerr, ok )
266 infot = 5
267 CALL sormqr(
'R',
'N', 1, 0, 1, a, 1, x, af, 1, w, 1, info )
268 CALL chkxer(
'SORMQR', infot, nout, lerr, ok )
269 infot = 7
270 CALL sormqr(
'L',
'N', 2, 1, 0, a, 1, x, af, 2, w, 1, info )
271 CALL chkxer(
'SORMQR', infot, nout, lerr, ok )
272 infot = 7
273 CALL sormqr(
'R',
'N', 1, 2, 0, a, 1, x, af, 1, w, 1, info )
274 CALL chkxer(
'SORMQR', infot, nout, lerr, ok )
275 infot = 10
276 CALL sormqr(
'L',
'N', 2, 1, 0, a, 2, x, af, 1, w, 1, info )
277 CALL chkxer(
'SORMQR', infot, nout, lerr, ok )
278 infot = 12
279 CALL sormqr(
'L',
'N', 1, 2, 0, a, 1, x, af, 1, w, 1, info )
280 CALL chkxer(
'SORMQR', infot, nout, lerr, ok )
281 infot = 12
282 CALL sormqr(
'R',
'N', 2, 1, 0, a, 1, x, af, 2, w, 1, info )
283 CALL chkxer(
'SORMQR', infot, nout, lerr, ok )
284
285
286
287 srnamt = 'SORM2R'
288 infot = 1
289 CALL sorm2r(
'/',
'N', 0, 0, 0, a, 1, x, af, 1, w, info )
290 CALL chkxer(
'SORM2R', infot, nout, lerr, ok )
291 infot = 2
292 CALL sorm2r(
'L',
'/', 0, 0, 0, a, 1, x, af, 1, w, info )
293 CALL chkxer(
'SORM2R', infot, nout, lerr, ok )
294 infot = 3
295 CALL sorm2r(
'L',
'N', -1, 0, 0, a, 1, x, af, 1, w, info )
296 CALL chkxer(
'SORM2R', infot, nout, lerr, ok )
297 infot = 4
298 CALL sorm2r(
'L',
'N', 0, -1, 0, a, 1, x, af, 1, w, info )
299 CALL chkxer(
'SORM2R', infot, nout, lerr, ok )
300 infot = 5
301 CALL sorm2r(
'L',
'N', 0, 0, -1, a, 1, x, af, 1, w, info )
302 CALL chkxer(
'SORM2R', infot, nout, lerr, ok )
303 infot = 5
304 CALL sorm2r(
'L',
'N', 0, 1, 1, a, 1, x, af, 1, w, info )
305 CALL chkxer(
'SORM2R', infot, nout, lerr, ok )
306 infot = 5
307 CALL sorm2r(
'R',
'N', 1, 0, 1, a, 1, x, af, 1, w, info )
308 CALL chkxer(
'SORM2R', infot, nout, lerr, ok )
309 infot = 7
310 CALL sorm2r(
'L',
'N', 2, 1, 0, a, 1, x, af, 2, w, info )
311 CALL chkxer(
'SORM2R', infot, nout, lerr, ok )
312 infot = 7
313 CALL sorm2r(
'R',
'N', 1, 2, 0, a, 1, x, af, 1, w, info )
314 CALL chkxer(
'SORM2R', infot, nout, lerr, ok )
315 infot = 10
316 CALL sorm2r(
'L',
'N', 2, 1, 0, a, 2, x, af, 1, w, info )
317 CALL chkxer(
'SORM2R', infot, nout, lerr, ok )
318
319
320
321 CALL alaesm( path, ok, nout )
322
323 RETURN
324
325
326
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
subroutine alaesm(PATH, OK, NOUT)
ALAESM
subroutine sgeqrfp(M, N, A, LDA, TAU, WORK, LWORK, INFO)
SGEQRFP
subroutine sgeqrf(M, N, A, LDA, TAU, WORK, LWORK, INFO)
SGEQRF
subroutine sgeqr2p(M, N, A, LDA, TAU, WORK, INFO)
SGEQR2P computes the QR factorization of a general rectangular matrix with non-negative diagonal elem...
subroutine sgeqr2(M, N, A, LDA, TAU, WORK, INFO)
SGEQR2 computes the QR factorization of a general rectangular matrix using an unblocked algorithm.
subroutine sorm2r(SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, INFO)
SORM2R multiplies a general matrix by the orthogonal matrix from a QR factorization determined by sge...
subroutine sorg2r(M, N, K, A, LDA, TAU, WORK, INFO)
SORG2R generates all or part of the orthogonal matrix Q from a QR factorization determined by sgeqrf ...
subroutine sorgqr(M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
SORGQR
subroutine sormqr(SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
SORMQR
subroutine sgeqrs(M, N, NRHS, A, LDA, TAU, B, LDB, WORK, LWORK, INFO)
SGEQRS