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