LAPACK  3.10.1
LAPACK: Linear Algebra PACKage
zdrvab.f
Go to the documentation of this file.
1 *> \brief \b ZDRVAB
2 *
3 * =========== DOCUMENTATION ===========
4 *
5 * Online html documentation available at
6 * http://www.netlib.org/lapack/explore-html/
7 *
8 * Definition:
9 * ===========
10 *
11 * SUBROUTINE ZDRVAB( DOTYPE, NM, MVAL, NNS,
12 * NSVAL, THRESH, NMAX, A, AFAC, B,
13 * X, WORK, RWORK, SWORK, IWORK, NOUT )
14 *
15 * .. Scalar Arguments ..
16 * INTEGER NM, NMAX, NNS, NOUT
17 * DOUBLE PRECISION THRESH
18 * ..
19 * .. Array Arguments ..
20 * LOGICAL DOTYPE( * )
21 * INTEGER MVAL( * ), NSVAL( * ), IWORK( * )
22 * DOUBLE PRECISION RWORK( * )
23 * COMPLEX SWORK( * )
24 * COMPLEX*16 A( * ), AFAC( * ), B( * ),
25 * $ WORK( * ), X( * )
26 * ..
27 *
28 *
29 *> \par Purpose:
30 * =============
31 *>
32 *> \verbatim
33 *>
34 *> ZDRVAB tests ZCGESV
35 *> \endverbatim
36 *
37 * Arguments:
38 * ==========
39 *
40 *> \param[in] DOTYPE
41 *> \verbatim
42 *> DOTYPE is LOGICAL array, dimension (NTYPES)
43 *> The matrix types to be used for testing. Matrices of type j
44 *> (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
45 *> .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
46 *> \endverbatim
47 *>
48 *> \param[in] NM
49 *> \verbatim
50 *> NM is INTEGER
51 *> The number of values of M contained in the vector MVAL.
52 *> \endverbatim
53 *>
54 *> \param[in] MVAL
55 *> \verbatim
56 *> MVAL is INTEGER array, dimension (NM)
57 *> The values of the matrix row dimension M.
58 *> \endverbatim
59 *>
60 *> \param[in] NNS
61 *> \verbatim
62 *> NNS is INTEGER
63 *> The number of values of NRHS contained in the vector NSVAL.
64 *> \endverbatim
65 *>
66 *> \param[in] NSVAL
67 *> \verbatim
68 *> NSVAL is INTEGER array, dimension (NNS)
69 *> The values of the number of right hand sides NRHS.
70 *> \endverbatim
71 *>
72 *> \param[in] THRESH
73 *> \verbatim
74 *> THRESH is DOUBLE PRECISION
75 *> The threshold value for the test ratios. A result is
76 *> included in the output file if RESULT >= THRESH. To have
77 *> every test ratio printed, use THRESH = 0.
78 *> \endverbatim
79 *>
80 *> \param[in] NMAX
81 *> \verbatim
82 *> NMAX is INTEGER
83 *> The maximum value permitted for M or N, used in dimensioning
84 *> the work arrays.
85 *> \endverbatim
86 *>
87 *> \param[out] A
88 *> \verbatim
89 *> A is COMPLEX*16 array, dimension (NMAX*NMAX)
90 *> \endverbatim
91 *>
92 *> \param[out] AFAC
93 *> \verbatim
94 *> AFAC is COMPLEX*16 array, dimension (NMAX*NMAX)
95 *> \endverbatim
96 *>
97 *> \param[out] B
98 *> \verbatim
99 *> B is COMPLEX*16 array, dimension (NMAX*NSMAX)
100 *> where NSMAX is the largest entry in NSVAL.
101 *> \endverbatim
102 *>
103 *> \param[out] X
104 *> \verbatim
105 *> X is COMPLEX*16 array, dimension (NMAX*NSMAX)
106 *> \endverbatim
107 *>
108 *> \param[out] WORK
109 *> \verbatim
110 *> WORK is COMPLEX*16 array, dimension
111 *> (NMAX*max(3,NSMAX*2))
112 *> \endverbatim
113 *>
114 *> \param[out] RWORK
115 *> \verbatim
116 *> RWORK is DOUBLE PRECISION array, dimension
117 *> NMAX
118 *> \endverbatim
119 *>
120 *> \param[out] SWORK
121 *> \verbatim
122 *> SWORK is COMPLEX array, dimension
123 *> (NMAX*(NSMAX+NMAX))
124 *> \endverbatim
125 *>
126 *> \param[out] IWORK
127 *> \verbatim
128 *> IWORK is INTEGER array, dimension
129 *> NMAX
130 *> \endverbatim
131 *>
132 *> \param[in] NOUT
133 *> \verbatim
134 *> NOUT is INTEGER
135 *> The unit number for output.
136 *> \endverbatim
137 *
138 * Authors:
139 * ========
140 *
141 *> \author Univ. of Tennessee
142 *> \author Univ. of California Berkeley
143 *> \author Univ. of Colorado Denver
144 *> \author NAG Ltd.
145 *
146 *> \ingroup complex16_lin
147 *
148 * =====================================================================
149  SUBROUTINE zdrvab( DOTYPE, NM, MVAL, NNS,
150  $ NSVAL, THRESH, NMAX, A, AFAC, B,
151  $ X, WORK, RWORK, SWORK, IWORK, NOUT )
152 *
153 * -- LAPACK test routine --
154 * -- LAPACK is a software package provided by Univ. of Tennessee, --
155 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
156 *
157 * .. Scalar Arguments ..
158  INTEGER NM, NMAX, NNS, NOUT
159  DOUBLE PRECISION THRESH
160 * ..
161 * .. Array Arguments ..
162  LOGICAL DOTYPE( * )
163  INTEGER MVAL( * ), NSVAL( * ), IWORK( * )
164  DOUBLE PRECISION RWORK( * )
165  COMPLEX SWORK( * )
166  COMPLEX*16 A( * ), AFAC( * ), B( * ),
167  $ work( * ), x( * )
168 * ..
169 *
170 * =====================================================================
171 *
172 * .. Parameters ..
173  DOUBLE PRECISION ZERO
174  PARAMETER ( ZERO = 0.0d+0 )
175  INTEGER NTYPES
176  parameter( ntypes = 11 )
177  INTEGER NTESTS
178  parameter( ntests = 1 )
179 * ..
180 * .. Local Scalars ..
181  LOGICAL ZEROT
182  CHARACTER DIST, TRANS, TYPE, XTYPE
183  CHARACTER*3 PATH
184  INTEGER I, IM, IMAT, INFO, IOFF, IRHS,
185  $ izero, kl, ku, lda, m, mode, n,
186  $ nerrs, nfail, nimat, nrhs, nrun
187  DOUBLE PRECISION ANORM, CNDNUM
188 * ..
189 * .. Local Arrays ..
190  INTEGER ISEED( 4 ), ISEEDY( 4 )
191  DOUBLE PRECISION RESULT( NTESTS )
192 * ..
193 * .. Local Variables ..
194  INTEGER ITER, KASE
195 * ..
196 * .. External Subroutines ..
197  EXTERNAL alaerh, alahd, zget08, zlacpy, zlarhs, zlaset,
198  $ zlatb4, zlatms
199 * ..
200 * .. Intrinsic Functions ..
201  INTRINSIC dcmplx, dble, max, min, sqrt
202 * ..
203 * .. Scalars in Common ..
204  LOGICAL LERR, OK
205  CHARACTER*32 SRNAMT
206  INTEGER INFOT, NUNIT
207 * ..
208 * .. Common blocks ..
209  COMMON / infoc / infot, nunit, ok, lerr
210  COMMON / srnamc / srnamt
211 * ..
212 * .. Data statements ..
213  DATA iseedy / 2006, 2007, 2008, 2009 /
214 * ..
215 * .. Executable Statements ..
216 *
217 * Initialize constants and the random number seed.
218 *
219  kase = 0
220  path( 1: 1 ) = 'Zomplex precision'
221  path( 2: 3 ) = 'GE'
222  nrun = 0
223  nfail = 0
224  nerrs = 0
225  DO 10 i = 1, 4
226  iseed( i ) = iseedy( i )
227  10 CONTINUE
228 *
229  infot = 0
230 *
231 * Do for each value of M in MVAL
232 *
233  DO 120 im = 1, nm
234  m = mval( im )
235  lda = max( 1, m )
236 *
237  n = m
238  nimat = ntypes
239  IF( m.LE.0 .OR. n.LE.0 )
240  $ nimat = 1
241 *
242  DO 100 imat = 1, nimat
243 *
244 * Do the tests only if DOTYPE( IMAT ) is true.
245 *
246  IF( .NOT.dotype( imat ) )
247  $ GO TO 100
248 *
249 * Skip types 5, 6, or 7 if the matrix size is too small.
250 *
251  zerot = imat.GE.5 .AND. imat.LE.7
252  IF( zerot .AND. n.LT.imat-4 )
253  $ GO TO 100
254 *
255 * Set up parameters with ZLATB4 and generate a test matrix
256 * with ZLATMS.
257 *
258  CALL zlatb4( path, imat, m, n, TYPE, kl, ku, anorm, mode,
259  $ cndnum, dist )
260 *
261  srnamt = 'ZLATMS'
262  CALL zlatms( m, n, dist, iseed, TYPE, rwork, mode,
263  $ cndnum, anorm, kl, ku, 'No packing', a, lda,
264  $ work, info )
265 *
266 * Check error code from ZLATMS.
267 *
268  IF( info.NE.0 ) THEN
269  CALL alaerh( path, 'ZLATMS', info, 0, ' ', m, n, -1,
270  $ -1, -1, imat, nfail, nerrs, nout )
271  GO TO 100
272  END IF
273 *
274 * For types 5-7, zero one or more columns of the matrix to
275 * test that INFO is returned correctly.
276 *
277  IF( zerot ) THEN
278  IF( imat.EQ.5 ) THEN
279  izero = 1
280  ELSE IF( imat.EQ.6 ) THEN
281  izero = min( m, n )
282  ELSE
283  izero = min( m, n ) / 2 + 1
284  END IF
285  ioff = ( izero-1 )*lda
286  IF( imat.LT.7 ) THEN
287  DO 20 i = 1, m
288  a( ioff+i ) = zero
289  20 CONTINUE
290  ELSE
291  CALL zlaset( 'Full', m, n-izero+1, dcmplx(zero),
292  $ dcmplx(zero), a( ioff+1 ), lda )
293  END IF
294  ELSE
295  izero = 0
296  END IF
297 *
298  DO 60 irhs = 1, nns
299  nrhs = nsval( irhs )
300  xtype = 'N'
301  trans = 'N'
302 *
303  srnamt = 'ZLARHS'
304  CALL zlarhs( path, xtype, ' ', trans, n, n, kl,
305  $ ku, nrhs, a, lda, x, lda, b,
306  $ lda, iseed, info )
307 *
308  srnamt = 'ZCGESV'
309 *
310  kase = kase + 1
311 *
312  CALL zlacpy( 'Full', m, n, a, lda, afac, lda )
313 *
314  CALL zcgesv( n, nrhs, a, lda, iwork, b, lda, x, lda,
315  $ work, swork, rwork, iter, info)
316 *
317  IF (iter.LT.0) THEN
318  CALL zlacpy( 'Full', m, n, afac, lda, a, lda )
319  ENDIF
320 *
321 * Check error code from ZCGESV. This should be the same as
322 * the one of DGETRF.
323 *
324  IF( info.NE.izero ) THEN
325 *
326  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
327  $ CALL alahd( nout, path )
328  nerrs = nerrs + 1
329 *
330  IF( info.NE.izero .AND. izero.NE.0 ) THEN
331  WRITE( nout, fmt = 9988 )'ZCGESV',info,
332  $ izero,m,imat
333  ELSE
334  WRITE( nout, fmt = 9975 )'ZCGESV',info,
335  $ m, imat
336  END IF
337  END IF
338 *
339 * Skip the remaining test if the matrix is singular.
340 *
341  IF( info.NE.0 )
342  $ GO TO 100
343 *
344 * Check the quality of the solution
345 *
346  CALL zlacpy( 'Full', n, nrhs, b, lda, work, lda )
347 *
348  CALL zget08( trans, n, n, nrhs, a, lda, x, lda, work,
349  $ lda, rwork, result( 1 ) )
350 *
351 * Check if the test passes the tesing.
352 * Print information about the tests that did not
353 * pass the testing.
354 *
355 * If iterative refinement has been used and claimed to
356 * be successful (ITER>0), we want
357 * NORMI(B - A*X)/(NORMI(A)*NORMI(X)*EPS*SRQT(N)) < 1
358 *
359 * If double precision has been used (ITER<0), we want
360 * NORMI(B - A*X)/(NORMI(A)*NORMI(X)*EPS) < THRES
361 * (Cf. the linear solver testing routines)
362 *
363  IF ((thresh.LE.0.0e+00)
364  $ .OR.((iter.GE.0).AND.(n.GT.0)
365  $ .AND.(result(1).GE.sqrt(dble(n))))
366  $ .OR.((iter.LT.0).AND.(result(1).GE.thresh))) THEN
367 *
368  IF( nfail.EQ.0 .AND. nerrs.EQ.0 ) THEN
369  WRITE( nout, fmt = 8999 )'DGE'
370  WRITE( nout, fmt = '( '' Matrix types:'' )' )
371  WRITE( nout, fmt = 8979 )
372  WRITE( nout, fmt = '( '' Test ratios:'' )' )
373  WRITE( nout, fmt = 8960 )1
374  WRITE( nout, fmt = '( '' Messages:'' )' )
375  END IF
376 *
377  WRITE( nout, fmt = 9998 )trans, n, nrhs,
378  $ imat, 1, result( 1 )
379  nfail = nfail + 1
380  END IF
381  nrun = nrun + 1
382  60 CONTINUE
383  100 CONTINUE
384  120 CONTINUE
385 *
386 * Print a summary of the results.
387 *
388  IF( nfail.GT.0 ) THEN
389  WRITE( nout, fmt = 9996 )'ZCGESV', nfail, nrun
390  ELSE
391  WRITE( nout, fmt = 9995 )'ZCGESV', nrun
392  END IF
393  IF( nerrs.GT.0 ) THEN
394  WRITE( nout, fmt = 9994 )nerrs
395  END IF
396 *
397  9998 FORMAT( ' TRANS=''', a1, ''', N =', i5, ', NRHS=', i3, ', type ',
398  $ i2, ', test(', i2, ') =', g12.5 )
399  9996 FORMAT( 1x, a6, ': ', i6, ' out of ', i6,
400  $ ' tests failed to pass the threshold' )
401  9995 FORMAT( /1x, 'All tests for ', a6,
402  $ ' routines passed the threshold ( ', i6, ' tests run)' )
403  9994 FORMAT( 6x, i6, ' error messages recorded' )
404 *
405 * SUBNAM, INFO, INFOE, M, IMAT
406 *
407  9988 FORMAT( ' *** ', a6, ' returned with INFO =', i5, ' instead of ',
408  $ i5, / ' ==> M =', i5, ', type ',
409  $ i2 )
410 *
411 * SUBNAM, INFO, M, IMAT
412 *
413  9975 FORMAT( ' *** Error code from ', a6, '=', i5, ' for M=', i5,
414  $ ', type ', i2 )
415  8999 FORMAT( / 1x, a3, ': General dense matrices' )
416  8979 FORMAT( 4x, '1. Diagonal', 24x, '7. Last n/2 columns zero', / 4x,
417  $ '2. Upper triangular', 16x,
418  $ '8. Random, CNDNUM = sqrt(0.1/EPS)', / 4x,
419  $ '3. Lower triangular', 16x, '9. Random, CNDNUM = 0.1/EPS',
420  $ / 4x, '4. Random, CNDNUM = 2', 13x,
421  $ '10. Scaled near underflow', / 4x, '5. First column zero',
422  $ 14x, '11. Scaled near overflow', / 4x,
423  $ '6. Last column zero' )
424  8960 FORMAT( 3x, i2, ': norm_1( B - A * X ) / ',
425  $ '( norm_1(A) * norm_1(X) * EPS * SQRT(N) ) > 1 if ITERREF',
426  $ / 4x, 'or norm_1( B - A * X ) / ',
427  $ '( norm_1(A) * norm_1(X) * EPS ) > THRES if DGETRF' )
428  RETURN
429 *
430 * End of ZDRVAB
431 *
432  END
subroutine alahd(IOUNIT, PATH)
ALAHD
Definition: alahd.f:107
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
Definition: alaerh.f:147
subroutine zlarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
ZLARHS
Definition: zlarhs.f:208
subroutine zdrvab(DOTYPE, NM, MVAL, NNS, NSVAL, THRESH, NMAX, A, AFAC, B, X, WORK, RWORK, SWORK, IWORK, NOUT)
ZDRVAB
Definition: zdrvab.f:152
subroutine zget08(TRANS, M, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
ZGET08
Definition: zget08.f:133
subroutine zlatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
ZLATB4
Definition: zlatb4.f:121
subroutine zlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
ZLATMS
Definition: zlatms.f:332
subroutine zcgesv(N, NRHS, A, LDA, IPIV, B, LDB, X, LDX, WORK, SWORK, RWORK, ITER, INFO)
ZCGESV computes the solution to system of linear equations A * X = B for GE matrices (mixed precision...
Definition: zcgesv.f:201
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
Definition: zlacpy.f:103
subroutine zlaset(UPLO, M, N, ALPHA, BETA, A, LDA)
ZLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values.
Definition: zlaset.f:106