LAPACK  3.8.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.```
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 *
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:149
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
subroutine zlatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
ZLATB4
Definition: zlatb4.f:123
subroutine zget08(TRANS, M, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
ZGET08
Definition: zget08.f:135
subroutine zlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
ZLATMS
Definition: zlatms.f:334
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
subroutine zlarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
ZLARHS
Definition: zlarhs.f:211
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 precisio...
Definition: zcgesv.f:203
Here is the call graph for this function:
Here is the caller graph for this function: