61 DOUBLE PRECISION THRESH
67 DOUBLE PRECISION ZERO, ONE, TEN
68 parameter( zero = 0.0d0, one = 1.0d+0, ten = 1.0d1 )
70 parameter( nsz = 5, nszb = 3*nsz-2 )
72 parameter( nszp = ( nsz*( nsz+1 ) ) / 2,
78 INTEGER I, INFO, J, KL, KU, M, N
79 DOUBLE PRECISION CCOND, EPS, NORM, RATIO, RCMAX, RCMIN, RCOND
82 DOUBLE PRECISION A( NSZ, NSZ ), AB( NSZB, NSZ ), AP( NSZP ),
83 $ C( NSZ ), POW( NPOW ), R( NSZ ), RESLTS( 5 ),
87 DOUBLE PRECISION DLAMCH
94 INTRINSIC abs, max, min
98 path( 1: 1 ) =
'Double precision'
106 pow( i ) = ten**( i-1 )
107 rpow( i ) = one / pow( i )
117 IF( i.LE.m .AND. j.LE.n )
THEN
118 a( i, j ) = pow( i+j+1 )*( -1 )**( i+j )
125 CALL dgeequ( m, n, a, nsz, r, c, rcond, ccond, norm, info )
130 IF( n.NE.0 .AND. m.NE.0 )
THEN
131 reslts( 1 ) = max( reslts( 1 ),
132 $ abs( ( rcond-rpow( m ) ) / rpow( m ) ) )
133 reslts( 1 ) = max( reslts( 1 ),
134 $ abs( ( ccond-rpow( n ) ) / rpow( n ) ) )
135 reslts( 1 ) = max( reslts( 1 ),
136 $ abs( ( norm-pow( n+m+1 ) ) / pow( n+m+
139 reslts( 1 ) = max( reslts( 1 ),
140 $ abs( ( r( i )-rpow( i+n+1 ) ) /
144 reslts( 1 ) = max( reslts( 1 ),
145 $ abs( ( c( j )-pow( n-j+1 ) ) /
157 a( max( nsz-1, 1 ), j ) = zero
159 CALL dgeequ( nsz, nsz, a, nsz, r, c, rcond, ccond, norm, info )
160 IF( info.NE.max( nsz-1, 1 ) )
164 a( max( nsz-1, 1 ), j ) = one
167 a( i, max( nsz-1, 1 ) ) = zero
169 CALL dgeequ( nsz, nsz, a, nsz, r, c, rcond, ccond, norm, info )
170 IF( info.NE.nsz+max( nsz-1, 1 ) )
172 reslts( 1 ) = reslts( 1 ) / eps
178 DO 230 kl = 0, max( m-1, 0 )
179 DO 220 ku = 0, max( n-1, 0 )
188 IF( i.LE.min( m, j+kl ) .AND. i.GE.
189 $ max( 1, j-ku ) .AND. j.LE.n )
THEN
190 ab( ku+1+i-j, j ) = pow( i+j+1 )*
196 CALL dgbequ( m, n, kl, ku, ab, nszb, r, c, rcond,
197 $ ccond, norm, info )
200 IF( .NOT.( ( n+kl.LT.m .AND. info.EQ.n+kl+1 ) .OR.
201 $ ( m+ku.LT.n .AND. info.EQ.2*m+ku+1 ) ) )
THEN
205 IF( n.NE.0 .AND. m.NE.0 )
THEN
210 rcmin = min( rcmin, r( i ) )
211 rcmax = max( rcmax, r( i ) )
213 ratio = rcmin / rcmax
214 reslts( 2 ) = max( reslts( 2 ),
215 $ abs( ( rcond-ratio ) / ratio ) )
220 rcmin = min( rcmin, c( j ) )
221 rcmax = max( rcmax, c( j ) )
223 ratio = rcmin / rcmax
224 reslts( 2 ) = max( reslts( 2 ),
225 $ abs( ( ccond-ratio ) / ratio ) )
227 reslts( 2 ) = max( reslts( 2 ),
228 $ abs( ( norm-pow( n+m+1 ) ) /
233 IF( i.LE.j+kl .AND. i.GE.j-ku )
THEN
234 ratio = abs( r( i )*pow( i+j+1 )*
236 rcmax = max( rcmax, ratio )
239 reslts( 2 ) = max( reslts( 2 ),
246 IF( i.LE.j+kl .AND. i.GE.j-ku )
THEN
247 ratio = abs( r( i )*pow( i+j+1 )*
249 rcmax = max( rcmax, ratio )
252 reslts( 2 ) = max( reslts( 2 ),
262 reslts( 2 ) = reslts( 2 ) / eps
270 IF( i.LE.n .AND. j.EQ.i )
THEN
271 a( i, j ) = pow( i+j+1 )*( -1 )**( i+j )
278 CALL dpoequ( n, a, nsz, r, rcond, norm, info )
284 reslts( 3 ) = max( reslts( 3 ),
285 $ abs( ( rcond-rpow( n ) ) / rpow( n ) ) )
286 reslts( 3 ) = max( reslts( 3 ),
287 $ abs( ( norm-pow( 2*n+1 ) ) / pow( 2*n+
290 reslts( 3 ) = max( reslts( 3 ),
291 $ abs( ( r( i )-rpow( i+1 ) ) / rpow( i+
297 a( max( nsz-1, 1 ), max( nsz-1, 1 ) ) = -one
298 CALL dpoequ( nsz, a, nsz, r, rcond, norm, info )
299 IF( info.NE.max( nsz-1, 1 ) )
301 reslts( 3 ) = reslts( 3 ) / eps
309 DO 300 i = 1, ( n*( n+1 ) ) / 2
313 ap( ( i*( i+1 ) ) / 2 ) = pow( 2*i+1 )
316 CALL dppequ(
'U', n, ap, r, rcond, norm, info )
322 reslts( 4 ) = max( reslts( 4 ),
323 $ abs( ( rcond-rpow( n ) ) / rpow( n ) ) )
324 reslts( 4 ) = max( reslts( 4 ),
325 $ abs( ( norm-pow( 2*n+1 ) ) / pow( 2*n+
328 reslts( 4 ) = max( reslts( 4 ),
329 $ abs( ( r( i )-rpow( i+1 ) ) / rpow( i+
337 DO 330 i = 1, ( n*( n+1 ) ) / 2
342 ap( j ) = pow( 2*i+1 )
346 CALL dppequ(
'L', n, ap, r, rcond, norm, info )
352 reslts( 4 ) = max( reslts( 4 ),
353 $ abs( ( rcond-rpow( n ) ) / rpow( n ) ) )
354 reslts( 4 ) = max( reslts( 4 ),
355 $ abs( ( norm-pow( 2*n+1 ) ) / pow( 2*n+
358 reslts( 4 ) = max( reslts( 4 ),
359 $ abs( ( r( i )-rpow( i+1 ) ) / rpow( i+
366 i = ( nsz*( nsz+1 ) ) / 2 - 2
368 CALL dppequ(
'L', nsz, ap, r, rcond, norm, info )
369 IF( info.NE.max( nsz-1, 1 ) )
371 reslts( 4 ) = reslts( 4 ) / eps
376 DO 450 kl = 0, max( n-1, 0 )
386 ab( kl+1, j ) = pow( 2*j+1 )
389 CALL dpbequ(
'U', n, kl, ab, nszb, r, rcond, norm, info )
395 reslts( 5 ) = max( reslts( 5 ),
396 $ abs( ( rcond-rpow( n ) ) / rpow( n ) ) )
397 reslts( 5 ) = max( reslts( 5 ),
398 $ abs( ( norm-pow( 2*n+1 ) ) / pow( 2*n+
401 reslts( 5 ) = max( reslts( 5 ),
402 $ abs( ( r( i )-rpow( i+1 ) ) /
408 ab( kl+1, max( n-1, 1 ) ) = -one
409 CALL dpbequ(
'U', n, kl, ab, nszb, r, rcond, norm, info )
410 IF( info.NE.max( n-1, 1 ) )
422 ab( 1, j ) = pow( 2*j+1 )
425 CALL dpbequ(
'L', n, kl, ab, nszb, r, rcond, norm, info )
431 reslts( 5 ) = max( reslts( 5 ),
432 $ abs( ( rcond-rpow( n ) ) / rpow( n ) ) )
433 reslts( 5 ) = max( reslts( 5 ),
434 $ abs( ( norm-pow( 2*n+1 ) ) / pow( 2*n+
437 reslts( 5 ) = max( reslts( 5 ),
438 $ abs( ( r( i )-rpow( i+1 ) ) /
444 ab( 1, max( n-1, 1 ) ) = -one
445 CALL dpbequ(
'L', n, kl, ab, nszb, r, rcond, norm, info )
446 IF( info.NE.max( n-1, 1 ) )
451 reslts( 5 ) = reslts( 5 ) / eps
452 ok = ( reslts( 1 ).LE.thresh ) .AND.
453 $ ( reslts( 2 ).LE.thresh ) .AND.
454 $ ( reslts( 3 ).LE.thresh ) .AND.
455 $ ( reslts( 4 ).LE.thresh ) .AND. ( reslts( 5 ).LE.thresh )
456 WRITE( nout, fmt = * )
458 WRITE( nout, fmt = 9999 )path
460 IF( reslts( 1 ).GT.thresh )
461 $
WRITE( nout, fmt = 9998 )reslts( 1 ), thresh
462 IF( reslts( 2 ).GT.thresh )
463 $
WRITE( nout, fmt = 9997 )reslts( 2 ), thresh
464 IF( reslts( 3 ).GT.thresh )
465 $
WRITE( nout, fmt = 9996 )reslts( 3 ), thresh
466 IF( reslts( 4 ).GT.thresh )
467 $
WRITE( nout, fmt = 9995 )reslts( 4 ), thresh
468 IF( reslts( 5 ).GT.thresh )
469 $
WRITE( nout, fmt = 9994 )reslts( 5 ), thresh
471 9999
FORMAT( 1x,
'All tests for ', a3,
472 $
' routines passed the threshold' )
473 9998
FORMAT(
' DGEEQU failed test with value ', d10.3,
' exceeding',
474 $
' threshold ', d10.3 )
475 9997
FORMAT(
' DGBEQU failed test with value ', d10.3,
' exceeding',
476 $
' threshold ', d10.3 )
477 9996
FORMAT(
' DPOEQU failed test with value ', d10.3,
' exceeding',
478 $
' threshold ', d10.3 )
479 9995
FORMAT(
' DPPEQU failed test with value ', d10.3,
' exceeding',
480 $
' threshold ', d10.3 )
481 9994
FORMAT(
' DPBEQU failed test with value ', d10.3,
' exceeding',
482 $
' threshold ', d10.3 )
subroutine dchkeq(THRESH, NOUT)
DCHKEQ
subroutine dgbequ(M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND, AMAX, INFO)
DGBEQU
subroutine dgeequ(M, N, A, LDA, R, C, ROWCND, COLCND, AMAX, INFO)
DGEEQU
subroutine dppequ(UPLO, N, AP, S, SCOND, AMAX, INFO)
DPPEQU
subroutine dpbequ(UPLO, N, KD, AB, LDAB, S, SCOND, AMAX, INFO)
DPBEQU
subroutine dpoequ(N, A, LDA, S, SCOND, AMAX, INFO)
DPOEQU