55 SUBROUTINE zchkeq( THRESH, NOUT )
64 DOUBLE PRECISION THRESH
70 DOUBLE PRECISION ZERO, ONE, TEN
71 parameter ( zero = 0.0d0, one = 1.0d+0, ten = 1.0d1 )
73 parameter ( czero = ( 0.0d0, 0.0d0 ) )
75 parameter ( cone = ( 1.0d0, 0.0d0 ) )
77 parameter ( nsz = 5, nszb = 3*nsz-2 )
79 parameter ( nszp = ( nsz*( nsz+1 ) ) / 2,
85 INTEGER I, INFO, J, KL, KU, M, N
86 DOUBLE PRECISION CCOND, EPS, NORM, RATIO, RCMAX, RCMIN, RCOND
89 DOUBLE PRECISION C( nsz ), POW( npow ), R( nsz ), RESLTS( 5 ),
91 COMPLEX*16 A( nsz, nsz ), AB( nszb, nsz ), AP( nszp )
94 DOUBLE PRECISION DLAMCH
101 INTRINSIC abs, max, min
105 path( 1: 1 ) =
'Zomplex precision'
113 pow( i ) = ten**( i-1 )
114 rpow( i ) = one / pow( i )
124 IF( i.LE.m .AND. j.LE.n )
THEN
125 a( i, j ) = pow( i+j+1 )*( -1 )**( i+j )
132 CALL zgeequ( m, n, a, nsz, r, c, rcond, ccond, norm, info )
137 IF( n.NE.0 .AND. m.NE.0 )
THEN
138 reslts( 1 ) = max( reslts( 1 ),
139 $ abs( ( rcond-rpow( m ) ) / rpow( m ) ) )
140 reslts( 1 ) = max( reslts( 1 ),
141 $ abs( ( ccond-rpow( n ) ) / rpow( n ) ) )
142 reslts( 1 ) = max( reslts( 1 ),
143 $ abs( ( norm-pow( n+m+1 ) ) / pow( n+m+
146 reslts( 1 ) = max( reslts( 1 ),
147 $ abs( ( r( i )-rpow( i+n+1 ) ) /
151 reslts( 1 ) = max( reslts( 1 ),
152 $ abs( ( c( j )-pow( n-j+1 ) ) /
164 a( max( nsz-1, 1 ), j ) = czero
166 CALL zgeequ( nsz, nsz, a, nsz, r, c, rcond, ccond, norm, info )
167 IF( info.NE.max( nsz-1, 1 ) )
171 a( max( nsz-1, 1 ), j ) = cone
174 a( i, max( nsz-1, 1 ) ) = czero
176 CALL zgeequ( nsz, nsz, a, nsz, r, c, rcond, ccond, norm, info )
177 IF( info.NE.nsz+max( nsz-1, 1 ) )
179 reslts( 1 ) = reslts( 1 ) / eps
185 DO 230 kl = 0, max( m-1, 0 )
186 DO 220 ku = 0, max( n-1, 0 )
195 IF( i.LE.min( m, j+kl ) .AND. i.GE.
196 $ max( 1, j-ku ) .AND. j.LE.n )
THEN
197 ab( ku+1+i-j, j ) = pow( i+j+1 )*
203 CALL zgbequ( m, n, kl, ku, ab, nszb, r, c, rcond,
204 $ ccond, norm, info )
207 IF( .NOT.( ( n+kl.LT.m .AND. info.EQ.n+kl+1 ) .OR.
208 $ ( m+ku.LT.n .AND. info.EQ.2*m+ku+1 ) ) )
THEN
212 IF( n.NE.0 .AND. m.NE.0 )
THEN
217 rcmin = min( rcmin, r( i ) )
218 rcmax = max( rcmax, r( i ) )
220 ratio = rcmin / rcmax
221 reslts( 2 ) = max( reslts( 2 ),
222 $ abs( ( rcond-ratio ) / ratio ) )
227 rcmin = min( rcmin, c( j ) )
228 rcmax = max( rcmax, c( j ) )
230 ratio = rcmin / rcmax
231 reslts( 2 ) = max( reslts( 2 ),
232 $ abs( ( ccond-ratio ) / ratio ) )
234 reslts( 2 ) = max( reslts( 2 ),
235 $ abs( ( norm-pow( n+m+1 ) ) /
240 IF( i.LE.j+kl .AND. i.GE.j-ku )
THEN
241 ratio = abs( r( i )*pow( i+j+1 )*
243 rcmax = max( rcmax, ratio )
246 reslts( 2 ) = max( reslts( 2 ),
253 IF( i.LE.j+kl .AND. i.GE.j-ku )
THEN
254 ratio = abs( r( i )*pow( i+j+1 )*
256 rcmax = max( rcmax, ratio )
259 reslts( 2 ) = max( reslts( 2 ),
269 reslts( 2 ) = reslts( 2 ) / eps
277 IF( i.LE.n .AND. j.EQ.i )
THEN
278 a( i, j ) = pow( i+j+1 )*( -1 )**( i+j )
285 CALL zpoequ( n, a, nsz, r, rcond, norm, info )
291 reslts( 3 ) = max( reslts( 3 ),
292 $ abs( ( rcond-rpow( n ) ) / rpow( n ) ) )
293 reslts( 3 ) = max( reslts( 3 ),
294 $ abs( ( norm-pow( 2*n+1 ) ) / pow( 2*n+
297 reslts( 3 ) = max( reslts( 3 ),
298 $ abs( ( r( i )-rpow( i+1 ) ) / rpow( i+
304 a( max( nsz-1, 1 ), max( nsz-1, 1 ) ) = -cone
305 CALL zpoequ( nsz, a, nsz, r, rcond, norm, info )
306 IF( info.NE.max( nsz-1, 1 ) )
308 reslts( 3 ) = reslts( 3 ) / eps
316 DO 300 i = 1, ( n*( n+1 ) ) / 2
320 ap( ( i*( i+1 ) ) / 2 ) = pow( 2*i+1 )
323 CALL zppequ(
'U', n, ap, r, rcond, norm, info )
329 reslts( 4 ) = max( reslts( 4 ),
330 $ abs( ( rcond-rpow( n ) ) / rpow( n ) ) )
331 reslts( 4 ) = max( reslts( 4 ),
332 $ abs( ( norm-pow( 2*n+1 ) ) / pow( 2*n+
335 reslts( 4 ) = max( reslts( 4 ),
336 $ abs( ( r( i )-rpow( i+1 ) ) / rpow( i+
344 DO 330 i = 1, ( n*( n+1 ) ) / 2
349 ap( j ) = pow( 2*i+1 )
353 CALL zppequ(
'L', n, ap, r, rcond, norm, info )
359 reslts( 4 ) = max( reslts( 4 ),
360 $ abs( ( rcond-rpow( n ) ) / rpow( n ) ) )
361 reslts( 4 ) = max( reslts( 4 ),
362 $ abs( ( norm-pow( 2*n+1 ) ) / pow( 2*n+
365 reslts( 4 ) = max( reslts( 4 ),
366 $ abs( ( r( i )-rpow( i+1 ) ) / rpow( i+
373 i = ( nsz*( nsz+1 ) ) / 2 - 2
375 CALL zppequ(
'L', nsz, ap, r, rcond, norm, info )
376 IF( info.NE.max( nsz-1, 1 ) )
378 reslts( 4 ) = reslts( 4 ) / eps
383 DO 450 kl = 0, max( n-1, 0 )
393 ab( kl+1, j ) = pow( 2*j+1 )
396 CALL zpbequ(
'U', n, kl, ab, nszb, r, rcond, norm, info )
402 reslts( 5 ) = max( reslts( 5 ),
403 $ abs( ( rcond-rpow( n ) ) / rpow( n ) ) )
404 reslts( 5 ) = max( reslts( 5 ),
405 $ abs( ( norm-pow( 2*n+1 ) ) / pow( 2*n+
408 reslts( 5 ) = max( reslts( 5 ),
409 $ abs( ( r( i )-rpow( i+1 ) ) /
415 ab( kl+1, max( n-1, 1 ) ) = -cone
416 CALL zpbequ(
'U', n, kl, ab, nszb, r, rcond, norm, info )
417 IF( info.NE.max( n-1, 1 ) )
429 ab( 1, j ) = pow( 2*j+1 )
432 CALL zpbequ(
'L', n, kl, ab, nszb, r, rcond, norm, info )
438 reslts( 5 ) = max( reslts( 5 ),
439 $ abs( ( rcond-rpow( n ) ) / rpow( n ) ) )
440 reslts( 5 ) = max( reslts( 5 ),
441 $ abs( ( norm-pow( 2*n+1 ) ) / pow( 2*n+
444 reslts( 5 ) = max( reslts( 5 ),
445 $ abs( ( r( i )-rpow( i+1 ) ) /
451 ab( 1, max( n-1, 1 ) ) = -cone
452 CALL zpbequ(
'L', n, kl, ab, nszb, r, rcond, norm, info )
453 IF( info.NE.max( n-1, 1 ) )
458 reslts( 5 ) = reslts( 5 ) / eps
459 ok = ( reslts( 1 ).LE.thresh ) .AND.
460 $ ( reslts( 2 ).LE.thresh ) .AND.
461 $ ( reslts( 3 ).LE.thresh ) .AND.
462 $ ( reslts( 4 ).LE.thresh ) .AND. ( reslts( 5 ).LE.thresh )
463 WRITE( nout, fmt = * )
465 WRITE( nout, fmt = 9999 )path
467 IF( reslts( 1 ).GT.thresh )
468 $
WRITE( nout, fmt = 9998 )reslts( 1 ), thresh
469 IF( reslts( 2 ).GT.thresh )
470 $
WRITE( nout, fmt = 9997 )reslts( 2 ), thresh
471 IF( reslts( 3 ).GT.thresh )
472 $
WRITE( nout, fmt = 9996 )reslts( 3 ), thresh
473 IF( reslts( 4 ).GT.thresh )
474 $
WRITE( nout, fmt = 9995 )reslts( 4 ), thresh
475 IF( reslts( 5 ).GT.thresh )
476 $
WRITE( nout, fmt = 9994 )reslts( 5 ), thresh
478 9999
FORMAT( 1x,
'All tests for ', a3,
479 $
' routines passed the threshold' )
480 9998
FORMAT(
' ZGEEQU failed test with value ', d10.3,
' exceeding',
481 $
' threshold ', d10.3 )
482 9997
FORMAT(
' ZGBEQU failed test with value ', d10.3,
' exceeding',
483 $
' threshold ', d10.3 )
484 9996
FORMAT(
' ZPOEQU failed test with value ', d10.3,
' exceeding',
485 $
' threshold ', d10.3 )
486 9995
FORMAT(
' ZPPEQU failed test with value ', d10.3,
' exceeding',
487 $
' threshold ', d10.3 )
488 9994
FORMAT(
' ZPBEQU failed test with value ', d10.3,
' exceeding',
489 $
' threshold ', d10.3 )
subroutine zchkeq(THRESH, NOUT)
ZCHKEQ
subroutine zppequ(UPLO, N, AP, S, SCOND, AMAX, INFO)
ZPPEQU
subroutine zpbequ(UPLO, N, KD, AB, LDAB, S, SCOND, AMAX, INFO)
ZPBEQU
subroutine zgbequ(M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND, AMAX, INFO)
ZGBEQU
subroutine zpoequ(N, A, LDA, S, SCOND, AMAX, INFO)
ZPOEQU
subroutine zgeequ(M, N, A, LDA, R, C, ROWCND, COLCND, AMAX, INFO)
ZGEEQU