LAPACK  3.9.0
LAPACK: Linear Algebra PACKage

◆ zdrvab()

subroutine zdrvab ( logical, dimension( * )  DOTYPE,
integer  NM,
integer, dimension( * )  MVAL,
integer  NNS,
integer, dimension( * )  NSVAL,
double precision  THRESH,
integer  NMAX,
complex*16, dimension( * )  A,
complex*16, dimension( * )  AFAC,
complex*16, dimension( * )  B,
complex*16, dimension( * )  X,
complex*16, dimension( * )  WORK,
double precision, dimension( * )  RWORK,
complex, dimension( * )  SWORK,
integer, dimension( * )  IWORK,
integer  NOUT 
)

ZDRVAB

Purpose:
 ZDRVAB tests ZCGESV
Parameters
[in]DOTYPE
          DOTYPE is LOGICAL array, dimension (NTYPES)
          The matrix types to be used for testing.  Matrices of type j
          (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
          .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
[in]NM
          NM is INTEGER
          The number of values of M contained in the vector MVAL.
[in]MVAL
          MVAL is INTEGER array, dimension (NM)
          The values of the matrix row dimension M.
[in]NNS
          NNS is INTEGER
          The number of values of NRHS contained in the vector NSVAL.
[in]NSVAL
          NSVAL is INTEGER array, dimension (NNS)
          The values of the number of right hand sides NRHS.
[in]THRESH
          THRESH is DOUBLE PRECISION
          The threshold value for the test ratios.  A result is
          included in the output file if RESULT >= THRESH.  To have
          every test ratio printed, use THRESH = 0.
[in]NMAX
          NMAX is INTEGER
          The maximum value permitted for M or N, used in dimensioning
          the work arrays.
[out]A
          A is COMPLEX*16 array, dimension (NMAX*NMAX)
[out]AFAC
          AFAC is COMPLEX*16 array, dimension (NMAX*NMAX)
[out]B
          B is COMPLEX*16 array, dimension (NMAX*NSMAX)
          where NSMAX is the largest entry in NSVAL.
[out]X
          X is COMPLEX*16 array, dimension (NMAX*NSMAX)
[out]WORK
          WORK is COMPLEX*16 array, dimension
                      (NMAX*max(3,NSMAX*2))
[out]RWORK
          RWORK is DOUBLE PRECISION array, dimension
                      NMAX
[out]SWORK
          SWORK is COMPLEX array, dimension
                      (NMAX*(NSMAX+NMAX))
[out]IWORK
          IWORK is INTEGER array, dimension
                      NMAX
[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
December 2016

Definition at line 154 of file zdrvab.f.

154 *
155 * -- LAPACK test routine (version 3.7.0) --
156 * -- LAPACK is a software package provided by Univ. of Tennessee, --
157 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
158 * December 2016
159 *
160 * .. Scalar Arguments ..
161  INTEGER NM, NMAX, NNS, NOUT
162  DOUBLE PRECISION THRESH
163 * ..
164 * .. Array Arguments ..
165  LOGICAL DOTYPE( * )
166  INTEGER MVAL( * ), NSVAL( * ), IWORK( * )
167  DOUBLE PRECISION RWORK( * )
168  COMPLEX SWORK( * )
169  COMPLEX*16 A( * ), AFAC( * ), B( * ),
170  $ WORK( * ), X( * )
171 * ..
172 *
173 * =====================================================================
174 *
175 * .. Parameters ..
176  DOUBLE PRECISION ZERO
177  parameter( zero = 0.0d+0 )
178  INTEGER NTYPES
179  parameter( ntypes = 11 )
180  INTEGER NTESTS
181  parameter( ntests = 1 )
182 * ..
183 * .. Local Scalars ..
184  LOGICAL ZEROT
185  CHARACTER DIST, TRANS, TYPE, XTYPE
186  CHARACTER*3 PATH
187  INTEGER I, IM, IMAT, INFO, IOFF, IRHS,
188  $ IZERO, KL, KU, LDA, M, MODE, N,
189  $ NERRS, NFAIL, NIMAT, NRHS, NRUN
190  DOUBLE PRECISION ANORM, CNDNUM
191 * ..
192 * .. Local Arrays ..
193  INTEGER ISEED( 4 ), ISEEDY( 4 )
194  DOUBLE PRECISION RESULT( NTESTS )
195 * ..
196 * .. Local Variables ..
197  INTEGER ITER, KASE
198 * ..
199 * .. External Subroutines ..
200  EXTERNAL alaerh, alahd, zget08, zlacpy, zlarhs, zlaset,
201  $ zlatb4, zlatms
202 * ..
203 * .. Intrinsic Functions ..
204  INTRINSIC dcmplx, dble, max, min, sqrt
205 * ..
206 * .. Scalars in Common ..
207  LOGICAL LERR, OK
208  CHARACTER*32 SRNAMT
209  INTEGER INFOT, NUNIT
210 * ..
211 * .. Common blocks ..
212  COMMON / infoc / infot, nunit, ok, lerr
213  COMMON / srnamc / srnamt
214 * ..
215 * .. Data statements ..
216  DATA iseedy / 2006, 2007, 2008, 2009 /
217 * ..
218 * .. Executable Statements ..
219 *
220 * Initialize constants and the random number seed.
221 *
222  kase = 0
223  path( 1: 1 ) = 'Zomplex precision'
224  path( 2: 3 ) = 'GE'
225  nrun = 0
226  nfail = 0
227  nerrs = 0
228  DO 10 i = 1, 4
229  iseed( i ) = iseedy( i )
230  10 CONTINUE
231 *
232  infot = 0
233 *
234 * Do for each value of M in MVAL
235 *
236  DO 120 im = 1, nm
237  m = mval( im )
238  lda = max( 1, m )
239 *
240  n = m
241  nimat = ntypes
242  IF( m.LE.0 .OR. n.LE.0 )
243  $ nimat = 1
244 *
245  DO 100 imat = 1, nimat
246 *
247 * Do the tests only if DOTYPE( IMAT ) is true.
248 *
249  IF( .NOT.dotype( imat ) )
250  $ GO TO 100
251 *
252 * Skip types 5, 6, or 7 if the matrix size is too small.
253 *
254  zerot = imat.GE.5 .AND. imat.LE.7
255  IF( zerot .AND. n.LT.imat-4 )
256  $ GO TO 100
257 *
258 * Set up parameters with ZLATB4 and generate a test matrix
259 * with ZLATMS.
260 *
261  CALL zlatb4( path, imat, m, n, TYPE, KL, KU, ANORM, MODE,
262  $ CNDNUM, DIST )
263 *
264  srnamt = 'ZLATMS'
265  CALL zlatms( m, n, dist, iseed, TYPE, RWORK, MODE,
266  $ CNDNUM, ANORM, KL, KU, 'No packing', A, LDA,
267  $ WORK, INFO )
268 *
269 * Check error code from ZLATMS.
270 *
271  IF( info.NE.0 ) THEN
272  CALL alaerh( path, 'ZLATMS', info, 0, ' ', m, n, -1,
273  $ -1, -1, imat, nfail, nerrs, nout )
274  GO TO 100
275  END IF
276 *
277 * For types 5-7, zero one or more columns of the matrix to
278 * test that INFO is returned correctly.
279 *
280  IF( zerot ) THEN
281  IF( imat.EQ.5 ) THEN
282  izero = 1
283  ELSE IF( imat.EQ.6 ) THEN
284  izero = min( m, n )
285  ELSE
286  izero = min( m, n ) / 2 + 1
287  END IF
288  ioff = ( izero-1 )*lda
289  IF( imat.LT.7 ) THEN
290  DO 20 i = 1, m
291  a( ioff+i ) = zero
292  20 CONTINUE
293  ELSE
294  CALL zlaset( 'Full', m, n-izero+1, dcmplx(zero),
295  $ dcmplx(zero), a( ioff+1 ), lda )
296  END IF
297  ELSE
298  izero = 0
299  END IF
300 *
301  DO 60 irhs = 1, nns
302  nrhs = nsval( irhs )
303  xtype = 'N'
304  trans = 'N'
305 *
306  srnamt = 'ZLARHS'
307  CALL zlarhs( path, xtype, ' ', trans, n, n, kl,
308  $ ku, nrhs, a, lda, x, lda, b,
309  $ lda, iseed, info )
310 *
311  srnamt = 'ZCGESV'
312 *
313  kase = kase + 1
314 *
315  CALL zlacpy( 'Full', m, n, a, lda, afac, lda )
316 *
317  CALL zcgesv( n, nrhs, a, lda, iwork, b, lda, x, lda,
318  $ work, swork, rwork, iter, info)
319 *
320  IF (iter.LT.0) THEN
321  CALL zlacpy( 'Full', m, n, afac, lda, a, lda )
322  ENDIF
323 *
324 * Check error code from ZCGESV. This should be the same as
325 * the one of DGETRF.
326 *
327  IF( info.NE.izero ) THEN
328 *
329  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
330  $ CALL alahd( nout, path )
331  nerrs = nerrs + 1
332 *
333  IF( info.NE.izero .AND. izero.NE.0 ) THEN
334  WRITE( nout, fmt = 9988 )'ZCGESV',info,
335  $ izero,m,imat
336  ELSE
337  WRITE( nout, fmt = 9975 )'ZCGESV',info,
338  $ m, imat
339  END IF
340  END IF
341 *
342 * Skip the remaining test if the matrix is singular.
343 *
344  IF( info.NE.0 )
345  $ GO TO 100
346 *
347 * Check the quality of the solution
348 *
349  CALL zlacpy( 'Full', n, nrhs, b, lda, work, lda )
350 *
351  CALL zget08( trans, n, n, nrhs, a, lda, x, lda, work,
352  $ lda, rwork, result( 1 ) )
353 *
354 * Check if the test passes the tesing.
355 * Print information about the tests that did not
356 * pass the testing.
357 *
358 * If iterative refinement has been used and claimed to
359 * be successful (ITER>0), we want
360 * NORMI(B - A*X)/(NORMI(A)*NORMI(X)*EPS*SRQT(N)) < 1
361 *
362 * If double precision has been used (ITER<0), we want
363 * NORMI(B - A*X)/(NORMI(A)*NORMI(X)*EPS) < THRES
364 * (Cf. the linear solver testing routines)
365 *
366  IF ((thresh.LE.0.0e+00)
367  $ .OR.((iter.GE.0).AND.(n.GT.0)
368  $ .AND.(result(1).GE.sqrt(dble(n))))
369  $ .OR.((iter.LT.0).AND.(result(1).GE.thresh))) THEN
370 *
371  IF( nfail.EQ.0 .AND. nerrs.EQ.0 ) THEN
372  WRITE( nout, fmt = 8999 )'DGE'
373  WRITE( nout, fmt = '( '' Matrix types:'' )' )
374  WRITE( nout, fmt = 8979 )
375  WRITE( nout, fmt = '( '' Test ratios:'' )' )
376  WRITE( nout, fmt = 8960 )1
377  WRITE( nout, fmt = '( '' Messages:'' )' )
378  END IF
379 *
380  WRITE( nout, fmt = 9998 )trans, n, nrhs,
381  $ imat, 1, result( 1 )
382  nfail = nfail + 1
383  END IF
384  nrun = nrun + 1
385  60 CONTINUE
386  100 CONTINUE
387  120 CONTINUE
388 *
389 * Print a summary of the results.
390 *
391  IF( nfail.GT.0 ) THEN
392  WRITE( nout, fmt = 9996 )'ZCGESV', nfail, nrun
393  ELSE
394  WRITE( nout, fmt = 9995 )'ZCGESV', nrun
395  END IF
396  IF( nerrs.GT.0 ) THEN
397  WRITE( nout, fmt = 9994 )nerrs
398  END IF
399 *
400  9998 FORMAT( ' TRANS=''', a1, ''', N =', i5, ', NRHS=', i3, ', type ',
401  $ i2, ', test(', i2, ') =', g12.5 )
402  9996 FORMAT( 1x, a6, ': ', i6, ' out of ', i6,
403  $ ' tests failed to pass the threshold' )
404  9995 FORMAT( /1x, 'All tests for ', a6,
405  $ ' routines passed the threshold ( ', i6, ' tests run)' )
406  9994 FORMAT( 6x, i6, ' error messages recorded' )
407 *
408 * SUBNAM, INFO, INFOE, M, IMAT
409 *
410  9988 FORMAT( ' *** ', a6, ' returned with INFO =', i5, ' instead of ',
411  $ i5, / ' ==> M =', i5, ', type ',
412  $ i2 )
413 *
414 * SUBNAM, INFO, M, IMAT
415 *
416  9975 FORMAT( ' *** Error code from ', a6, '=', i5, ' for M=', i5,
417  $ ', type ', i2 )
418  8999 FORMAT( / 1x, a3, ': General dense matrices' )
419  8979 FORMAT( 4x, '1. Diagonal', 24x, '7. Last n/2 columns zero', / 4x,
420  $ '2. Upper triangular', 16x,
421  $ '8. Random, CNDNUM = sqrt(0.1/EPS)', / 4x,
422  $ '3. Lower triangular', 16x, '9. Random, CNDNUM = 0.1/EPS',
423  $ / 4x, '4. Random, CNDNUM = 2', 13x,
424  $ '10. Scaled near underflow', / 4x, '5. First column zero',
425  $ 14x, '11. Scaled near overflow', / 4x,
426  $ '6. Last column zero' )
427  8960 FORMAT( 3x, i2, ': norm_1( B - A * X ) / ',
428  $ '( norm_1(A) * norm_1(X) * EPS * SQRT(N) ) > 1 if ITERREF',
429  $ / 4x, 'or norm_1( B - A * X ) / ',
430  $ '( norm_1(A) * norm_1(X) * EPS ) > THRES if DGETRF' )
431  RETURN
432 *
433 * End of ZDRVAB
434 *
Here is the call graph for this function:
Here is the caller graph for this function:
zlarhs
subroutine zlarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
ZLARHS
Definition: zlarhs.f:211
alahd
subroutine alahd(IOUNIT, PATH)
ALAHD
Definition: alahd.f:109
zcgesv
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:203
zlaset
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:108
zget08
subroutine zget08(TRANS, M, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
ZGET08
Definition: zget08.f:135
zlacpy
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
Definition: zlacpy.f:105
alaerh
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
Definition: alaerh.f:149
zlatb4
subroutine zlatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
ZLATB4
Definition: zlatb4.f:123
zlatms
subroutine zlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
ZLATMS
Definition: zlatms.f:334