LAPACK  3.10.0 LAPACK: Linear Algebra PACKage

## ◆ zchkeq()

 subroutine zchkeq ( double precision THRESH, integer NOUT )

ZCHKEQ

Purpose:
` ZCHKEQ tests ZGEEQU, ZGBEQU, ZPOEQU, ZPPEQU and ZPBEQU`
Parameters
 [in] THRESH ``` THRESH is DOUBLE PRECISION Threshold for testing routines. Should be between 2 and 10.``` [in] NOUT ``` NOUT is INTEGER The unit number for output.```

Definition at line 53 of file zchkeq.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  DOUBLE PRECISION THRESH
62 * ..
63 *
64 * =====================================================================
65 *
66 * .. Parameters ..
67  DOUBLE PRECISION ZERO, ONE, TEN
68  parameter( zero = 0.0d0, one = 1.0d+0, ten = 1.0d1 )
69  COMPLEX*16 CZERO
70  parameter( czero = ( 0.0d0, 0.0d0 ) )
71  COMPLEX*16 CONE
72  parameter( cone = ( 1.0d0, 0.0d0 ) )
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  DOUBLE PRECISION CCOND, EPS, NORM, RATIO, RCMAX, RCMIN, RCOND
84 * ..
85 * .. Local Arrays ..
86  DOUBLE PRECISION C( NSZ ), POW( NPOW ), R( NSZ ), RESLTS( 5 ),
87  \$ RPOW( NPOW )
88  COMPLEX*16 A( NSZ, NSZ ), AB( NSZB, NSZ ), AP( NSZP )
89 * ..
90 * .. External Functions ..
91  DOUBLE PRECISION DLAMCH
92  EXTERNAL dlamch
93 * ..
94 * .. External Subroutines ..
95  EXTERNAL zgbequ, zgeequ, zpbequ, zpoequ, zppequ
96 * ..
97 * .. Intrinsic Functions ..
98  INTRINSIC abs, max, min
99 * ..
100 * .. Executable Statements ..
101 *
102  path( 1: 1 ) = 'Zomplex precision'
103  path( 2: 3 ) = 'EQ'
104 *
105  eps = dlamch( '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 ZGEEQU
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 zgeequ( 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 zgeequ( 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 zgeequ( 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 ZGBEQU
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 zgbequ( 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 ZPOEQU
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 zpoequ( 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 zpoequ( 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 ZPPEQU
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 zppequ( '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 zppequ( '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 zppequ( '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 ZPBEQU
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 zpbequ( '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 zpbequ( '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 zpbequ( '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 zpbequ( '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( ' ZGEEQU failed test with value ', d10.3, ' exceeding',
478  \$ ' threshold ', d10.3 )
479  9997 FORMAT( ' ZGBEQU failed test with value ', d10.3, ' exceeding',
480  \$ ' threshold ', d10.3 )
481  9996 FORMAT( ' ZPOEQU failed test with value ', d10.3, ' exceeding',
482  \$ ' threshold ', d10.3 )
483  9995 FORMAT( ' ZPPEQU failed test with value ', d10.3, ' exceeding',
484  \$ ' threshold ', d10.3 )
485  9994 FORMAT( ' ZPBEQU failed test with value ', d10.3, ' exceeding',
486  \$ ' threshold ', d10.3 )
487  RETURN
488 *
489 * End of ZCHKEQ
490 *
double precision function dlamch(CMACH)
DLAMCH
Definition: dlamch.f:69
subroutine zgbequ(M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND, AMAX, INFO)
ZGBEQU
Definition: zgbequ.f:154
subroutine zgeequ(M, N, A, LDA, R, C, ROWCND, COLCND, AMAX, INFO)
ZGEEQU
Definition: zgeequ.f:140
subroutine zppequ(UPLO, N, AP, S, SCOND, AMAX, INFO)
ZPPEQU
Definition: zppequ.f:117
subroutine zpbequ(UPLO, N, KD, AB, LDAB, S, SCOND, AMAX, INFO)
ZPBEQU
Definition: zpbequ.f:130
subroutine zpoequ(N, A, LDA, S, SCOND, AMAX, INFO)
ZPOEQU
Definition: zpoequ.f:113
Here is the call graph for this function:
Here is the caller graph for this function: