90
91
92
93
94
95
96 CHARACTER*3 PATH
97 INTEGER IOUNIT
98
99
100
101
102
103 LOGICAL CORZ, SORD
104 CHARACTER C1, C3
105 CHARACTER*2 P2
106 CHARACTER*9 SYM
107
108
109 LOGICAL LSAME, LSAMEN
111
112
113
114 IF( iounit.LE.0 )
115 $ RETURN
116 c1 = path( 1: 1 )
117 c3 = path( 3: 3 )
118 p2 = path( 2: 3 )
121 IF( .NOT.( sord .OR. corz ) )
122 $ RETURN
123
124 IF(
lsamen( 2, p2,
'GE' ) )
THEN
125
126
127
128 WRITE( iounit, fmt = 9999 )path
129 WRITE( iounit, fmt = '( '' Matrix types:'' )' )
130 WRITE( iounit, fmt = 9989 )
131 WRITE( iounit, fmt = '( '' Test ratios:'' )' )
132 WRITE( iounit, fmt = 9981 )1
133 WRITE( iounit, fmt = 9980 )2
134 WRITE( iounit, fmt = 9979 )3
135 WRITE( iounit, fmt = 9978 )4
136 WRITE( iounit, fmt = 9977 )5
137 WRITE( iounit, fmt = 9976 )6
138 WRITE( iounit, fmt = 9972 )7
139 WRITE( iounit, fmt = '( '' Messages:'' )' )
140
141 ELSE IF(
lsamen( 2, p2,
'GB' ) )
THEN
142
143
144
145 WRITE( iounit, fmt = 9998 )path
146 WRITE( iounit, fmt = '( '' Matrix types:'' )' )
147 WRITE( iounit, fmt = 9988 )
148 WRITE( iounit, fmt = '( '' Test ratios:'' )' )
149 WRITE( iounit, fmt = 9981 )1
150 WRITE( iounit, fmt = 9980 )2
151 WRITE( iounit, fmt = 9979 )3
152 WRITE( iounit, fmt = 9978 )4
153 WRITE( iounit, fmt = 9977 )5
154 WRITE( iounit, fmt = 9976 )6
155 WRITE( iounit, fmt = 9972 )7
156 WRITE( iounit, fmt = '( '' Messages:'' )' )
157
158 ELSE IF(
lsamen( 2, p2,
'GT' ) )
THEN
159
160
161
162 WRITE( iounit, fmt = 9997 )path
163 WRITE( iounit, fmt = 9987 )
164 WRITE( iounit, fmt = '( '' Test ratios:'' )' )
165 WRITE( iounit, fmt = 9981 )1
166 WRITE( iounit, fmt = 9980 )2
167 WRITE( iounit, fmt = 9979 )3
168 WRITE( iounit, fmt = 9978 )4
169 WRITE( iounit, fmt = 9977 )5
170 WRITE( iounit, fmt = 9976 )6
171 WRITE( iounit, fmt = '( '' Messages:'' )' )
172
173 ELSE IF(
lsamen( 2, p2,
'PO' ) .OR.
lsamen( 2, p2,
'PP' )
174 $ .OR.
lsamen( 2, p2,
'PS' ) )
THEN
175
176
177
178
179
180 IF( sord ) THEN
181 sym = 'Symmetric'
182 ELSE
183 sym = 'Hermitian'
184 END IF
185 IF(
lsame( c3,
'O' ) )
THEN
186 WRITE( iounit, fmt = 9996 )path, sym
187 ELSE
188 WRITE( iounit, fmt = 9995 )path, sym
189 END IF
190 WRITE( iounit, fmt = '( '' Matrix types:'' )' )
191 WRITE( iounit, fmt = 9985 )path
192 WRITE( iounit, fmt = '( '' Test ratios:'' )' )
193 WRITE( iounit, fmt = 9975 )1
194 WRITE( iounit, fmt = 9980 )2
195 WRITE( iounit, fmt = 9979 )3
196 WRITE( iounit, fmt = 9978 )4
197 WRITE( iounit, fmt = 9977 )5
198 WRITE( iounit, fmt = 9976 )6
199 WRITE( iounit, fmt = '( '' Messages:'' )' )
200
201 ELSE IF(
lsamen( 2, p2,
'PB' ) )
THEN
202
203
204
205 IF( sord ) THEN
206 WRITE( iounit, fmt = 9994 )path, 'Symmetric'
207 ELSE
208 WRITE( iounit, fmt = 9994 )path, 'Hermitian'
209 END IF
210 WRITE( iounit, fmt = '( '' Matrix types:'' )' )
211 WRITE( iounit, fmt = 9984 )path
212 WRITE( iounit, fmt = '( '' Test ratios:'' )' )
213 WRITE( iounit, fmt = 9975 )1
214 WRITE( iounit, fmt = 9980 )2
215 WRITE( iounit, fmt = 9979 )3
216 WRITE( iounit, fmt = 9978 )4
217 WRITE( iounit, fmt = 9977 )5
218 WRITE( iounit, fmt = 9976 )6
219 WRITE( iounit, fmt = '( '' Messages:'' )' )
220
221 ELSE IF(
lsamen( 2, p2,
'PT' ) )
THEN
222
223
224
225 IF( sord ) THEN
226 WRITE( iounit, fmt = 9993 )path, 'Symmetric'
227 ELSE
228 WRITE( iounit, fmt = 9993 )path, 'Hermitian'
229 END IF
230 WRITE( iounit, fmt = 9986 )
231 WRITE( iounit, fmt = '( '' Test ratios:'' )' )
232 WRITE( iounit, fmt = 9973 )1
233 WRITE( iounit, fmt = 9980 )2
234 WRITE( iounit, fmt = 9979 )3
235 WRITE( iounit, fmt = 9978 )4
236 WRITE( iounit, fmt = 9977 )5
237 WRITE( iounit, fmt = 9976 )6
238 WRITE( iounit, fmt = '( '' Messages:'' )' )
239
240 ELSE IF(
lsamen( 2, p2,
'SY' ) .OR.
lsamen( 2, p2,
'SP' ) )
THEN
241
242
243
244
245
246
247 IF(
lsame( c3,
'Y' ) )
THEN
248 WRITE( iounit, fmt = 9992 )path, 'Symmetric'
249 ELSE
250 WRITE( iounit, fmt = 9991 )path, 'Symmetric'
251 END IF
252 WRITE( iounit, fmt = '( '' Matrix types:'' )' )
253 IF( sord ) THEN
254 WRITE( iounit, fmt = 9983 )
255 ELSE
256 WRITE( iounit, fmt = 9982 )
257 END IF
258 WRITE( iounit, fmt = '( '' Test ratios:'' )' )
259 WRITE( iounit, fmt = 9974 )1
260 WRITE( iounit, fmt = 9980 )2
261 WRITE( iounit, fmt = 9979 )3
262 WRITE( iounit, fmt = 9977 )4
263 WRITE( iounit, fmt = 9978 )5
264 WRITE( iounit, fmt = 9976 )6
265 WRITE( iounit, fmt = '( '' Messages:'' )' )
266
267 ELSE IF(
lsamen( 2, p2,
'SR' ) .OR.
lsamen( 2, p2,
'SK') )
THEN
268
269
270
271
272
273
274
275
276
277
278 WRITE( iounit, fmt = 9992 )path, 'Symmetric'
279
280 WRITE( iounit, fmt = '( '' Matrix types:'' )' )
281 IF( sord ) THEN
282 WRITE( iounit, fmt = 9983 )
283 ELSE
284 WRITE( iounit, fmt = 9982 )
285 END IF
286
287 WRITE( iounit, fmt = '( '' Test ratios:'' )' )
288 WRITE( iounit, fmt = 9974 )1
289 WRITE( iounit, fmt = 9980 )2
290 WRITE( iounit, fmt = 9979 )3
291 WRITE( iounit, fmt = '( '' Messages:'' )' )
292
293 ELSE IF(
lsamen( 2, p2,
'HA' ) )
THEN
294
295
296
297 WRITE( iounit, fmt = 9971 )path, 'Hermitian'
298
299 WRITE( iounit, fmt = '( '' Matrix types:'' )' )
300 WRITE( iounit, fmt = 9983 )
301
302 WRITE( iounit, fmt = '( '' Test ratios:'' )' )
303 WRITE( iounit, fmt = 9974 )1
304 WRITE( iounit, fmt = 9980 )2
305 WRITE( iounit, fmt = 9979 )3
306 WRITE( iounit, fmt = 9977 )4
307 WRITE( iounit, fmt = 9978 )5
308 WRITE( iounit, fmt = 9976 )6
309 WRITE( iounit, fmt = '( '' Messages:'' )' )
310
311
312 ELSE IF(
lsamen( 2, p2,
'HE' ) .OR.
313 $
lsamen( 2, p2,
'HP' ) )
THEN
314
315
316
317
318
319
320 IF(
lsame( c3,
'E' ) )
THEN
321 WRITE( iounit, fmt = 9992 )path, 'Hermitian'
322 ELSE
323 WRITE( iounit, fmt = 9991 )path, 'Hermitian'
324 END IF
325
326 WRITE( iounit, fmt = '( '' Matrix types:'' )' )
327 WRITE( iounit, fmt = 9983 )
328
329 WRITE( iounit, fmt = '( '' Test ratios:'' )' )
330 WRITE( iounit, fmt = 9974 )1
331 WRITE( iounit, fmt = 9980 )2
332 WRITE( iounit, fmt = 9979 )3
333 WRITE( iounit, fmt = 9977 )4
334 WRITE( iounit, fmt = 9978 )5
335 WRITE( iounit, fmt = 9976 )6
336 WRITE( iounit, fmt = '( '' Messages:'' )' )
337
338 ELSE IF(
lsamen( 2, p2,
'HR' ) .OR.
lsamen( 2, p2,
'HK' ) )
THEN
339
340
341
342
343
344
345
346
347
348
349 WRITE( iounit, fmt = 9992 )path, 'Hermitian'
350
351 WRITE( iounit, fmt = '( '' Matrix types:'' )' )
352 WRITE( iounit, fmt = 9983 )
353
354 WRITE( iounit, fmt = '( '' Test ratios:'' )' )
355 WRITE( iounit, fmt = 9974 )1
356 WRITE( iounit, fmt = 9980 )2
357 WRITE( iounit, fmt = 9979 )3
358 WRITE( iounit, fmt = '( '' Messages:'' )' )
359
360 ELSE
361
362
363
364 WRITE( iounit, fmt = 9990 )path
365 END IF
366
367
368
369 9999 FORMAT( / 1x, a3, ' drivers: General dense matrices' )
370 9998 FORMAT( / 1x, a3, ' drivers: General band matrices' )
371 9997 FORMAT( / 1x, a3, ' drivers: General tridiagonal' )
372 9996 FORMAT( / 1x, a3, ' drivers: ', a9,
373 $ ' positive definite matrices' )
374 9995 FORMAT( / 1x, a3, ' drivers: ', a9,
375 $ ' positive definite packed matrices' )
376 9994 FORMAT( / 1x, a3, ' drivers: ', a9,
377 $ ' positive definite band matrices' )
378 9993 FORMAT( / 1x, a3, ' drivers: ', a9,
379 $ ' positive definite tridiagonal' )
380 9971 FORMAT( / 1x, a3, ' drivers: ', a9, ' indefinite matrices',
381 $ ', "Aasen" Algorithm' )
382 9992 FORMAT( / 1x, a3, ' drivers: ', a9, ' indefinite matrices',
383 $ ', "rook" (bounded Bunch-Kaufman) pivoting' )
384 9991 FORMAT( / 1x, a3, ' drivers: ', a9,
385 $ ' indefinite packed matrices',
386 $ ', partial (Bunch-Kaufman) pivoting' )
387 9891 FORMAT( / 1x, a3, ' drivers: ', a9,
388 $ ' indefinite packed matrices',
389 $ ', "rook" (bounded Bunch-Kaufman) pivoting' )
390 9990 FORMAT( / 1x, a3, ': No header available' )
391
392
393
394 9989 FORMAT( 4x, '1. Diagonal', 24x, '7. Last n/2 columns zero', / 4x,
395 $ '2. Upper triangular', 16x,
396 $ '8. Random, CNDNUM = sqrt(0.1/EPS)', / 4x,
397 $ '3. Lower triangular', 16x, '9. Random, CNDNUM = 0.1/EPS',
398 $ / 4x, '4. Random, CNDNUM = 2', 13x,
399 $ '10. Scaled near underflow', / 4x, '5. First column zero',
400 $ 14x, '11. Scaled near overflow', / 4x,
401 $ '6. Last column zero' )
402
403
404
405 9988 FORMAT( 4x, '1. Random, CNDNUM = 2', 14x,
406 $ '5. Random, CNDNUM = sqrt(0.1/EPS)', / 4x,
407 $ '2. First column zero', 15x, '6. Random, CNDNUM = 0.1/EPS',
408 $ / 4x, '3. Last column zero', 16x,
409 $ '7. Scaled near underflow', / 4x,
410 $ '4. Last n/2 columns zero', 11x, '8. Scaled near overflow' )
411
412
413
414 9987 FORMAT( ' Matrix types (1-6 have specified condition numbers):',
415 $ / 4x, '1. Diagonal', 24x, '7. Random, unspecified CNDNUM',
416 $ / 4x, '2. Random, CNDNUM = 2', 14x, '8. First column zero',
417 $ / 4x, '3. Random, CNDNUM = sqrt(0.1/EPS)', 2x,
418 $ '9. Last column zero', / 4x, '4. Random, CNDNUM = 0.1/EPS',
419 $ 7x, '10. Last n/2 columns zero', / 4x,
420 $ '5. Scaled near underflow', 10x,
421 $ '11. Scaled near underflow', / 4x,
422 $ '6. Scaled near overflow', 11x, '12. Scaled near overflow' )
423
424
425
426 9986 FORMAT( ' Matrix types (1-6 have specified condition numbers):',
427 $ / 4x, '1. Diagonal', 24x, '7. Random, unspecified CNDNUM',
428 $ / 4x, '2. Random, CNDNUM = 2', 14x,
429 $ '8. First row and column zero', / 4x,
430 $ '3. Random, CNDNUM = sqrt(0.1/EPS)', 2x,
431 $ '9. Last row and column zero', / 4x,
432 $ '4. Random, CNDNUM = 0.1/EPS', 7x,
433 $ '10. Middle row and column zero', / 4x,
434 $ '5. Scaled near underflow', 10x,
435 $ '11. Scaled near underflow', / 4x,
436 $ '6. Scaled near overflow', 11x, '12. Scaled near overflow' )
437
438
439
440 9985 FORMAT( 4x, '1. Diagonal', 24x,
441 $ '6. Random, CNDNUM = sqrt(0.1/EPS)', / 4x,
442 $ '2. Random, CNDNUM = 2', 14x, '7. Random, CNDNUM = 0.1/EPS',
443 $ / 3x, '*3. First row and column zero', 7x,
444 $ '8. Scaled near underflow', / 3x,
445 $ '*4. Last row and column zero', 8x,
446 $ '9. Scaled near overflow', / 3x,
447 $ '*5. Middle row and column zero', / 3x,
448 $ '(* - tests error exits from ', a3,
449 $ 'TRF, no test ratios are computed)' )
450
451
452
453 9984 FORMAT( 4x, '1. Random, CNDNUM = 2', 14x,
454 $ '5. Random, CNDNUM = sqrt(0.1/EPS)', / 3x,
455 $ '*2. First row and column zero', 7x,
456 $ '6. Random, CNDNUM = 0.1/EPS', / 3x,
457 $ '*3. Last row and column zero', 8x,
458 $ '7. Scaled near underflow', / 3x,
459 $ '*4. Middle row and column zero', 6x,
460 $ '8. Scaled near overflow', / 3x,
461 $ '(* - tests error exits from ', a3,
462 $ 'TRF, no test ratios are computed)' )
463
464
465
466 9983 FORMAT( 4x, '1. Diagonal', 24x,
467 $ '6. Last n/2 rows and columns zero', / 4x,
468 $ '2. Random, CNDNUM = 2', 14x,
469 $ '7. Random, CNDNUM = sqrt(0.1/EPS)', / 4x,
470 $ '3. First row and column zero', 7x,
471 $ '8. Random, CNDNUM = 0.1/EPS', / 4x,
472 $ '4. Last row and column zero', 8x,
473 $ '9. Scaled near underflow', / 4x,
474 $ '5. Middle row and column zero', 5x,
475 $ '10. Scaled near overflow' )
476
477
478
479 9982 FORMAT( 4x, '1. Diagonal', 24x,
480 $ '7. Random, CNDNUM = sqrt(0.1/EPS)', / 4x,
481 $ '2. Random, CNDNUM = 2', 14x, '8. Random, CNDNUM = 0.1/EPS',
482 $ / 4x, '3. First row and column zero', 7x,
483 $ '9. Scaled near underflow', / 4x,
484 $ '4. Last row and column zero', 7x,
485 $ '10. Scaled near overflow', / 4x,
486 $ '5. Middle row and column zero', 5x,
487 $ '11. Block diagonal matrix', / 4x,
488 $ '6. Last n/2 rows and columns zero' )
489
490
491
492 9981 FORMAT( 3x, i2, ': norm( L * U - A ) / ( N * norm(A) * EPS )' )
493 9980 FORMAT( 3x, i2, ': norm( B - A * X ) / ',
494 $ '( norm(A) * norm(X) * EPS )' )
495 9979 FORMAT( 3x, i2, ': norm( X - XACT ) / ',
496 $ '( norm(XACT) * CNDNUM * EPS )' )
497 9978 FORMAT( 3x, i2, ': norm( X - XACT ) / ',
498 $ '( norm(XACT) * (error bound) )' )
499 9977 FORMAT( 3x, i2, ': (backward error) / EPS' )
500 9976 FORMAT( 3x, i2, ': RCOND * CNDNUM - 1.0' )
501 9975 FORMAT( 3x, i2, ': norm( U'' * U - A ) / ( N * norm(A) * EPS )',
502 $ ', or', / 7x, 'norm( L * L'' - A ) / ( N * norm(A) * EPS )'
503 $ )
504 9974 FORMAT( 3x, i2, ': norm( U*D*U'' - A ) / ( N * norm(A) * EPS )',
505 $ ', or', / 7x, 'norm( L*D*L'' - A ) / ( N * norm(A) * EPS )'
506 $ )
507 9973 FORMAT( 3x, i2, ': norm( U''*D*U - A ) / ( N * norm(A) * EPS )',
508 $ ', or', / 7x, 'norm( L*D*L'' - A ) / ( N * norm(A) * EPS )'
509 $ )
510 9972 FORMAT( 3x, i2, ': abs( WORK(1) - RPVGRW ) /',
511 $ ' ( max( WORK(1), RPVGRW ) * EPS )' )
512
513 RETURN
514
515
516
logical function lsame(ca, cb)
LSAME
logical function lsamen(n, ca, cb)
LSAMEN