LAPACK  3.7.1
LAPACK: Linear Algebra PACKage

◆ cchkgt()

subroutine cchkgt ( logical, dimension( * )  DOTYPE,
integer  NN,
integer, dimension( * )  NVAL,
integer  NNS,
integer, dimension( * )  NSVAL,
real  THRESH,
logical  TSTERR,
complex, dimension( * )  A,
complex, dimension( * )  AF,
complex, dimension( * )  B,
complex, dimension( * )  X,
complex, dimension( * )  XACT,
complex, dimension( * )  WORK,
real, dimension( * )  RWORK,
integer, dimension( * )  IWORK,
integer  NOUT 
)

CCHKGT

Purpose: 
 CCHKGT tests CGTTRF, -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]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 dimension N.
[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 REAL
          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.
[out]A
          A is COMPLEX array, dimension (NMAX*4)
[out]AF
          AF is COMPLEX array, dimension (NMAX*4)
[out]B
          B is COMPLEX array, dimension (NMAX*NSMAX)
          where NSMAX is the largest entry in NSVAL.
[out]X
          X is COMPLEX array, dimension (NMAX*NSMAX)
[out]XACT
          XACT is COMPLEX array, dimension (NMAX*NSMAX)
[out]WORK
          WORK is COMPLEX array, dimension
                      (NMAX*max(3,NSMAX))
[out]RWORK
          RWORK is REAL array, dimension
                      (max(NMAX)+2*NSMAX)
[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 149 of file cchkgt.f.

149 *
150 * -- LAPACK test routine (version 3.7.0) --
151 * -- LAPACK is a software package provided by Univ. of Tennessee, --
152 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
153 * December 2016
154 *
155 * .. Scalar Arguments ..
156  LOGICAL tsterr
157  INTEGER nn, nns, nout
158  REAL thresh
159 * ..
160 * .. Array Arguments ..
161  LOGICAL dotype( * )
162  INTEGER iwork( * ), nsval( * ), nval( * )
163  REAL rwork( * )
164  COMPLEX a( * ), af( * ), b( * ), work( * ), x( * ),
165  $ xact( * )
166 * ..
167 *
168 * =====================================================================
169 *
170 * .. Parameters ..
171  REAL one, zero
172  parameter( one = 1.0e+0, zero = 0.0e+0 )
173  INTEGER ntypes
174  parameter( ntypes = 12 )
175  INTEGER ntests
176  parameter( ntests = 7 )
177 * ..
178 * .. Local Scalars ..
179  LOGICAL trfcon, zerot
180  CHARACTER dist, norm, trans, type
181  CHARACTER*3 path
182  INTEGER i, imat, in, info, irhs, itran, ix, izero, j,
183  $ k, kl, koff, ku, lda, m, mode, n, nerrs, nfail,
184  $ nimat, nrhs, nrun
185  REAL ainvnm, anorm, cond, rcond, rcondc, rcondi,
186  $ rcondo
187 * ..
188 * .. Local Arrays ..
189  CHARACTER transs( 3 )
190  INTEGER iseed( 4 ), iseedy( 4 )
191  REAL result( ntests )
192  COMPLEX z( 3 )
193 * ..
194 * .. External Functions ..
195  REAL clangt, scasum, sget06
196  EXTERNAL clangt, scasum, sget06
197 * ..
198 * .. External Subroutines ..
199  EXTERNAL alaerh, alahd, alasum, ccopy, cerrge, cget04,
200  $ cgtcon, cgtrfs, cgtt01, cgtt02, cgtt05, cgttrf,
201  $ cgttrs, clacpy, clagtm, clarnv, clatb4, clatms,
202  $ csscal
203 * ..
204 * .. Intrinsic Functions ..
205  INTRINSIC max
206 * ..
207 * .. Scalars in Common ..
208  LOGICAL lerr, ok
209  CHARACTER*32 srnamt
210  INTEGER infot, nunit
211 * ..
212 * .. Common blocks ..
213  COMMON / infoc / infot, nunit, ok, lerr
214  COMMON / srnamc / srnamt
215 * ..
216 * .. Data statements ..
217  DATA iseedy / 0, 0, 0, 1 / , transs / 'N', 'T',
218  $ 'C' /
219 * ..
220 * .. Executable Statements ..
221 *
222  path( 1: 1 ) = 'Complex precision'
223  path( 2: 3 ) = 'GT'
224  nrun = 0
225  nfail = 0
226  nerrs = 0
227  DO 10 i = 1, 4
228  iseed( i ) = iseedy( i )
229  10 CONTINUE
230 *
231 * Test the error exits
232 *
233  IF( tsterr )
234  $ CALL cerrge( path, nout )
235  infot = 0
236 *
237  DO 110 in = 1, nn
238 *
239 * Do for each value of N in NVAL.
240 *
241  n = nval( in )
242  m = max( n-1, 0 )
243  lda = max( 1, n )
244  nimat = ntypes
245  IF( n.LE.0 )
246  $ nimat = 1
247 *
248  DO 100 imat = 1, nimat
249 *
250 * Do the tests only if DOTYPE( IMAT ) is true.
251 *
252  IF( .NOT.dotype( imat ) )
253  $ GO TO 100
254 *
255 * Set up parameters with CLATB4.
256 *
257  CALL clatb4( path, imat, n, n, TYPE, kl, ku, anorm, mode,
258  $ cond, dist )
259 *
260  zerot = imat.GE.8 .AND. imat.LE.10
261  IF( imat.LE.6 ) THEN
262 *
263 * Types 1-6: generate matrices of known condition number.
264 *
265  koff = max( 2-ku, 3-max( 1, n ) )
266  srnamt = 'CLATMS'
267  CALL clatms( n, n, dist, iseed, TYPE, rwork, mode, cond,
268  $ anorm, kl, ku, 'Z', af( koff ), 3, work,
269  $ info )
270 *
271 * Check the error code from CLATMS.
272 *
273  IF( info.NE.0 ) THEN
274  CALL alaerh( path, 'CLATMS', info, 0, ' ', n, n, kl,
275  $ ku, -1, imat, nfail, nerrs, nout )
276  GO TO 100
277  END IF
278  izero = 0
279 *
280  IF( n.GT.1 ) THEN
281  CALL ccopy( n-1, af( 4 ), 3, a, 1 )
282  CALL ccopy( n-1, af( 3 ), 3, a( n+m+1 ), 1 )
283  END IF
284  CALL ccopy( n, af( 2 ), 3, a( m+1 ), 1 )
285  ELSE
286 *
287 * Types 7-12: generate tridiagonal matrices with
288 * unknown condition numbers.
289 *
290  IF( .NOT.zerot .OR. .NOT.dotype( 7 ) ) THEN
291 *
292 * Generate a matrix with elements whose real and
293 * imaginary parts are from [-1,1].
294 *
295  CALL clarnv( 2, iseed, n+2*m, a )
296  IF( anorm.NE.one )
297  $ CALL csscal( n+2*m, anorm, a, 1 )
298  ELSE IF( izero.GT.0 ) THEN
299 *
300 * Reuse the last matrix by copying back the zeroed out
301 * elements.
302 *
303  IF( izero.EQ.1 ) THEN
304  a( n ) = z( 2 )
305  IF( n.GT.1 )
306  $ a( 1 ) = z( 3 )
307  ELSE IF( izero.EQ.n ) THEN
308  a( 3*n-2 ) = z( 1 )
309  a( 2*n-1 ) = z( 2 )
310  ELSE
311  a( 2*n-2+izero ) = z( 1 )
312  a( n-1+izero ) = z( 2 )
313  a( izero ) = z( 3 )
314  END IF
315  END IF
316 *
317 * If IMAT > 7, set one column of the matrix to 0.
318 *
319  IF( .NOT.zerot ) THEN
320  izero = 0
321  ELSE IF( imat.EQ.8 ) THEN
322  izero = 1
323  z( 2 ) = a( n )
324  a( n ) = zero
325  IF( n.GT.1 ) THEN
326  z( 3 ) = a( 1 )
327  a( 1 ) = zero
328  END IF
329  ELSE IF( imat.EQ.9 ) THEN
330  izero = n
331  z( 1 ) = a( 3*n-2 )
332  z( 2 ) = a( 2*n-1 )
333  a( 3*n-2 ) = zero
334  a( 2*n-1 ) = zero
335  ELSE
336  izero = ( n+1 ) / 2
337  DO 20 i = izero, n - 1
338  a( 2*n-2+i ) = zero
339  a( n-1+i ) = zero
340  a( i ) = zero
341  20 CONTINUE
342  a( 3*n-2 ) = zero
343  a( 2*n-1 ) = zero
344  END IF
345  END IF
346 *
347 *+ TEST 1
348 * Factor A as L*U and compute the ratio
349 * norm(L*U - A) / (n * norm(A) * EPS )
350 *
351  CALL ccopy( n+2*m, a, 1, af, 1 )
352  srnamt = 'CGTTRF'
353  CALL cgttrf( n, af, af( m+1 ), af( n+m+1 ), af( n+2*m+1 ),
354  $ iwork, info )
355 *
356 * Check error code from CGTTRF.
357 *
358  IF( info.NE.izero )
359  $ CALL alaerh( path, 'CGTTRF', info, izero, ' ', n, n, 1,
360  $ 1, -1, imat, nfail, nerrs, nout )
361  trfcon = info.NE.0
362 *
363  CALL cgtt01( n, a, a( m+1 ), a( n+m+1 ), af, af( m+1 ),
364  $ af( n+m+1 ), af( n+2*m+1 ), iwork, work, lda,
365  $ rwork, result( 1 ) )
366 *
367 * Print the test ratio if it is .GE. THRESH.
368 *
369  IF( result( 1 ).GE.thresh ) THEN
370  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
371  $ CALL alahd( nout, path )
372  WRITE( nout, fmt = 9999 )n, imat, 1, result( 1 )
373  nfail = nfail + 1
374  END IF
375  nrun = nrun + 1
376 *
377  DO 50 itran = 1, 2
378  trans = transs( itran )
379  IF( itran.EQ.1 ) THEN
380  norm = 'O'
381  ELSE
382  norm = 'I'
383  END IF
384  anorm = clangt( norm, n, a, a( m+1 ), a( n+m+1 ) )
385 *
386  IF( .NOT.trfcon ) THEN
387 *
388 * Use CGTTRS to solve for one column at a time of
389 * inv(A), computing the maximum column sum as we go.
390 *
391  ainvnm = zero
392  DO 40 i = 1, n
393  DO 30 j = 1, n
394  x( j ) = zero
395  30 CONTINUE
396  x( i ) = one
397  CALL cgttrs( trans, n, 1, af, af( m+1 ),
398  $ af( n+m+1 ), af( n+2*m+1 ), iwork, x,
399  $ lda, info )
400  ainvnm = max( ainvnm, scasum( n, x, 1 ) )
401  40 CONTINUE
402 *
403 * Compute RCONDC = 1 / (norm(A) * norm(inv(A))
404 *
405  IF( anorm.LE.zero .OR. ainvnm.LE.zero ) THEN
406  rcondc = one
407  ELSE
408  rcondc = ( one / anorm ) / ainvnm
409  END IF
410  IF( itran.EQ.1 ) THEN
411  rcondo = rcondc
412  ELSE
413  rcondi = rcondc
414  END IF
415  ELSE
416  rcondc = zero
417  END IF
418 *
419 *+ TEST 7
420 * Estimate the reciprocal of the condition number of the
421 * matrix.
422 *
423  srnamt = 'CGTCON'
424  CALL cgtcon( norm, n, af, af( m+1 ), af( n+m+1 ),
425  $ af( n+2*m+1 ), iwork, anorm, rcond, work,
426  $ info )
427 *
428 * Check error code from CGTCON.
429 *
430  IF( info.NE.0 )
431  $ CALL alaerh( path, 'CGTCON', info, 0, norm, n, n, -1,
432  $ -1, -1, imat, nfail, nerrs, nout )
433 *
434  result( 7 ) = sget06( rcond, rcondc )
435 *
436 * Print the test ratio if it is .GE. THRESH.
437 *
438  IF( result( 7 ).GE.thresh ) THEN
439  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
440  $ CALL alahd( nout, path )
441  WRITE( nout, fmt = 9997 )norm, n, imat, 7,
442  $ result( 7 )
443  nfail = nfail + 1
444  END IF
445  nrun = nrun + 1
446  50 CONTINUE
447 *
448 * Skip the remaining tests if the matrix is singular.
449 *
450  IF( trfcon )
451  $ GO TO 100
452 *
453  DO 90 irhs = 1, nns
454  nrhs = nsval( irhs )
455 *
456 * Generate NRHS random solution vectors.
457 *
458  ix = 1
459  DO 60 j = 1, nrhs
460  CALL clarnv( 2, iseed, n, xact( ix ) )
461  ix = ix + lda
462  60 CONTINUE
463 *
464  DO 80 itran = 1, 3
465  trans = transs( itran )
466  IF( itran.EQ.1 ) THEN
467  rcondc = rcondo
468  ELSE
469  rcondc = rcondi
470  END IF
471 *
472 * Set the right hand side.
473 *
474  CALL clagtm( trans, n, nrhs, one, a,
475  $ a( m+1 ), a( n+m+1 ), xact, lda,
476  $ zero, b, lda )
477 *
478 *+ TEST 2
479 * Solve op(A) * X = B and compute the residual.
480 *
481  CALL clacpy( 'Full', n, nrhs, b, lda, x, lda )
482  srnamt = 'CGTTRS'
483  CALL cgttrs( trans, n, nrhs, af, af( m+1 ),
484  $ af( n+m+1 ), af( n+2*m+1 ), iwork, x,
485  $ lda, info )
486 *
487 * Check error code from CGTTRS.
488 *
489  IF( info.NE.0 )
490  $ CALL alaerh( path, 'CGTTRS', info, 0, trans, n, n,
491  $ -1, -1, nrhs, imat, nfail, nerrs,
492  $ nout )
493 *
494  CALL clacpy( 'Full', n, nrhs, b, lda, work, lda )
495  CALL cgtt02( trans, n, nrhs, a, a( m+1 ), a( n+m+1 ),
496  $ x, lda, work, lda, result( 2 ) )
497 *
498 *+ TEST 3
499 * Check solution from generated exact solution.
500 *
501  CALL cget04( n, nrhs, x, lda, xact, lda, rcondc,
502  $ result( 3 ) )
503 *
504 *+ TESTS 4, 5, and 6
505 * Use iterative refinement to improve the solution.
506 *
507  srnamt = 'CGTRFS'
508  CALL cgtrfs( trans, n, nrhs, a, a( m+1 ), a( n+m+1 ),
509  $ af, af( m+1 ), af( n+m+1 ),
510  $ af( n+2*m+1 ), iwork, b, lda, x, lda,
511  $ rwork, rwork( nrhs+1 ), work,
512  $ rwork( 2*nrhs+1 ), info )
513 *
514 * Check error code from CGTRFS.
515 *
516  IF( info.NE.0 )
517  $ CALL alaerh( path, 'CGTRFS', info, 0, trans, n, n,
518  $ -1, -1, nrhs, imat, nfail, nerrs,
519  $ nout )
520 *
521  CALL cget04( n, nrhs, x, lda, xact, lda, rcondc,
522  $ result( 4 ) )
523  CALL cgtt05( trans, n, nrhs, a, a( m+1 ), a( n+m+1 ),
524  $ b, lda, x, lda, xact, lda, rwork,
525  $ rwork( nrhs+1 ), result( 5 ) )
526 *
527 * Print information about the tests that did not pass the
528 * threshold.
529 *
530  DO 70 k = 2, 6
531  IF( result( k ).GE.thresh ) THEN
532  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
533  $ CALL alahd( nout, path )
534  WRITE( nout, fmt = 9998 )trans, n, nrhs, imat,
535  $ k, result( k )
536  nfail = nfail + 1
537  END IF
538  70 CONTINUE
539  nrun = nrun + 5
540  80 CONTINUE
541  90 CONTINUE
542  100 CONTINUE
543  110 CONTINUE
544 *
545 * Print a summary of the results.
546 *
547  CALL alasum( path, nout, nfail, nrun, nerrs )
548 *
549  9999 FORMAT( 12x, 'N =', i5, ',', 10x, ' type ', i2, ', test(', i2,
550  $ ') = ', g12.5 )
551  9998 FORMAT( ' TRANS=''', a1, ''', N =', i5, ', NRHS=', i3, ', type ',
552  $ i2, ', test(', i2, ') = ', g12.5 )
553  9997 FORMAT( ' NORM =''', a1, ''', N =', i5, ',', 10x, ' type ', i2,
554  $ ', test(', i2, ') = ', g12.5 )
555  RETURN
556 *
557 * End of CCHKGT
558 *
alahd
subroutine alahd(IOUNIT, PATH)
ALAHD
Definition: alahd.f:107
scasum
real function scasum(N, CX, INCX)
SCASUM
Definition: scasum.f:74
alaerh
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
Definition: alaerh.f:149
cgttrf
subroutine cgttrf(N, DL, D, DU, DU2, IPIV, INFO)
CGTTRF
Definition: cgttrf.f:126
clarnv
subroutine clarnv(IDIST, ISEED, N, X)
CLARNV returns a vector of random numbers from a uniform or normal distribution.
Definition: clarnv.f:101
sget06
real function sget06(RCOND, RCONDC)
SGET06
Definition: sget06.f:57
cgtcon
subroutine cgtcon(NORM, N, DL, D, DU, DU2, IPIV, ANORM, RCOND, WORK, INFO)
CGTCON
Definition: cgtcon.f:143
cgtrfs
subroutine cgtrfs(TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF, DU2, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
CGTRFS
Definition: cgtrfs.f:212
clagtm
subroutine clagtm(TRANS, N, NRHS, ALPHA, DL, D, DU, X, LDX, BETA, B, LDB)
CLAGTM performs a matrix-matrix product of the form C = αAB+βC, where A is a tridiagonal matrix...
Definition: clagtm.f:147
cgttrs
subroutine cgttrs(TRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, LDB, INFO)
CGTTRS
Definition: cgttrs.f:140
clacpy
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
Definition: clacpy.f:105
clatms
subroutine clatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
CLATMS
Definition: clatms.f:334
ccopy
subroutine ccopy(N, CX, INCX, CY, INCY)
CCOPY
Definition: ccopy.f:83
cgtt01
subroutine cgtt01(N, DL, D, DU, DLF, DF, DUF, DU2, IPIV, WORK, LDWORK, RWORK, RESID)
CGTT01
Definition: cgtt01.f:136
cerrge
subroutine cerrge(PATH, NUNIT)
CERRGE
Definition: cerrge.f:57
cgtt02
subroutine cgtt02(TRANS, N, NRHS, DL, D, DU, X, LDX, B, LDB, RESID)
CGTT02
Definition: cgtt02.f:126
clangt
real function clangt(NORM, N, DL, D, DU)
CLANGT returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
Definition: clangt.f:108
cget04
subroutine cget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
CGET04
Definition: cget04.f:104
alasum
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
Definition: alasum.f:75
csscal
subroutine csscal(N, SA, CX, INCX)
CSSCAL
Definition: csscal.f:80
clatb4
subroutine clatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
CLATB4
Definition: clatb4.f:123
cgtt05
subroutine cgtt05(TRANS, N, NRHS, DL, D, DU, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
CGTT05
Definition: cgtt05.f:167
Here is the call graph for this function:
Here is the caller graph for this function: