LAPACK  3.9.0
LAPACK: Linear Algebra PACKage

◆ cdrvsy_rk()

subroutine cdrvsy_rk ( logical, dimension( * )  DOTYPE,
integer  NN,
integer, dimension( * )  NVAL,
integer  NRHS,
real  THRESH,
logical  TSTERR,
integer  NMAX,
complex, dimension( * )  A,
complex, dimension( * )  AFAC,
complex, dimension( * )  E,
complex, dimension( * )  AINV,
complex, dimension( * )  B,
complex, dimension( * )  X,
complex, dimension( * )  XACT,
complex, dimension( * )  WORK,
real, dimension( * )  RWORK,
integer, dimension( * )  IWORK,
integer  NOUT 
)

CDRVSY_RK

Purpose:
 CDRVSY_RK tests the driver routines CSYSV_RK.
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]NRHS
          NRHS is INTEGER
          The number of right hand side vectors to be generated for
          each linear system.
[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.
[in]NMAX
          NMAX is INTEGER
          The maximum value permitted for N, used in dimensioning the
          work arrays.
[out]A
          A is COMPLEX array, dimension (NMAX*NMAX)
[out]AFAC
          AFAC is COMPLEX array, dimension (NMAX*NMAX)
[out]E
          E is COMPLEX array, dimension (NMAX)
[out]AINV
          AINV is COMPLEX array, dimension (NMAX*NMAX)
[out]B
          B is COMPLEX array, dimension (NMAX*NRHS)
[out]X
          X is COMPLEX array, dimension (NMAX*NRHS)
[out]XACT
          XACT is COMPLEX array, dimension (NMAX*NRHS)
[out]WORK
[out]RWORK
          RWORK is REAL array, dimension (NMAX+2*NRHS)
[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 159 of file cdrvsy_rk.f.

159 *
160 * -- LAPACK test routine (version 3.7.0) --
161 * -- LAPACK is a software package provided by Univ. of Tennessee, --
162 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
163 * December 2016
164 *
165 * .. Scalar Arguments ..
166  LOGICAL TSTERR
167  INTEGER NMAX, NN, NOUT, NRHS
168  REAL THRESH
169 * ..
170 * .. Array Arguments ..
171  LOGICAL DOTYPE( * )
172  INTEGER IWORK( * ), NVAL( * )
173  REAL RWORK( * )
174  COMPLEX A( * ), AFAC( * ), AINV( * ), B( * ), E( * ),
175  $ WORK( * ), X( * ), XACT( * )
176 * ..
177 *
178 * =====================================================================
179 *
180 * .. Parameters ..
181  REAL ONE, ZERO
182  parameter( one = 1.0e+0, zero = 0.0e+0 )
183  INTEGER NTYPES, NTESTS
184  parameter( ntypes = 11, ntests = 3 )
185  INTEGER NFACT
186  parameter( nfact = 2 )
187 * ..
188 * .. Local Scalars ..
189  LOGICAL ZEROT
190  CHARACTER DIST, FACT, TYPE, UPLO, XTYPE
191  CHARACTER*3 MATPATH, PATH
192  INTEGER I, I1, I2, IFACT, IMAT, IN, INFO, IOFF, IUPLO,
193  $ IZERO, J, K, KL, KU, LDA, LWORK, MODE, N,
194  $ NB, NBMIN, NERRS, NFAIL, NIMAT, NRUN, NT
195  REAL AINVNM, ANORM, CNDNUM, RCONDC
196 * ..
197 * .. Local Arrays ..
198  CHARACTER FACTS( NFACT ), UPLOS( 2 )
199  INTEGER ISEED( 4 ), ISEEDY( 4 )
200  REAL RESULT( NTESTS )
201 
202 * ..
203 * .. External Functions ..
204  REAL CLANSY
205  EXTERNAL clansy
206 * ..
207 * .. External Subroutines ..
208  EXTERNAL aladhd, alaerh, alasvm, xlaenv, cerrvx, cget04,
209  $ clacpy, clarhs, clatb4, clatms, clatsy,
210  $ csysv_rk, csyt01_3, csyt02, csytrf_rk, csytri_3
211 * ..
212 * .. Scalars in Common ..
213  LOGICAL LERR, OK
214  CHARACTER*32 SRNAMT
215  INTEGER INFOT, NUNIT
216 * ..
217 * .. Common blocks ..
218  COMMON / infoc / infot, nunit, ok, lerr
219  COMMON / srnamc / srnamt
220 * ..
221 * .. Intrinsic Functions ..
222  INTRINSIC max, min
223 * ..
224 * .. Data statements ..
225  DATA iseedy / 1988, 1989, 1990, 1991 /
226  DATA uplos / 'U', 'L' / , facts / 'F', 'N' /
227 * ..
228 * .. Executable Statements ..
229 *
230 * Initialize constants and the random number seed.
231 *
232 * Test path
233 *
234  path( 1: 1 ) = 'Complex precision'
235  path( 2: 3 ) = 'SK'
236 *
237 * Path to generate matrices
238 *
239  matpath( 1: 1 ) = 'Complex precision'
240  matpath( 2: 3 ) = 'SY'
241 *
242  nrun = 0
243  nfail = 0
244  nerrs = 0
245  DO 10 i = 1, 4
246  iseed( i ) = iseedy( i )
247  10 CONTINUE
248  lwork = max( 2*nmax, nmax*nrhs )
249 *
250 * Test the error exits
251 *
252  IF( tsterr )
253  $ CALL cerrvx( path, nout )
254  infot = 0
255 *
256 * Set the block size and minimum block size for which the block
257 * routine should be used, which will be later returned by ILAENV.
258 *
259  nb = 1
260  nbmin = 2
261  CALL xlaenv( 1, nb )
262  CALL xlaenv( 2, nbmin )
263 *
264 * Do for each value of N in NVAL
265 *
266  DO 180 in = 1, nn
267  n = nval( in )
268  lda = max( n, 1 )
269  xtype = 'N'
270  nimat = ntypes
271  IF( n.LE.0 )
272  $ nimat = 1
273 *
274  DO 170 imat = 1, nimat
275 *
276 * Do the tests only if DOTYPE( IMAT ) is true.
277 *
278  IF( .NOT.dotype( imat ) )
279  $ GO TO 170
280 *
281 * Skip types 3, 4, 5, or 6 if the matrix size is too small.
282 *
283  zerot = imat.GE.3 .AND. imat.LE.6
284  IF( zerot .AND. n.LT.imat-2 )
285  $ GO TO 170
286 *
287 * Do first for UPLO = 'U', then for UPLO = 'L'
288 *
289  DO 160 iuplo = 1, 2
290  uplo = uplos( iuplo )
291 *
292  IF( imat.NE.ntypes ) THEN
293 *
294 * Begin generate the test matrix A.
295 *
296 * Set up parameters with CLATB4 for the matrix generator
297 * based on the type of matrix to be generated.
298 *
299  CALL clatb4( matpath, imat, n, n, TYPE, KL, KU, ANORM,
300  $ MODE, CNDNUM, DIST )
301 *
302 * Generate a matrix with CLATMS.
303 *
304  srnamt = 'CLATMS'
305  CALL clatms( n, n, dist, iseed, TYPE, RWORK, MODE,
306  $ CNDNUM, ANORM, KL, KU, UPLO, A, LDA,
307  $ WORK, INFO )
308 *
309 * Check error code from CLATMS and handle error.
310 *
311  IF( info.NE.0 ) THEN
312  CALL alaerh( path, 'CLATMS', info, 0, uplo, n, n,
313  $ -1, -1, -1, imat, nfail, nerrs, nout )
314  GO TO 160
315  END IF
316 *
317 * For types 3-6, zero one or more rows and columns of
318 * the matrix to test that INFO is returned correctly.
319 *
320  IF( zerot ) THEN
321  IF( imat.EQ.3 ) THEN
322  izero = 1
323  ELSE IF( imat.EQ.4 ) THEN
324  izero = n
325  ELSE
326  izero = n / 2 + 1
327  END IF
328 *
329  IF( imat.LT.6 ) THEN
330 *
331 * Set row and column IZERO to zero.
332 *
333  IF( iuplo.EQ.1 ) THEN
334  ioff = ( izero-1 )*lda
335  DO 20 i = 1, izero - 1
336  a( ioff+i ) = zero
337  20 CONTINUE
338  ioff = ioff + izero
339  DO 30 i = izero, n
340  a( ioff ) = zero
341  ioff = ioff + lda
342  30 CONTINUE
343  ELSE
344  ioff = izero
345  DO 40 i = 1, izero - 1
346  a( ioff ) = zero
347  ioff = ioff + lda
348  40 CONTINUE
349  ioff = ioff - izero
350  DO 50 i = izero, n
351  a( ioff+i ) = zero
352  50 CONTINUE
353  END IF
354  ELSE
355  IF( iuplo.EQ.1 ) THEN
356 *
357 * Set the first IZERO rows and columns to zero.
358 *
359  ioff = 0
360  DO 70 j = 1, n
361  i2 = min( j, izero )
362  DO 60 i = 1, i2
363  a( ioff+i ) = zero
364  60 CONTINUE
365  ioff = ioff + lda
366  70 CONTINUE
367  ELSE
368 *
369 * Set the first IZERO rows and columns to zero.
370 *
371  ioff = 0
372  DO 90 j = 1, n
373  i1 = max( j, izero )
374  DO 80 i = i1, n
375  a( ioff+i ) = zero
376  80 CONTINUE
377  ioff = ioff + lda
378  90 CONTINUE
379  END IF
380  END IF
381  ELSE
382  izero = 0
383  END IF
384 *
385 * End generate the test matrix A.
386 *
387  ELSE
388 *
389 * IMAT = NTYPES: Use a special block diagonal matrix to
390 * test alternate code for the 2-by-2 blocks.
391 *
392  CALL clatsy( uplo, n, a, lda, iseed )
393  END IF
394 *
395  DO 150 ifact = 1, nfact
396 *
397 * Do first for FACT = 'F', then for other values.
398 *
399  fact = facts( ifact )
400 *
401 * Compute the condition number
402 *
403  IF( zerot ) THEN
404  IF( ifact.EQ.1 )
405  $ GO TO 150
406  rcondc = zero
407 *
408  ELSE IF( ifact.EQ.1 ) THEN
409 *
410 * Compute the 1-norm of A.
411 *
412  anorm = clansy( '1', uplo, n, a, lda, rwork )
413 *
414 * Factor the matrix A.
415 *
416 
417  CALL clacpy( uplo, n, n, a, lda, afac, lda )
418  CALL csytrf_rk( uplo, n, afac, lda, e, iwork, work,
419  $ lwork, info )
420 *
421 * Compute inv(A) and take its norm.
422 *
423  CALL clacpy( uplo, n, n, afac, lda, ainv, lda )
424  lwork = (n+nb+1)*(nb+3)
425 *
426 * We need to copute the invesrse to compute
427 * RCONDC that is used later in TEST3.
428 *
429  CALL csytri_3( uplo, n, ainv, lda, e, iwork,
430  $ work, lwork, info )
431  ainvnm = clansy( '1', uplo, n, ainv, lda, rwork )
432 *
433 * Compute the 1-norm condition number of A.
434 *
435  IF( anorm.LE.zero .OR. ainvnm.LE.zero ) THEN
436  rcondc = one
437  ELSE
438  rcondc = ( one / anorm ) / ainvnm
439  END IF
440  END IF
441 *
442 * Form an exact solution and set the right hand side.
443 *
444  srnamt = 'CLARHS'
445  CALL clarhs( matpath, xtype, uplo, ' ', n, n, kl, ku,
446  $ nrhs, a, lda, xact, lda, b, lda, iseed,
447  $ info )
448  xtype = 'C'
449 *
450 * --- Test CSYSV_RK ---
451 *
452  IF( ifact.EQ.2 ) THEN
453  CALL clacpy( uplo, n, n, a, lda, afac, lda )
454  CALL clacpy( 'Full', n, nrhs, b, lda, x, lda )
455 *
456 * Factor the matrix and solve the system using
457 * CSYSV_RK.
458 *
459  srnamt = 'CSYSV_RK'
460  CALL csysv_rk( uplo, n, nrhs, afac, lda, e, iwork,
461  $ x, lda, work, lwork, info )
462 *
463 * Adjust the expected value of INFO to account for
464 * pivoting.
465 *
466  k = izero
467  IF( k.GT.0 ) THEN
468  100 CONTINUE
469  IF( iwork( k ).LT.0 ) THEN
470  IF( iwork( k ).NE.-k ) THEN
471  k = -iwork( k )
472  GO TO 100
473  END IF
474  ELSE IF( iwork( k ).NE.k ) THEN
475  k = iwork( k )
476  GO TO 100
477  END IF
478  END IF
479 *
480 * Check error code from CSYSV_RK and handle error.
481 *
482  IF( info.NE.k ) THEN
483  CALL alaerh( path, 'CSYSV_RK', info, k, uplo,
484  $ n, n, -1, -1, nrhs, imat, nfail,
485  $ nerrs, nout )
486  GO TO 120
487  ELSE IF( info.NE.0 ) THEN
488  GO TO 120
489  END IF
490 *
491 *+ TEST 1 Reconstruct matrix from factors and compute
492 * residual.
493 *
494  CALL csyt01_3( uplo, n, a, lda, afac, lda, e,
495  $ iwork, ainv, lda, rwork,
496  $ result( 1 ) )
497 *
498 *+ TEST 2 Compute residual of the computed solution.
499 *
500  CALL clacpy( 'Full', n, nrhs, b, lda, work, lda )
501  CALL csyt02( uplo, n, nrhs, a, lda, x, lda, work,
502  $ lda, rwork, result( 2 ) )
503 *
504 *+ TEST 3
505 * Check solution from generated exact solution.
506 *
507  CALL cget04( n, nrhs, x, lda, xact, lda, rcondc,
508  $ result( 3 ) )
509  nt = 3
510 *
511 * Print information about the tests that did not pass
512 * the threshold.
513 *
514  DO 110 k = 1, nt
515  IF( result( k ).GE.thresh ) THEN
516  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
517  $ CALL aladhd( nout, path )
518  WRITE( nout, fmt = 9999 )'CSYSV_RK', uplo,
519  $ n, imat, k, result( k )
520  nfail = nfail + 1
521  END IF
522  110 CONTINUE
523  nrun = nrun + nt
524  120 CONTINUE
525  END IF
526 *
527  150 CONTINUE
528 *
529  160 CONTINUE
530  170 CONTINUE
531  180 CONTINUE
532 *
533 * Print a summary of the results.
534 *
535  CALL alasvm( path, nout, nfail, nrun, nerrs )
536 *
537  9999 FORMAT( 1x, a, ', UPLO=''', a1, ''', N =', i5, ', type ', i2,
538  $ ', test ', i2, ', ratio =', g12.5 )
539  RETURN
540 *
541 * End of CDRVSY_RK
542 *
Here is the call graph for this function:
Here is the caller graph for this function:
csyt02
subroutine csyt02(UPLO, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
CSYT02
Definition: csyt02.f:129
csysv_rk
subroutine csysv_rk(UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB, WORK, LWORK, INFO)
CSYSV_RK computes the solution to system of linear equations A * X = B for SY matrices
Definition: csysv_rk.f:230
clansy
real function clansy(NORM, UPLO, N, A, LDA, WORK)
CLANSY returns the value of the 1-norm, or the Frobenius norm, or the infinity norm,...
Definition: clansy.f:125
alasvm
subroutine alasvm(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASVM
Definition: alasvm.f:75
cerrvx
subroutine cerrvx(PATH, NUNIT)
CERRVX
Definition: cerrvx.f:57
cget04
subroutine cget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
CGET04
Definition: cget04.f:104
csyt01_3
subroutine csyt01_3(UPLO, N, A, LDA, AFAC, LDAFAC, E, IPIV, C, LDC, RWORK, RESID)
CSYT01_3
Definition: csyt01_3.f:143
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
clatsy
subroutine clatsy(UPLO, N, X, LDX, ISEED)
CLATSY
Definition: clatsy.f:91
csytrf_rk
subroutine csytrf_rk(UPLO, N, A, LDA, E, IPIV, WORK, LWORK, INFO)
CSYTRF_RK computes the factorization of a complex symmetric indefinite matrix using the bounded Bunch...
Definition: csytrf_rk.f:261
csytri_3
subroutine csytri_3(UPLO, N, A, LDA, E, IPIV, WORK, LWORK, INFO)
CSYTRI_3
Definition: csytri_3.f:172
clatms
subroutine clatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
CLATMS
Definition: clatms.f:334
aladhd
subroutine aladhd(IOUNIT, PATH)
ALADHD
Definition: aladhd.f:92
alaerh
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
Definition: alaerh.f:149
clarhs
subroutine clarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
CLARHS
Definition: clarhs.f:211
clatb4
subroutine clatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
CLATB4
Definition: clatb4.f:123
xlaenv
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
Definition: xlaenv.f:83