LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
subroutine cchkeq ( real  THRESH,
integer  NOUT 
)

CCHKEQ

Purpose: 
 CCHKEQ tests CGEEQU, CGBEQU, CPOEQU, CPPEQU and CPBEQU
Parameters
[in]THRESH
          THRESH is REAL
          Threshold for testing routines. Should be between 2 and 10.
[in]NOUT
          NOUT is INTEGER
          The unit number for output.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
November 2011

Definition at line 56 of file cchkeq.f.

56 *
57 * -- LAPACK test routine (version 3.4.0) --
58 * -- LAPACK is a software package provided by Univ. of Tennessee, --
59 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
60 * November 2011
61 *
62 * .. Scalar Arguments ..
63  INTEGER nout
64  REAL thresh
65 * ..
66 *
67 * =====================================================================
68 *
69 * .. Parameters ..
70  REAL zero, one, ten
71  parameter ( zero = 0.0e0, one = 1.0e+0, ten = 1.0e1 )
72  COMPLEX czero
73  parameter ( czero = ( 0.0e0, 0.0e0 ) )
74  COMPLEX cone
75  parameter ( cone = ( 1.0e0, 0.0e0 ) )
76  INTEGER nsz, nszb
77  parameter ( nsz = 5, nszb = 3*nsz-2 )
78  INTEGER nszp, npow
79  parameter ( nszp = ( nsz*( nsz+1 ) ) / 2,
80  $ npow = 2*nsz+1 )
81 * ..
82 * .. Local Scalars ..
83  LOGICAL ok
84  CHARACTER*3 path
85  INTEGER i, info, j, kl, ku, m, n
86  REAL ccond, eps, norm, ratio, rcmax, rcmin, rcond
87 * ..
88 * .. Local Arrays ..
89  REAL c( nsz ), pow( npow ), r( nsz ), reslts( 5 ),
90  $ rpow( npow )
91  COMPLEX a( nsz, nsz ), ab( nszb, nsz ), ap( nszp )
92 * ..
93 * .. External Functions ..
94  REAL slamch
95  EXTERNAL slamch
96 * ..
97 * .. External Subroutines ..
98  EXTERNAL cgbequ, cgeequ, cpbequ, cpoequ, cppequ
99 * ..
100 * .. Intrinsic Functions ..
101  INTRINSIC abs, max, min
102 * ..
103 * .. Executable Statements ..
104 *
105  path( 1:1 ) = 'Complex precision'
106  path( 2:3 ) = 'EQ'
107 *
108  eps = slamch( 'P' )
109  DO 10 i = 1, 5
110  reslts( i ) = zero
111  10 CONTINUE
112  DO 20 i = 1, npow
113  pow( i ) = ten**( i-1 )
114  rpow( i ) = one / pow( i )
115  20 CONTINUE
116 *
117 * Test CGEEQU
118 *
119  DO 80 n = 0, nsz
120  DO 70 m = 0, nsz
121 *
122  DO 40 j = 1, nsz
123  DO 30 i = 1, nsz
124  IF( i.LE.m .AND. j.LE.n ) THEN
125  a( i, j ) = pow( i+j+1 )*( -1 )**( i+j )
126  ELSE
127  a( i, j ) = czero
128  END IF
129  30 CONTINUE
130  40 CONTINUE
131 *
132  CALL cgeequ( m, n, a, nsz, r, c, rcond, ccond, norm, info )
133 *
134  IF( info.NE.0 ) THEN
135  reslts( 1 ) = one
136  ELSE
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+
144  $ 1 ) ) )
145  DO 50 i = 1, m
146  reslts( 1 ) = max( reslts( 1 ),
147  $ abs( ( r( i )-rpow( i+n+1 ) ) /
148  $ rpow( i+n+1 ) ) )
149  50 CONTINUE
150  DO 60 j = 1, n
151  reslts( 1 ) = max( reslts( 1 ),
152  $ abs( ( c( j )-pow( n-j+1 ) ) /
153  $ pow( n-j+1 ) ) )
154  60 CONTINUE
155  END IF
156  END IF
157 *
158  70 CONTINUE
159  80 CONTINUE
160 *
161 * Test with zero rows and columns
162 *
163  DO 90 j = 1, nsz
164  a( max( nsz-1, 1 ), j ) = czero
165  90 CONTINUE
166  CALL cgeequ( nsz, nsz, a, nsz, r, c, rcond, ccond, norm, info )
167  IF( info.NE.max( nsz-1, 1 ) )
168  $ reslts( 1 ) = one
169 *
170  DO 100 j = 1, nsz
171  a( max( nsz-1, 1 ), j ) = cone
172  100 CONTINUE
173  DO 110 i = 1, nsz
174  a( i, max( nsz-1, 1 ) ) = czero
175  110 CONTINUE
176  CALL cgeequ( nsz, nsz, a, nsz, r, c, rcond, ccond, norm, info )
177  IF( info.NE.nsz+max( nsz-1, 1 ) )
178  $ reslts( 1 ) = one
179  reslts( 1 ) = reslts( 1 ) / eps
180 *
181 * Test CGBEQU
182 *
183  DO 250 n = 0, nsz
184  DO 240 m = 0, nsz
185  DO 230 kl = 0, max( m-1, 0 )
186  DO 220 ku = 0, max( n-1, 0 )
187 *
188  DO 130 j = 1, nsz
189  DO 120 i = 1, nszb
190  ab( i, j ) = czero
191  120 CONTINUE
192  130 CONTINUE
193  DO 150 j = 1, n
194  DO 140 i = 1, m
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 )*
198  $ ( -1 )**( i+j )
199  END IF
200  140 CONTINUE
201  150 CONTINUE
202 *
203  CALL cgbequ( m, n, kl, ku, ab, nszb, r, c, rcond,
204  $ ccond, norm, info )
205 *
206  IF( info.NE.0 ) THEN
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
209  reslts( 2 ) = one
210  END IF
211  ELSE
212  IF( n.NE.0 .AND. m.NE.0 ) THEN
213 *
214  rcmin = r( 1 )
215  rcmax = r( 1 )
216  DO 160 i = 1, m
217  rcmin = min( rcmin, r( i ) )
218  rcmax = max( rcmax, r( i ) )
219  160 CONTINUE
220  ratio = rcmin / rcmax
221  reslts( 2 ) = max( reslts( 2 ),
222  $ abs( ( rcond-ratio ) / ratio ) )
223 *
224  rcmin = c( 1 )
225  rcmax = c( 1 )
226  DO 170 j = 1, n
227  rcmin = min( rcmin, c( j ) )
228  rcmax = max( rcmax, c( j ) )
229  170 CONTINUE
230  ratio = rcmin / rcmax
231  reslts( 2 ) = max( reslts( 2 ),
232  $ abs( ( ccond-ratio ) / ratio ) )
233 *
234  reslts( 2 ) = max( reslts( 2 ),
235  $ abs( ( norm-pow( n+m+1 ) ) /
236  $ pow( n+m+1 ) ) )
237  DO 190 i = 1, m
238  rcmax = zero
239  DO 180 j = 1, n
240  IF( i.LE.j+kl .AND. i.GE.j-ku ) THEN
241  ratio = abs( r( i )*pow( i+j+1 )*
242  $ c( j ) )
243  rcmax = max( rcmax, ratio )
244  END IF
245  180 CONTINUE
246  reslts( 2 ) = max( reslts( 2 ),
247  $ abs( one-rcmax ) )
248  190 CONTINUE
249 *
250  DO 210 j = 1, n
251  rcmax = zero
252  DO 200 i = 1, m
253  IF( i.LE.j+kl .AND. i.GE.j-ku ) THEN
254  ratio = abs( r( i )*pow( i+j+1 )*
255  $ c( j ) )
256  rcmax = max( rcmax, ratio )
257  END IF
258  200 CONTINUE
259  reslts( 2 ) = max( reslts( 2 ),
260  $ abs( one-rcmax ) )
261  210 CONTINUE
262  END IF
263  END IF
264 *
265  220 CONTINUE
266  230 CONTINUE
267  240 CONTINUE
268  250 CONTINUE
269  reslts( 2 ) = reslts( 2 ) / eps
270 *
271 * Test CPOEQU
272 *
273  DO 290 n = 0, nsz
274 *
275  DO 270 i = 1, nsz
276  DO 260 j = 1, nsz
277  IF( i.LE.n .AND. j.EQ.i ) THEN
278  a( i, j ) = pow( i+j+1 )*( -1 )**( i+j )
279  ELSE
280  a( i, j ) = czero
281  END IF
282  260 CONTINUE
283  270 CONTINUE
284 *
285  CALL cpoequ( n, a, nsz, r, rcond, norm, info )
286 *
287  IF( info.NE.0 ) THEN
288  reslts( 3 ) = one
289  ELSE
290  IF( n.NE.0 ) THEN
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+
295  $ 1 ) ) )
296  DO 280 i = 1, n
297  reslts( 3 ) = max( reslts( 3 ),
298  $ abs( ( r( i )-rpow( i+1 ) ) / rpow( i+
299  $ 1 ) ) )
300  280 CONTINUE
301  END IF
302  END IF
303  290 CONTINUE
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 ) )
307  $ reslts( 3 ) = one
308  reslts( 3 ) = reslts( 3 ) / eps
309 *
310 * Test CPPEQU
311 *
312  DO 360 n = 0, nsz
313 *
314 * Upper triangular packed storage
315 *
316  DO 300 i = 1, ( n*( n+1 ) ) / 2
317  ap( i ) = czero
318  300 CONTINUE
319  DO 310 i = 1, n
320  ap( ( i*( i+1 ) ) / 2 ) = pow( 2*i+1 )
321  310 CONTINUE
322 *
323  CALL cppequ( 'U', n, ap, r, rcond, norm, info )
324 *
325  IF( info.NE.0 ) THEN
326  reslts( 4 ) = one
327  ELSE
328  IF( n.NE.0 ) THEN
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+
333  $ 1 ) ) )
334  DO 320 i = 1, n
335  reslts( 4 ) = max( reslts( 4 ),
336  $ abs( ( r( i )-rpow( i+1 ) ) / rpow( i+
337  $ 1 ) ) )
338  320 CONTINUE
339  END IF
340  END IF
341 *
342 * Lower triangular packed storage
343 *
344  DO 330 i = 1, ( n*( n+1 ) ) / 2
345  ap( i ) = czero
346  330 CONTINUE
347  j = 1
348  DO 340 i = 1, n
349  ap( j ) = pow( 2*i+1 )
350  j = j + ( n-i+1 )
351  340 CONTINUE
352 *
353  CALL cppequ( 'L', n, ap, r, rcond, norm, info )
354 *
355  IF( info.NE.0 ) THEN
356  reslts( 4 ) = one
357  ELSE
358  IF( n.NE.0 ) THEN
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+
363  $ 1 ) ) )
364  DO 350 i = 1, n
365  reslts( 4 ) = max( reslts( 4 ),
366  $ abs( ( r( i )-rpow( i+1 ) ) / rpow( i+
367  $ 1 ) ) )
368  350 CONTINUE
369  END IF
370  END IF
371 *
372  360 CONTINUE
373  i = ( nsz*( nsz+1 ) ) / 2 - 2
374  ap( i ) = -cone
375  CALL cppequ( 'L', nsz, ap, r, rcond, norm, info )
376  IF( info.NE.max( nsz-1, 1 ) )
377  $ reslts( 4 ) = one
378  reslts( 4 ) = reslts( 4 ) / eps
379 *
380 * Test CPBEQU
381 *
382  DO 460 n = 0, nsz
383  DO 450 kl = 0, max( n-1, 0 )
384 *
385 * Test upper triangular storage
386 *
387  DO 380 j = 1, nsz
388  DO 370 i = 1, nszb
389  ab( i, j ) = czero
390  370 CONTINUE
391  380 CONTINUE
392  DO 390 j = 1, n
393  ab( kl+1, j ) = pow( 2*j+1 )
394  390 CONTINUE
395 *
396  CALL cpbequ( 'U', n, kl, ab, nszb, r, rcond, norm, info )
397 *
398  IF( info.NE.0 ) THEN
399  reslts( 5 ) = one
400  ELSE
401  IF( n.NE.0 ) THEN
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+
406  $ 1 ) ) )
407  DO 400 i = 1, n
408  reslts( 5 ) = max( reslts( 5 ),
409  $ abs( ( r( i )-rpow( i+1 ) ) /
410  $ rpow( i+1 ) ) )
411  400 CONTINUE
412  END IF
413  END IF
414  IF( n.NE.0 ) THEN
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 ) )
418  $ reslts( 5 ) = one
419  END IF
420 *
421 * Test lower triangular storage
422 *
423  DO 420 j = 1, nsz
424  DO 410 i = 1, nszb
425  ab( i, j ) = czero
426  410 CONTINUE
427  420 CONTINUE
428  DO 430 j = 1, n
429  ab( 1, j ) = pow( 2*j+1 )
430  430 CONTINUE
431 *
432  CALL cpbequ( 'L', n, kl, ab, nszb, r, rcond, norm, info )
433 *
434  IF( info.NE.0 ) THEN
435  reslts( 5 ) = one
436  ELSE
437  IF( n.NE.0 ) THEN
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+
442  $ 1 ) ) )
443  DO 440 i = 1, n
444  reslts( 5 ) = max( reslts( 5 ),
445  $ abs( ( r( i )-rpow( i+1 ) ) /
446  $ rpow( i+1 ) ) )
447  440 CONTINUE
448  END IF
449  END IF
450  IF( n.NE.0 ) THEN
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 ) )
454  $ reslts( 5 ) = one
455  END IF
456  450 CONTINUE
457  460 CONTINUE
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 = * )
464  IF( ok ) THEN
465  WRITE( nout, fmt = 9999 )path
466  ELSE
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
477  END IF
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 )
490  RETURN
491 *
492 * End of CCHKEQ
493 *
cpbequ
subroutine cpbequ(UPLO, N, KD, AB, LDAB, S, SCOND, AMAX, INFO)
CPBEQU
Definition: cpbequ.f:132
cgeequ
subroutine cgeequ(M, N, A, LDA, R, C, ROWCND, COLCND, AMAX, INFO)
CGEEQU
Definition: cgeequ.f:142
cpoequ
subroutine cpoequ(N, A, LDA, S, SCOND, AMAX, INFO)
CPOEQU
Definition: cpoequ.f:115
cgbequ
subroutine cgbequ(M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND, AMAX, INFO)
CGBEQU
Definition: cgbequ.f:156
slamch
real function slamch(CMACH)
SLAMCH
Definition: slamch.f:69
cppequ
subroutine cppequ(UPLO, N, AP, S, SCOND, AMAX, INFO)
CPPEQU
Definition: cppequ.f:119

Here is the call graph for this function:

Here is the caller graph for this function: