LAPACK  3.10.0
LAPACK: Linear Algebra PACKage

◆ cchkeq()

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.

Definition at line 53 of file cchkeq.f.

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