55 SUBROUTINE cchkeq( THRESH, NOUT )
71 parameter ( zero = 0.0e0, one = 1.0e+0, ten = 1.0e1 )
73 parameter ( czero = ( 0.0e0, 0.0e0 ) )
75 parameter ( cone = ( 1.0e0, 0.0e0 ) )
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 REAL CCOND, EPS, NORM, RATIO, RCMAX, RCMIN, RCOND
89 REAL C( nsz ), POW( npow ), R( nsz ), RESLTS( 5 ),
91 COMPLEX A( nsz, nsz ), AB( nszb, nsz ), AP( nszp )
101 INTRINSIC abs, max, min
105 path( 1:1 ) =
'Complex 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 cgeequ( 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 cgeequ( 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 cgeequ( 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 cgbequ( 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 cpoequ( 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 cpoequ( 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 cppequ(
'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 cppequ(
'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 cppequ(
'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 cpbequ(
'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 cpbequ(
'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 cpbequ(
'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 cpbequ(
'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(
' CGEEQU failed test with value ', e10.3,
' exceeding',
481 $
' threshold ', e10.3 )
482 9997
FORMAT(
' CGBEQU failed test with value ', e10.3,
' exceeding',
483 $
' threshold ', e10.3 )
484 9996
FORMAT(
' CPOEQU failed test with value ', e10.3,
' exceeding',
485 $
' threshold ', e10.3 )
486 9995
FORMAT(
' CPPEQU failed test with value ', e10.3,
' exceeding',
487 $
' threshold ', e10.3 )
488 9994
FORMAT(
' CPBEQU failed test with value ', e10.3,
' exceeding',
489 $
' threshold ', e10.3 )
subroutine cppequ(UPLO, N, AP, S, SCOND, AMAX, INFO)
CPPEQU
subroutine cchkeq(THRESH, NOUT)
CCHKEQ
subroutine cpbequ(UPLO, N, KD, AB, LDAB, S, SCOND, AMAX, INFO)
CPBEQU
subroutine cgeequ(M, N, A, LDA, R, C, ROWCND, COLCND, AMAX, INFO)
CGEEQU
subroutine cpoequ(N, A, LDA, S, SCOND, AMAX, INFO)
CPOEQU
subroutine cgbequ(M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND, AMAX, INFO)
CGBEQU