LAPACK  3.10.1
LAPACK: Linear Algebra PACKage

◆ zchkge()

subroutine zchkge ( logical, dimension( * )  DOTYPE,
integer  NM,
integer, dimension( * )  MVAL,
integer  NN,
integer, dimension( * )  NVAL,
integer  NNB,
integer, dimension( * )  NBVAL,
integer  NNS,
integer, dimension( * )  NSVAL,
double precision  THRESH,
logical  TSTERR,
integer  NMAX,
complex*16, dimension( * )  A,
complex*16, dimension( * )  AFAC,
complex*16, dimension( * )  AINV,
complex*16, dimension( * )  B,
complex*16, dimension( * )  X,
complex*16, dimension( * )  XACT,
complex*16, dimension( * )  WORK,
double precision, dimension( * )  RWORK,
integer, dimension( * )  IWORK,
integer  NOUT 
)

ZCHKGE

Purpose:
 ZCHKGE tests ZGETRF, -TRI, -TRS, -RFS, and -CON.
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]NN
          NN is INTEGER
          The number of values of N contained in the vector NVAL.
[in]NVAL
          NVAL is INTEGER array, dimension (NN)
          The values of the matrix column dimension N.
[in]NNB
          NNB is INTEGER
          The number of values of NB contained in the vector NBVAL.
[in]NBVAL
          NBVAL is INTEGER array, dimension (NNB)
          The values of the blocksize NB.
[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]TSTERR
          TSTERR is LOGICAL
          Flag that indicates whether error exits are to be tested.
[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]AINV
          AINV 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]XACT
          XACT is COMPLEX*16 array, dimension (NMAX*NSMAX)
[out]WORK
          WORK is COMPLEX*16 array, dimension
                      (NMAX*max(3,NSMAX))
[out]RWORK
          RWORK is DOUBLE PRECISION array, dimension
                      (max(2*NMAX,2*NSMAX+NWORK))
[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.

Definition at line 183 of file zchkge.f.

186 *
187 * -- LAPACK test routine --
188 * -- LAPACK is a software package provided by Univ. of Tennessee, --
189 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
190 *
191 * .. Scalar Arguments ..
192  LOGICAL TSTERR
193  INTEGER NM, NMAX, NN, NNB, NNS, NOUT
194  DOUBLE PRECISION THRESH
195 * ..
196 * .. Array Arguments ..
197  LOGICAL DOTYPE( * )
198  INTEGER IWORK( * ), MVAL( * ), NBVAL( * ), NSVAL( * ),
199  $ NVAL( * )
200  DOUBLE PRECISION RWORK( * )
201  COMPLEX*16 A( * ), AFAC( * ), AINV( * ), B( * ),
202  $ WORK( * ), X( * ), XACT( * )
203 * ..
204 *
205 * =====================================================================
206 *
207 * .. Parameters ..
208  DOUBLE PRECISION ONE, ZERO
209  parameter( one = 1.0d+0, zero = 0.0d+0 )
210  INTEGER NTYPES
211  parameter( ntypes = 11 )
212  INTEGER NTESTS
213  parameter( ntests = 8 )
214  INTEGER NTRAN
215  parameter( ntran = 3 )
216 * ..
217 * .. Local Scalars ..
218  LOGICAL TRFCON, ZEROT
219  CHARACTER DIST, NORM, TRANS, TYPE, XTYPE
220  CHARACTER*3 PATH
221  INTEGER I, IM, IMAT, IN, INB, INFO, IOFF, IRHS, ITRAN,
222  $ IZERO, K, KL, KU, LDA, LWORK, M, MODE, N, NB,
223  $ NERRS, NFAIL, NIMAT, NRHS, NRUN, NT
224  DOUBLE PRECISION AINVNM, ANORM, ANORMI, ANORMO, CNDNUM, DUMMY,
225  $ RCOND, RCONDC, RCONDI, RCONDO
226 * ..
227 * .. Local Arrays ..
228  CHARACTER TRANSS( NTRAN )
229  INTEGER ISEED( 4 ), ISEEDY( 4 )
230  DOUBLE PRECISION RESULT( NTESTS )
231 * ..
232 * .. External Functions ..
233  DOUBLE PRECISION DGET06, ZLANGE
234  EXTERNAL dget06, zlange
235 * ..
236 * .. External Subroutines ..
237  EXTERNAL alaerh, alahd, alasum, xlaenv, zerrge, zgecon,
240  $ zlatb4, zlatms
241 * ..
242 * .. Intrinsic Functions ..
243  INTRINSIC dcmplx, max, min
244 * ..
245 * .. Scalars in Common ..
246  LOGICAL LERR, OK
247  CHARACTER*32 SRNAMT
248  INTEGER INFOT, NUNIT
249 * ..
250 * .. Common blocks ..
251  COMMON / infoc / infot, nunit, ok, lerr
252  COMMON / srnamc / srnamt
253 * ..
254 * .. Data statements ..
255  DATA iseedy / 1988, 1989, 1990, 1991 / ,
256  $ transs / 'N', 'T', 'C' /
257 * ..
258 * .. Executable Statements ..
259 *
260 * Initialize constants and the random number seed.
261 *
262  path( 1: 1 ) = 'Zomplex precision'
263  path( 2: 3 ) = 'GE'
264  nrun = 0
265  nfail = 0
266  nerrs = 0
267  DO 10 i = 1, 4
268  iseed( i ) = iseedy( i )
269  10 CONTINUE
270 *
271 * Test the error exits
272 *
273  CALL xlaenv( 1, 1 )
274  IF( tsterr )
275  $ CALL zerrge( path, nout )
276  infot = 0
277  CALL xlaenv( 2, 2 )
278 *
279 * Do for each value of M in MVAL
280 *
281  DO 120 im = 1, nm
282  m = mval( im )
283  lda = max( 1, m )
284 *
285 * Do for each value of N in NVAL
286 *
287  DO 110 in = 1, nn
288  n = nval( in )
289  xtype = 'N'
290  nimat = ntypes
291  IF( m.LE.0 .OR. n.LE.0 )
292  $ nimat = 1
293 *
294  DO 100 imat = 1, nimat
295 *
296 * Do the tests only if DOTYPE( IMAT ) is true.
297 *
298  IF( .NOT.dotype( imat ) )
299  $ GO TO 100
300 *
301 * Skip types 5, 6, or 7 if the matrix size is too small.
302 *
303  zerot = imat.GE.5 .AND. imat.LE.7
304  IF( zerot .AND. n.LT.imat-4 )
305  $ GO TO 100
306 *
307 * Set up parameters with ZLATB4 and generate a test matrix
308 * with ZLATMS.
309 *
310  CALL zlatb4( path, imat, m, n, TYPE, KL, KU, ANORM, MODE,
311  $ CNDNUM, DIST )
312 *
313  srnamt = 'ZLATMS'
314  CALL zlatms( m, n, dist, iseed, TYPE, RWORK, MODE,
315  $ CNDNUM, ANORM, KL, KU, 'No packing', A, LDA,
316  $ WORK, INFO )
317 *
318 * Check error code from ZLATMS.
319 *
320  IF( info.NE.0 ) THEN
321  CALL alaerh( path, 'ZLATMS', info, 0, ' ', m, n, -1,
322  $ -1, -1, imat, nfail, nerrs, nout )
323  GO TO 100
324  END IF
325 *
326 * For types 5-7, zero one or more columns of the matrix to
327 * test that INFO is returned correctly.
328 *
329  IF( zerot ) THEN
330  IF( imat.EQ.5 ) THEN
331  izero = 1
332  ELSE IF( imat.EQ.6 ) THEN
333  izero = min( m, n )
334  ELSE
335  izero = min( m, n ) / 2 + 1
336  END IF
337  ioff = ( izero-1 )*lda
338  IF( imat.LT.7 ) THEN
339  DO 20 i = 1, m
340  a( ioff+i ) = zero
341  20 CONTINUE
342  ELSE
343  CALL zlaset( 'Full', m, n-izero+1, dcmplx( zero ),
344  $ dcmplx( zero ), a( ioff+1 ), lda )
345  END IF
346  ELSE
347  izero = 0
348  END IF
349 *
350 * These lines, if used in place of the calls in the DO 60
351 * loop, cause the code to bomb on a Sun SPARCstation.
352 *
353 * ANORMO = ZLANGE( 'O', M, N, A, LDA, RWORK )
354 * ANORMI = ZLANGE( 'I', M, N, A, LDA, RWORK )
355 *
356 * Do for each blocksize in NBVAL
357 *
358  DO 90 inb = 1, nnb
359  nb = nbval( inb )
360  CALL xlaenv( 1, nb )
361 *
362 * Compute the LU factorization of the matrix.
363 *
364  CALL zlacpy( 'Full', m, n, a, lda, afac, lda )
365  srnamt = 'ZGETRF'
366  CALL zgetrf( m, n, afac, lda, iwork, info )
367 *
368 * Check error code from ZGETRF.
369 *
370  IF( info.NE.izero )
371  $ CALL alaerh( path, 'ZGETRF', info, izero, ' ', m,
372  $ n, -1, -1, nb, imat, nfail, nerrs,
373  $ nout )
374  trfcon = .false.
375 *
376 *+ TEST 1
377 * Reconstruct matrix from factors and compute residual.
378 *
379  CALL zlacpy( 'Full', m, n, afac, lda, ainv, lda )
380  CALL zget01( m, n, a, lda, ainv, lda, iwork, rwork,
381  $ result( 1 ) )
382  nt = 1
383 *
384 *+ TEST 2
385 * Form the inverse if the factorization was successful
386 * and compute the residual.
387 *
388  IF( m.EQ.n .AND. info.EQ.0 ) THEN
389  CALL zlacpy( 'Full', n, n, afac, lda, ainv, lda )
390  srnamt = 'ZGETRI'
391  nrhs = nsval( 1 )
392  lwork = nmax*max( 3, nrhs )
393  CALL zgetri( n, ainv, lda, iwork, work, lwork,
394  $ info )
395 *
396 * Check error code from ZGETRI.
397 *
398  IF( info.NE.0 )
399  $ CALL alaerh( path, 'ZGETRI', info, 0, ' ', n, n,
400  $ -1, -1, nb, imat, nfail, nerrs,
401  $ nout )
402 *
403 * Compute the residual for the matrix times its
404 * inverse. Also compute the 1-norm condition number
405 * of A.
406 *
407  CALL zget03( n, a, lda, ainv, lda, work, lda,
408  $ rwork, rcondo, result( 2 ) )
409  anormo = zlange( 'O', m, n, a, lda, rwork )
410 *
411 * Compute the infinity-norm condition number of A.
412 *
413  anormi = zlange( 'I', m, n, a, lda, rwork )
414  ainvnm = zlange( 'I', n, n, ainv, lda, rwork )
415  IF( anormi.LE.zero .OR. ainvnm.LE.zero ) THEN
416  rcondi = one
417  ELSE
418  rcondi = ( one / anormi ) / ainvnm
419  END IF
420  nt = 2
421  ELSE
422 *
423 * Do only the condition estimate if INFO > 0.
424 *
425  trfcon = .true.
426  anormo = zlange( 'O', m, n, a, lda, rwork )
427  anormi = zlange( 'I', m, n, a, lda, rwork )
428  rcondo = zero
429  rcondi = zero
430  END IF
431 *
432 * Print information about the tests so far that did not
433 * pass the threshold.
434 *
435  DO 30 k = 1, nt
436  IF( result( k ).GE.thresh ) THEN
437  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
438  $ CALL alahd( nout, path )
439  WRITE( nout, fmt = 9999 )m, n, nb, imat, k,
440  $ result( k )
441  nfail = nfail + 1
442  END IF
443  30 CONTINUE
444  nrun = nrun + nt
445 *
446 * Skip the remaining tests if this is not the first
447 * block size or if M .ne. N. Skip the solve tests if
448 * the matrix is singular.
449 *
450  IF( inb.GT.1 .OR. m.NE.n )
451  $ GO TO 90
452  IF( trfcon )
453  $ GO TO 70
454 *
455  DO 60 irhs = 1, nns
456  nrhs = nsval( irhs )
457  xtype = 'N'
458 *
459  DO 50 itran = 1, ntran
460  trans = transs( itran )
461  IF( itran.EQ.1 ) THEN
462  rcondc = rcondo
463  ELSE
464  rcondc = rcondi
465  END IF
466 *
467 *+ TEST 3
468 * Solve and compute residual for A * X = B.
469 *
470  srnamt = 'ZLARHS'
471  CALL zlarhs( path, xtype, ' ', trans, n, n, kl,
472  $ ku, nrhs, a, lda, xact, lda, b,
473  $ lda, iseed, info )
474  xtype = 'C'
475 *
476  CALL zlacpy( 'Full', n, nrhs, b, lda, x, lda )
477  srnamt = 'ZGETRS'
478  CALL zgetrs( trans, n, nrhs, afac, lda, iwork,
479  $ x, lda, info )
480 *
481 * Check error code from ZGETRS.
482 *
483  IF( info.NE.0 )
484  $ CALL alaerh( path, 'ZGETRS', info, 0, trans,
485  $ n, n, -1, -1, nrhs, imat, nfail,
486  $ nerrs, nout )
487 *
488  CALL zlacpy( 'Full', n, nrhs, b, lda, work,
489  $ lda )
490  CALL zget02( trans, n, n, nrhs, a, lda, x, lda,
491  $ work, lda, rwork, result( 3 ) )
492 *
493 *+ TEST 4
494 * Check solution from generated exact solution.
495 *
496  CALL zget04( n, nrhs, x, lda, xact, lda, rcondc,
497  $ result( 4 ) )
498 *
499 *+ TESTS 5, 6, and 7
500 * Use iterative refinement to improve the
501 * solution.
502 *
503  srnamt = 'ZGERFS'
504  CALL zgerfs( trans, n, nrhs, a, lda, afac, lda,
505  $ iwork, b, lda, x, lda, rwork,
506  $ rwork( nrhs+1 ), work,
507  $ rwork( 2*nrhs+1 ), info )
508 *
509 * Check error code from ZGERFS.
510 *
511  IF( info.NE.0 )
512  $ CALL alaerh( path, 'ZGERFS', info, 0, trans,
513  $ n, n, -1, -1, nrhs, imat, nfail,
514  $ nerrs, nout )
515 *
516  CALL zget04( n, nrhs, x, lda, xact, lda, rcondc,
517  $ result( 5 ) )
518  CALL zget07( trans, n, nrhs, a, lda, b, lda, x,
519  $ lda, xact, lda, rwork, .true.,
520  $ rwork( nrhs+1 ), result( 6 ) )
521 *
522 * Print information about the tests that did not
523 * pass the threshold.
524 *
525  DO 40 k = 3, 7
526  IF( result( k ).GE.thresh ) THEN
527  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
528  $ CALL alahd( nout, path )
529  WRITE( nout, fmt = 9998 )trans, n, nrhs,
530  $ imat, k, result( k )
531  nfail = nfail + 1
532  END IF
533  40 CONTINUE
534  nrun = nrun + 5
535  50 CONTINUE
536  60 CONTINUE
537 *
538 *+ TEST 8
539 * Get an estimate of RCOND = 1/CNDNUM.
540 *
541  70 CONTINUE
542  DO 80 itran = 1, 2
543  IF( itran.EQ.1 ) THEN
544  anorm = anormo
545  rcondc = rcondo
546  norm = 'O'
547  ELSE
548  anorm = anormi
549  rcondc = rcondi
550  norm = 'I'
551  END IF
552  srnamt = 'ZGECON'
553  CALL zgecon( norm, n, afac, lda, anorm, rcond,
554  $ work, rwork, info )
555 *
556 * Check error code from ZGECON.
557 *
558  IF( info.NE.0 )
559  $ CALL alaerh( path, 'ZGECON', info, 0, norm, n,
560  $ n, -1, -1, -1, imat, nfail, nerrs,
561  $ nout )
562 *
563 * This line is needed on a Sun SPARCstation.
564 *
565  dummy = rcond
566 *
567  result( 8 ) = dget06( rcond, rcondc )
568 *
569 * Print information about the tests that did not pass
570 * the threshold.
571 *
572  IF( result( 8 ).GE.thresh ) THEN
573  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
574  $ CALL alahd( nout, path )
575  WRITE( nout, fmt = 9997 )norm, n, imat, 8,
576  $ result( 8 )
577  nfail = nfail + 1
578  END IF
579  nrun = nrun + 1
580  80 CONTINUE
581  90 CONTINUE
582  100 CONTINUE
583 *
584  110 CONTINUE
585  120 CONTINUE
586 *
587 * Print a summary of the results.
588 *
589  CALL alasum( path, nout, nfail, nrun, nerrs )
590 *
591  9999 FORMAT( ' M = ', i5, ', N =', i5, ', NB =', i4, ', type ', i2,
592  $ ', test(', i2, ') =', g12.5 )
593  9998 FORMAT( ' TRANS=''', a1, ''', N =', i5, ', NRHS=', i3, ', type ',
594  $ i2, ', test(', i2, ') =', g12.5 )
595  9997 FORMAT( ' NORM =''', a1, ''', N =', i5, ',', 10x, ' type ', i2,
596  $ ', test(', i2, ') =', g12.5 )
597  RETURN
598 *
599 * End of ZCHKGE
600 *
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
Definition: alasum.f:73
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
Definition: xlaenv.f:81
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 zget02(TRANS, M, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
ZGET02
Definition: zget02.f:134
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 zget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
ZGET04
Definition: zget04.f:102
subroutine zerrge(PATH, NUNIT)
ZERRGE
Definition: zerrge.f:55
subroutine zget01(M, N, A, LDA, AFAC, LDAFAC, IPIV, RWORK, RESID)
ZGET01
Definition: zget01.f:108
subroutine zlatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
ZLATB4
Definition: zlatb4.f:121
subroutine zget07(TRANS, N, NRHS, A, LDA, B, LDB, X, LDX, XACT, LDXACT, FERR, CHKFERR, BERR, RESLTS)
ZGET07
Definition: zget07.f:166
subroutine zget03(N, A, LDA, AINV, LDAINV, WORK, LDWORK, RWORK, RCOND, RESID)
ZGET03
Definition: zget03.f:110
subroutine zlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
ZLATMS
Definition: zlatms.f:332
double precision function zlange(NORM, M, N, A, LDA, WORK)
ZLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
Definition: zlange.f:115
subroutine zgetrs(TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
ZGETRS
Definition: zgetrs.f:121
subroutine zgerfs(TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
ZGERFS
Definition: zgerfs.f:186
subroutine zgetri(N, A, LDA, IPIV, WORK, LWORK, INFO)
ZGETRI
Definition: zgetri.f:114
subroutine zgecon(NORM, N, A, LDA, ANORM, RCOND, WORK, RWORK, INFO)
ZGECON
Definition: zgecon.f:124
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
double precision function dget06(RCOND, RCONDC)
DGET06
Definition: dget06.f:55
subroutine zgetrf(M, N, A, LDA, IPIV, INFO)
ZGETRF VARIANT: Crout Level 3 BLAS version of the algorithm.
Definition: zgetrf.f:102
Here is the call graph for this function:
Here is the caller graph for this function: