LAPACK: TESTING/EIG/cchkhb.f Source File

Go to the documentation of this file.
00001       SUBROUTINE CCHKHB( NSIZES, NN, NWDTHS, KK, NTYPES, DOTYPE, ISEED,
00002      $                   THRESH, NOUNIT, A, LDA, SD, SE, U, LDU, WORK,
00003      $                   LWORK, RWORK, RESULT, INFO )
00004 *
00005 *  -- LAPACK test routine (version 3.1) --
00006 *     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
00007 *     November 2006
00008 *
00009 *     .. Scalar Arguments ..
00010       INTEGER            INFO, LDA, LDU, LWORK, NOUNIT, NSIZES, NTYPES,
00011      $                   NWDTHS
00012       REAL               THRESH
00013 *     ..
00014 *     .. Array Arguments ..
00015       LOGICAL            DOTYPE( * )
00016       INTEGER            ISEED( 4 ), KK( * ), NN( * )
00017       REAL               RESULT( * ), RWORK( * ), SD( * ), SE( * )
00018       COMPLEX            A( LDA, * ), U( LDU, * ), WORK( * )
00019 *     ..
00020 *
00021 *  Purpose
00022 *  =======
00023 *
00024 *  CCHKHB tests the reduction of a Hermitian band matrix to tridiagonal
00025 *  from, used with the Hermitian eigenvalue problem.
00026 *
00027 *  CHBTRD factors a Hermitian band matrix A as  U S U* , where * means
00028 *  conjugate transpose, S is symmetric tridiagonal, and U is unitary.
00029 *  CHBTRD can use either just the lower or just the upper triangle
00030 *  of A; CCHKHB checks both cases.
00031 *
00032 *  When CCHKHB is called, a number of matrix "sizes" ("n's"), a number
00033 *  of bandwidths ("k's"), and a number of matrix "types" are
00034 *  specified.  For each size ("n"), each bandwidth ("k") less than or
00035 *  equal to "n", and each type of matrix, one matrix will be generated
00036 *  and used to test the hermitian banded reduction routine.  For each
00037 *  matrix, a number of tests will be performed:
00038 *
00039 *  (1)     | A - V S V* | / ( |A| n ulp )  computed by CHBTRD with
00040 *                                          UPLO='U'
00041 *
00042 *  (2)     | I - UU* | / ( n ulp )
00043 *
00044 *  (3)     | A - V S V* | / ( |A| n ulp )  computed by CHBTRD with
00045 *                                          UPLO='L'
00046 *
00047 *  (4)     | I - UU* | / ( n ulp )
00048 *
00049 *  The "sizes" are specified by an array NN(1:NSIZES); the value of
00050 *  each element NN(j) specifies one size.
00051 *  The "types" are specified by a logical array DOTYPE( 1:NTYPES );
00052 *  if DOTYPE(j) is .TRUE., then matrix type "j" will be generated.
00053 *  Currently, the list of possible types is:
00054 *
00055 *  (1)  The zero matrix.
00056 *  (2)  The identity matrix.
00057 *
00058 *  (3)  A diagonal matrix with evenly spaced entries
00059 *       1, ..., ULP  and random signs.
00060 *       (ULP = (first number larger than 1) - 1 )
00061 *  (4)  A diagonal matrix with geometrically spaced entries
00062 *       1, ..., ULP  and random signs.
00063 *  (5)  A diagonal matrix with "clustered" entries 1, ULP, ..., ULP
00064 *       and random signs.
00065 *
00066 *  (6)  Same as (4), but multiplied by SQRT( overflow threshold )
00067 *  (7)  Same as (4), but multiplied by SQRT( underflow threshold )
00068 *
00069 *  (8)  A matrix of the form  U* D U, where U is unitary and
00070 *       D has evenly spaced entries 1, ..., ULP with random signs
00071 *       on the diagonal.
00072 *
00073 *  (9)  A matrix of the form  U* D U, where U is unitary and
00074 *       D has geometrically spaced entries 1, ..., ULP with random
00075 *       signs on the diagonal.
00076 *
00077 *  (10) A matrix of the form  U* D U, where U is unitary and
00078 *       D has "clustered" entries 1, ULP,..., ULP with random
00079 *       signs on the diagonal.
00080 *
00081 *  (11) Same as (8), but multiplied by SQRT( overflow threshold )
00082 *  (12) Same as (8), but multiplied by SQRT( underflow threshold )
00083 *
00084 *  (13) Hermitian matrix with random entries chosen from (-1,1).
00085 *  (14) Same as (13), but multiplied by SQRT( overflow threshold )
00086 *  (15) Same as (13), but multiplied by SQRT( underflow threshold )
00087 *
00088 *  Arguments
00089 *  =========
00090 *
00091 *  NSIZES  (input) INTEGER
00092 *          The number of sizes of matrices to use.  If it is zero,
00093 *          CCHKHB does nothing.  It must be at least zero.
00094 *
00095 *  NN      (input) INTEGER array, dimension (NSIZES)
00096 *          An array containing the sizes to be used for the matrices.
00097 *          Zero values will be skipped.  The values must be at least
00098 *          zero.
00099 *
00100 *  NWDTHS  (input) INTEGER
00101 *          The number of bandwidths to use.  If it is zero,
00102 *          CCHKHB does nothing.  It must be at least zero.
00103 *
00104 *  KK      (input) INTEGER array, dimension (NWDTHS)
00105 *          An array containing the bandwidths to be used for the band
00106 *          matrices.  The values must be at least zero.
00107 *
00108 *  NTYPES  (input) INTEGER
00109 *          The number of elements in DOTYPE.   If it is zero, CCHKHB
00110 *          does nothing.  It must be at least zero.  If it is MAXTYP+1
00111 *          and NSIZES is 1, then an additional type, MAXTYP+1 is
00112 *          defined, which is to use whatever matrix is in A.  This
00113 *          is only useful if DOTYPE(1:MAXTYP) is .FALSE. and
00114 *          DOTYPE(MAXTYP+1) is .TRUE. .
00115 *
00116 *  DOTYPE  (input) LOGICAL array, dimension (NTYPES)
00117 *          If DOTYPE(j) is .TRUE., then for each size in NN a
00118 *          matrix of that size and of type j will be generated.
00119 *          If NTYPES is smaller than the maximum number of types
00120 *          defined (PARAMETER MAXTYP), then types NTYPES+1 through
00121 *          MAXTYP will not be generated.  If NTYPES is larger
00122 *          than MAXTYP, DOTYPE(MAXTYP+1) through DOTYPE(NTYPES)
00123 *          will be ignored.
00124 *
00125 *  ISEED   (input/output) INTEGER array, dimension (4)
00126 *          On entry ISEED specifies the seed of the random number
00127 *          generator. The array elements should be between 0 and 4095;
00128 *          if not they will be reduced mod 4096.  Also, ISEED(4) must
00129 *          be odd.  The random number generator uses a linear
00130 *          congruential sequence limited to small integers, and so
00131 *          should produce machine independent random numbers. The
00132 *          values of ISEED are changed on exit, and can be used in the
00133 *          next call to CCHKHB to continue the same random number
00134 *          sequence.
00135 *
00136 *  THRESH  (input) REAL
00137 *          A test will count as "failed" if the "error", computed as
00138 *          described above, exceeds THRESH.  Note that the error
00139 *          is scaled to be O(1), so THRESH should be a reasonably
00140 *          small multiple of 1, e.g., 10 or 100.  In particular,
00141 *          it should not depend on the precision (single vs. double)
00142 *          or the size of the matrix.  It must be at least zero.
00143 *
00144 *  NOUNIT  (input) INTEGER
00145 *          The FORTRAN unit number for printing out error messages
00146 *          (e.g., if a routine returns IINFO not equal to 0.)
00147 *
00148 *  A       (input/workspace) REAL array, dimension
00149 *                            (LDA, max(NN))
00150 *          Used to hold the matrix whose eigenvalues are to be
00151 *          computed.
00152 *
00153 *  LDA     (input) INTEGER
00154 *          The leading dimension of A.  It must be at least 2 (not 1!)
00155 *          and at least max( KK )+1.
00156 *
00157 *  SD      (workspace) REAL array, dimension (max(NN))
00158 *          Used to hold the diagonal of the tridiagonal matrix computed
00159 *          by CHBTRD.
00160 *
00161 *  SE      (workspace) REAL array, dimension (max(NN))
00162 *          Used to hold the off-diagonal of the tridiagonal matrix
00163 *          computed by CHBTRD.
00164 *
00165 *  U       (workspace) REAL array, dimension (LDU, max(NN))
00166 *          Used to hold the unitary matrix computed by CHBTRD.
00167 *
00168 *  LDU     (input) INTEGER
00169 *          The leading dimension of U.  It must be at least 1
00170 *          and at least max( NN ).
00171 *
00172 *  WORK    (workspace) REAL array, dimension (LWORK)
00173 *
00174 *  LWORK   (input) INTEGER
00175 *          The number of entries in WORK.  This must be at least
00176 *          max( LDA+1, max(NN)+1 )*max(NN).
00177 *
00178 *  RESULT  (output) REAL array, dimension (4)
00179 *          The values computed by the tests described above.
00180 *          The values are currently limited to 1/ulp, to avoid
00181 *          overflow.
00182 *
00183 *  INFO    (output) INTEGER
00184 *          If 0, then everything ran OK.
00185 *
00186 *-----------------------------------------------------------------------
00187 *
00188 *       Some Local Variables and Parameters:
00189 *       ---- ----- --------- --- ----------
00190 *       ZERO, ONE       Real 0 and 1.
00191 *       MAXTYP          The number of types defined.
00192 *       NTEST           The number of tests performed, or which can
00193 *                       be performed so far, for the current matrix.
00194 *       NTESTT          The total number of tests performed so far.
00195 *       NMAX            Largest value in NN.
00196 *       NMATS           The number of matrices generated so far.
00197 *       NERRS           The number of tests which have exceeded THRESH
00198 *                       so far.
00199 *       COND, IMODE     Values to be passed to the matrix generators.
00200 *       ANORM           Norm of A; passed to matrix generators.
00201 *
00202 *       OVFL, UNFL      Overflow and underflow thresholds.
00203 *       ULP, ULPINV     Finest relative precision and its inverse.
00204 *       RTOVFL, RTUNFL  Square roots of the previous 2 values.
00205 *               The following four arrays decode JTYPE:
00206 *       KTYPE(j)        The general type (1-10) for type "j".
00207 *       KMODE(j)        The MODE value to be passed to the matrix
00208 *                       generator for type "j".
00209 *       KMAGN(j)        The order of magnitude ( O(1),
00210 *                       O(overflow^(1/2) ), O(underflow^(1/2) )
00211 *
00212 *  =====================================================================
00213 *
00214 *     .. Parameters ..
00215       COMPLEX            CZERO, CONE
00216       PARAMETER          ( CZERO = ( 0.0E+0, 0.0E+0 ),
00217      $                   CONE = ( 1.0E+0, 0.0E+0 ) )
00218       REAL               ZERO, ONE, TWO, TEN
00219       PARAMETER          ( ZERO = 0.0E+0, ONE = 1.0E+0, TWO = 2.0E+0,
00220      $                   TEN = 10.0E+0 )
00221       REAL               HALF
00222       PARAMETER          ( HALF = ONE / TWO )
00223       INTEGER            MAXTYP
00224       PARAMETER          ( MAXTYP = 15 )
00225 *     ..
00226 *     .. Local Scalars ..
00227       LOGICAL            BADNN, BADNNB
00228       INTEGER            I, IINFO, IMODE, ITYPE, J, JC, JCOL, JR, JSIZE,
00229      $                   JTYPE, JWIDTH, K, KMAX, MTYPES, N, NERRS,
00230      $                   NMATS, NMAX, NTEST, NTESTT
00231       REAL               ANINV, ANORM, COND, OVFL, RTOVFL, RTUNFL,
00232      $                   TEMP1, ULP, ULPINV, UNFL
00233 *     ..
00234 *     .. Local Arrays ..
00235       INTEGER            IDUMMA( 1 ), IOLDSD( 4 ), KMAGN( MAXTYP ),
00236      $                   KMODE( MAXTYP ), KTYPE( MAXTYP )
00237 *     ..
00238 *     .. External Functions ..
00239       REAL               SLAMCH
00240       EXTERNAL           SLAMCH
00241 *     ..
00242 *     .. External Subroutines ..
00243       EXTERNAL           CHBT21, CHBTRD, CLACPY, CLATMR, CLATMS, CLASET,
00244      $                   SLASUM, XERBLA
00245 *     ..
00246 *     .. Intrinsic Functions ..
00247       INTRINSIC          ABS, CONJG, MAX, MIN, REAL, SQRT
00248 *     ..
00249 *     .. Data statements ..
00250       DATA               KTYPE / 1, 2, 5*4, 5*5, 3*8 /
00251       DATA               KMAGN / 2*1, 1, 1, 1, 2, 3, 1, 1, 1, 2, 3, 1,
00252      $                   2, 3 /
00253       DATA               KMODE / 2*0, 4, 3, 1, 4, 4, 4, 3, 1, 4, 4, 0,
00254      $                   0, 0 /
00255 *     ..
00256 *     .. Executable Statements ..
00257 *
00258 *     Check for errors
00259 *
00260       NTESTT = 0
00261       INFO = 0
00262 *
00263 *     Important constants
00264 *
00265       BADNN = .FALSE.
00266       NMAX = 1
00267       DO 10 J = 1, NSIZES
00268          NMAX = MAX( NMAX, NN( J ) )
00269          IF( NN( J ).LT.0 )
00270      $      BADNN = .TRUE.
00271    10 CONTINUE
00272 *
00273       BADNNB = .FALSE.
00274       KMAX = 0
00275       DO 20 J = 1, NSIZES
00276          KMAX = MAX( KMAX, KK( J ) )
00277          IF( KK( J ).LT.0 )
00278      $      BADNNB = .TRUE.
00279    20 CONTINUE
00280       KMAX = MIN( NMAX-1, KMAX )
00281 *
00282 *     Check for errors
00283 *
00284       IF( NSIZES.LT.0 ) THEN
00285          INFO = -1
00286       ELSE IF( BADNN ) THEN
00287          INFO = -2
00288       ELSE IF( NWDTHS.LT.0 ) THEN
00289          INFO = -3
00290       ELSE IF( BADNNB ) THEN
00291          INFO = -4
00292       ELSE IF( NTYPES.LT.0 ) THEN
00293          INFO = -5
00294       ELSE IF( LDA.LT.KMAX+1 ) THEN
00295          INFO = -11
00296       ELSE IF( LDU.LT.NMAX ) THEN
00297          INFO = -15
00298       ELSE IF( ( MAX( LDA, NMAX )+1 )*NMAX.GT.LWORK ) THEN
00299          INFO = -17
00300       END IF
00301 *
00302       IF( INFO.NE.0 ) THEN
00303          CALL XERBLA( 'CCHKHB', -INFO )
00304          RETURN
00305       END IF
00306 *
00307 *     Quick return if possible
00308 *
00309       IF( NSIZES.EQ.0 .OR. NTYPES.EQ.0 .OR. NWDTHS.EQ.0 )
00310      $   RETURN
00311 *
00312 *     More Important constants
00313 *
00314       UNFL = SLAMCH( 'Safe minimum' )
00315       OVFL = ONE / UNFL
00316       ULP = SLAMCH( 'Epsilon' )*SLAMCH( 'Base' )
00317       ULPINV = ONE / ULP
00318       RTUNFL = SQRT( UNFL )
00319       RTOVFL = SQRT( OVFL )
00320 *
00321 *     Loop over sizes, types
00322 *
00323       NERRS = 0
00324       NMATS = 0
00325 *
00326       DO 190 JSIZE = 1, NSIZES
00327          N = NN( JSIZE )
00328          ANINV = ONE / REAL( MAX( 1, N ) )
00329 *
00330          DO 180 JWIDTH = 1, NWDTHS
00331             K = KK( JWIDTH )
00332             IF( K.GT.N )
00333      $         GO TO 180
00334             K = MAX( 0, MIN( N-1, K ) )
00335 *
00336             IF( NSIZES.NE.1 ) THEN
00337                MTYPES = MIN( MAXTYP, NTYPES )
00338             ELSE
00339                MTYPES = MIN( MAXTYP+1, NTYPES )
00340             END IF
00341 *
00342             DO 170 JTYPE = 1, MTYPES
00343                IF( .NOT.DOTYPE( JTYPE ) )
00344      $            GO TO 170
00345                NMATS = NMATS + 1
00346                NTEST = 0
00347 *
00348                DO 30 J = 1, 4
00349                   IOLDSD( J ) = ISEED( J )
00350    30          CONTINUE
00351 *
00352 *              Compute "A".
00353 *              Store as "Upper"; later, we will copy to other format.
00354 *
00355 *              Control parameters:
00356 *
00357 *                  KMAGN  KMODE        KTYPE
00358 *              =1  O(1)   clustered 1  zero
00359 *              =2  large  clustered 2  identity
00360 *              =3  small  exponential  (none)
00361 *              =4         arithmetic   diagonal, (w/ eigenvalues)
00362 *              =5         random log   hermitian, w/ eigenvalues
00363 *              =6         random       (none)
00364 *              =7                      random diagonal
00365 *              =8                      random hermitian
00366 *              =9                      positive definite
00367 *              =10                     diagonally dominant tridiagonal
00368 *
00369                IF( MTYPES.GT.MAXTYP )
00370      $            GO TO 100
00371 *
00372                ITYPE = KTYPE( JTYPE )
00373                IMODE = KMODE( JTYPE )
00374 *
00375 *              Compute norm
00376 *
00377                GO TO ( 40, 50, 60 )KMAGN( JTYPE )
00378 *
00379    40          CONTINUE
00380                ANORM = ONE
00381                GO TO 70
00382 *
00383    50          CONTINUE
00384                ANORM = ( RTOVFL*ULP )*ANINV
00385                GO TO 70
00386 *
00387    60          CONTINUE
00388                ANORM = RTUNFL*N*ULPINV
00389                GO TO 70
00390 *
00391    70          CONTINUE
00392 *
00393                CALL CLASET( 'Full', LDA, N, CZERO, CZERO, A, LDA )
00394                IINFO = 0
00395                IF( JTYPE.LE.15 ) THEN
00396                   COND = ULPINV
00397                ELSE
00398                   COND = ULPINV*ANINV / TEN
00399                END IF
00400 *
00401 *              Special Matrices -- Identity & Jordan block
00402 *
00403 *                 Zero
00404 *
00405                IF( ITYPE.EQ.1 ) THEN
00406                   IINFO = 0
00407 *
00408                ELSE IF( ITYPE.EQ.2 ) THEN
00409 *
00410 *                 Identity
00411 *
00412                   DO 80 JCOL = 1, N
00413                      A( K+1, JCOL ) = ANORM
00414    80             CONTINUE
00415 *
00416                ELSE IF( ITYPE.EQ.4 ) THEN
00417 *
00418 *                 Diagonal Matrix, [Eigen]values Specified
00419 *
00420                   CALL CLATMS( N, N, 'S', ISEED, 'H', RWORK, IMODE,
00421      $                         COND, ANORM, 0, 0, 'Q', A( K+1, 1 ), LDA,
00422      $                         WORK, IINFO )
00423 *
00424                ELSE IF( ITYPE.EQ.5 ) THEN
00425 *
00426 *                 Hermitian, eigenvalues specified
00427 *
00428                   CALL CLATMS( N, N, 'S', ISEED, 'H', RWORK, IMODE,
00429      $                         COND, ANORM, K, K, 'Q', A, LDA, WORK,
00430      $                         IINFO )
00431 *
00432                ELSE IF( ITYPE.EQ.7 ) THEN
00433 *
00434 *                 Diagonal, random eigenvalues
00435 *
00436                   CALL CLATMR( N, N, 'S', ISEED, 'H', WORK, 6, ONE,
00437      $                         CONE, 'T', 'N', WORK( N+1 ), 1, ONE,
00438      $                         WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, 0, 0,
00439      $                         ZERO, ANORM, 'Q', A( K+1, 1 ), LDA,
00440      $                         IDUMMA, IINFO )
00441 *
00442                ELSE IF( ITYPE.EQ.8 ) THEN
00443 *
00444 *                 Hermitian, random eigenvalues
00445 *
00446                   CALL CLATMR( N, N, 'S', ISEED, 'H', WORK, 6, ONE,
00447      $                         CONE, 'T', 'N', WORK( N+1 ), 1, ONE,
00448      $                         WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, K, K,
00449      $                         ZERO, ANORM, 'Q', A, LDA, IDUMMA, IINFO )
00450 *
00451                ELSE IF( ITYPE.EQ.9 ) THEN
00452 *
00453 *                 Positive definite, eigenvalues specified.
00454 *
00455                   CALL CLATMS( N, N, 'S', ISEED, 'P', RWORK, IMODE,
00456      $                         COND, ANORM, K, K, 'Q', A, LDA,
00457      $                         WORK( N+1 ), IINFO )
00458 *
00459                ELSE IF( ITYPE.EQ.10 ) THEN
00460 *
00461 *                 Positive definite tridiagonal, eigenvalues specified.
00462 *
00463                   IF( N.GT.1 )
00464      $               K = MAX( 1, K )
00465                   CALL CLATMS( N, N, 'S', ISEED, 'P', RWORK, IMODE,
00466      $                         COND, ANORM, 1, 1, 'Q', A( K, 1 ), LDA,
00467      $                         WORK, IINFO )
00468                   DO 90 I = 2, N
00469                      TEMP1 = ABS( A( K, I ) ) /
00470      $                       SQRT( ABS( A( K+1, I-1 )*A( K+1, I ) ) )
00471                      IF( TEMP1.GT.HALF ) THEN
00472                         A( K, I ) = HALF*SQRT( ABS( A( K+1,
00473      $                              I-1 )*A( K+1, I ) ) )
00474                      END IF
00475    90             CONTINUE
00476 *
00477                ELSE
00478 *
00479                   IINFO = 1
00480                END IF
00481 *
00482                IF( IINFO.NE.0 ) THEN
00483                   WRITE( NOUNIT, FMT = 9999 )'Generator', IINFO, N,
00484      $               JTYPE, IOLDSD
00485                   INFO = ABS( IINFO )
00486                   RETURN
00487                END IF
00488 *
00489   100          CONTINUE
00490 *
00491 *              Call CHBTRD to compute S and U from upper triangle.
00492 *
00493                CALL CLACPY( ' ', K+1, N, A, LDA, WORK, LDA )
00494 *
00495                NTEST = 1
00496                CALL CHBTRD( 'V', 'U', N, K, WORK, LDA, SD, SE, U, LDU,
00497      $                      WORK( LDA*N+1 ), IINFO )
00498 *
00499                IF( IINFO.NE.0 ) THEN
00500                   WRITE( NOUNIT, FMT = 9999 )'CHBTRD(U)', IINFO, N,
00501      $               JTYPE, IOLDSD
00502                   INFO = ABS( IINFO )
00503                   IF( IINFO.LT.0 ) THEN
00504                      RETURN
00505                   ELSE
00506                      RESULT( 1 ) = ULPINV
00507                      GO TO 150
00508                   END IF
00509                END IF
00510 *
00511 *              Do tests 1 and 2
00512 *
00513                CALL CHBT21( 'Upper', N, K, 1, A, LDA, SD, SE, U, LDU,
00514      $                      WORK, RWORK, RESULT( 1 ) )
00515 *
00516 *              Convert A from Upper-Triangle-Only storage to
00517 *              Lower-Triangle-Only storage.
00518 *
00519                DO 120 JC = 1, N
00520                   DO 110 JR = 0, MIN( K, N-JC )
00521                      A( JR+1, JC ) = CONJG( A( K+1-JR, JC+JR ) )
00522   110             CONTINUE
00523   120          CONTINUE
00524                DO 140 JC = N + 1 - K, N
00525                   DO 130 JR = MIN( K, N-JC ) + 1, K
00526                      A( JR+1, JC ) = ZERO
00527   130             CONTINUE
00528   140          CONTINUE
00529 *
00530 *              Call CHBTRD to compute S and U from lower triangle
00531 *
00532                CALL CLACPY( ' ', K+1, N, A, LDA, WORK, LDA )
00533 *
00534                NTEST = 3
00535                CALL CHBTRD( 'V', 'L', N, K, WORK, LDA, SD, SE, U, LDU,
00536      $                      WORK( LDA*N+1 ), IINFO )
00537 *
00538                IF( IINFO.NE.0 ) THEN
00539                   WRITE( NOUNIT, FMT = 9999 )'CHBTRD(L)', IINFO, N,
00540      $               JTYPE, IOLDSD
00541                   INFO = ABS( IINFO )
00542                   IF( IINFO.LT.0 ) THEN
00543                      RETURN
00544                   ELSE
00545                      RESULT( 3 ) = ULPINV
00546                      GO TO 150
00547                   END IF
00548                END IF
00549                NTEST = 4
00550 *
00551 *              Do tests 3 and 4
00552 *
00553                CALL CHBT21( 'Lower', N, K, 1, A, LDA, SD, SE, U, LDU,
00554      $                      WORK, RWORK, RESULT( 3 ) )
00555 *
00556 *              End of Loop -- Check for RESULT(j) > THRESH
00557 *
00558   150          CONTINUE
00559                NTESTT = NTESTT + NTEST
00560 *
00561 *              Print out tests which fail.
00562 *
00563                DO 160 JR = 1, NTEST
00564                   IF( RESULT( JR ).GE.THRESH ) THEN
00565 *
00566 *                    If this is the first test to fail,
00567 *                    print a header to the data file.
00568 *
00569                      IF( NERRS.EQ.0 ) THEN
00570                         WRITE( NOUNIT, FMT = 9998 )'CHB'
00571                         WRITE( NOUNIT, FMT = 9997 )
00572                         WRITE( NOUNIT, FMT = 9996 )
00573                         WRITE( NOUNIT, FMT = 9995 )'Hermitian'
00574                         WRITE( NOUNIT, FMT = 9994 )'unitary', '*',
00575      $                     'conjugate transpose', ( '*', J = 1, 4 )
00576                      END IF
00577                      NERRS = NERRS + 1
00578                      WRITE( NOUNIT, FMT = 9993 )N, K, IOLDSD, JTYPE,
00579      $                  JR, RESULT( JR )
00580                   END IF
00581   160          CONTINUE
00582 *
00583   170       CONTINUE
00584   180    CONTINUE
00585   190 CONTINUE
00586 *
00587 *     Summary
00588 *
00589       CALL SLASUM( 'CHB', NOUNIT, NERRS, NTESTT )
00590       RETURN
00591 *
00592  9999 FORMAT( ' CCHKHB: ', A, ' returned INFO=', I6, '.', / 9X, 'N=',
00593      $      I6, ', JTYPE=', I6, ', ISEED=(', 3( I5, ',' ), I5, ')' )
00594  9998 FORMAT( / 1X, A3,
00595      $     ' -- Complex Hermitian Banded Tridiagonal Reduction Routines'
00596      $       )
00597  9997 FORMAT( ' Matrix types (see SCHK23 for details): ' )
00598 *
00599  9996 FORMAT( / ' Special Matrices:',
00600      $      / '  1=Zero matrix.                        ',
00601      $      '  5=Diagonal: clustered entries.',
00602      $      / '  2=Identity matrix.                    ',
00603      $      '  6=Diagonal: large, evenly spaced.',
00604      $      / '  3=Diagonal: evenly spaced entries.    ',
00605      $      '  7=Diagonal: small, evenly spaced.',
00606      $      / '  4=Diagonal: geometr. spaced entries.' )
00607  9995 FORMAT( ' Dense ', A, ' Banded Matrices:',
00608      $      / '  8=Evenly spaced eigenvals.            ',
00609      $      ' 12=Small, evenly spaced eigenvals.',
00610      $      / '  9=Geometrically spaced eigenvals.     ',
00611      $      ' 13=Matrix with random O(1) entries.',
00612      $      / ' 10=Clustered eigenvalues.              ',
00613      $      ' 14=Matrix with large random entries.',
00614      $      / ' 11=Large, evenly spaced eigenvals.     ',
00615      $      ' 15=Matrix with small random entries.' )
00616 *
00617  9994 FORMAT( / ' Tests performed:   (S is Tridiag,  U is ', A, ',',
00618      $      / 20X, A, ' means ', A, '.', / ' UPLO=''U'':',
00619      $      / '  1= | A - U S U', A1, ' | / ( |A| n ulp )     ',
00620      $      '  2= | I - U U', A1, ' | / ( n ulp )', / ' UPLO=''L'':',
00621      $      / '  3= | A - U S U', A1, ' | / ( |A| n ulp )     ',
00622      $      '  4= | I - U U', A1, ' | / ( n ulp )' )
00623  9993 FORMAT( ' N=', I5, ', K=', I4, ', seed=', 4( I4, ',' ), ' type ',
00624      $      I2, ', test(', I2, ')=', G10.3 )
00625 *
00626 *     End of CCHKHB
00627 *
00628       END