LAPACK: TESTING/EIG/zdrvsg.f Source File

Go to the documentation of this file.
00001       SUBROUTINE ZDRVSG( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH,
00002      $                   NOUNIT, A, LDA, B, LDB, D, Z, LDZ, AB, BB, AP,
00003      $                   BP, WORK, NWORK, RWORK, LRWORK, IWORK, LIWORK,
00004      $                   RESULT, INFO )
00005 *
00006 *  -- LAPACK test routine (version 3.1) --
00007 *     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
00008 *     November 2006
00009 *
00010 **********************************************************************
00011 *
00012 *     modified August 1997, a new parameter LRWORK and LIWORK are
00013 *     added in the calling sequence.
00014 *
00015 *     test routine CDGT01 is also modified
00016 *
00017 **********************************************************************
00018 *
00019 *     .. Scalar Arguments ..
00020       INTEGER            INFO, LDA, LDB, LDZ, LIWORK, LRWORK, NOUNIT,
00021      $                   NSIZES, NTYPES, NWORK
00022       DOUBLE PRECISION   THRESH
00023 *     ..
00024 *     .. Array Arguments ..
00025       LOGICAL            DOTYPE( * )
00026       INTEGER            ISEED( 4 ), IWORK( * ), NN( * )
00027       DOUBLE PRECISION   D( * ), RESULT( * ), RWORK( * )
00028       COMPLEX*16         A( LDA, * ), AB( LDA, * ), AP( * ),
00029      $                   B( LDB, * ), BB( LDB, * ), BP( * ), WORK( * ),
00030      $                   Z( LDZ, * )
00031 *     ..
00032 *
00033 *  Purpose
00034 *  =======
00035 *
00036 *       ZDRVSG checks the complex Hermitian generalized eigenproblem
00037 *       drivers.
00038 *
00039 *               ZHEGV computes all eigenvalues and, optionally,
00040 *               eigenvectors of a complex Hermitian-definite generalized
00041 *               eigenproblem.
00042 *
00043 *               ZHEGVD computes all eigenvalues and, optionally,
00044 *               eigenvectors of a complex Hermitian-definite generalized
00045 *               eigenproblem using a divide and conquer algorithm.
00046 *
00047 *               ZHEGVX computes selected eigenvalues and, optionally,
00048 *               eigenvectors of a complex Hermitian-definite generalized
00049 *               eigenproblem.
00050 *
00051 *               ZHPGV computes all eigenvalues and, optionally,
00052 *               eigenvectors of a complex Hermitian-definite generalized
00053 *               eigenproblem in packed storage.
00054 *
00055 *               ZHPGVD computes all eigenvalues and, optionally,
00056 *               eigenvectors of a complex Hermitian-definite generalized
00057 *               eigenproblem in packed storage using a divide and
00058 *               conquer algorithm.
00059 *
00060 *               ZHPGVX computes selected eigenvalues and, optionally,
00061 *               eigenvectors of a complex Hermitian-definite generalized
00062 *               eigenproblem in packed storage.
00063 *
00064 *               ZHBGV computes all eigenvalues and, optionally,
00065 *               eigenvectors of a complex Hermitian-definite banded
00066 *               generalized eigenproblem.
00067 *
00068 *               ZHBGVD computes all eigenvalues and, optionally,
00069 *               eigenvectors of a complex Hermitian-definite banded
00070 *               generalized eigenproblem using a divide and conquer
00071 *               algorithm.
00072 *
00073 *               ZHBGVX computes selected eigenvalues and, optionally,
00074 *               eigenvectors of a complex Hermitian-definite banded
00075 *               generalized eigenproblem.
00076 *
00077 *       When ZDRVSG is called, a number of matrix "sizes" ("n's") and a
00078 *       number of matrix "types" are specified.  For each size ("n")
00079 *       and each type of matrix, one matrix A of the given type will be
00080 *       generated; a random well-conditioned matrix B is also generated
00081 *       and the pair (A,B) is used to test the drivers.
00082 *
00083 *       For each pair (A,B), the following tests are performed:
00084 *
00085 *       (1) ZHEGV with ITYPE = 1 and UPLO ='U':
00086 *
00087 *               | A Z - B Z D | / ( |A| |Z| n ulp )
00088 *
00089 *       (2) as (1) but calling ZHPGV
00090 *       (3) as (1) but calling ZHBGV
00091 *       (4) as (1) but with UPLO = 'L'
00092 *       (5) as (4) but calling ZHPGV
00093 *       (6) as (4) but calling ZHBGV
00094 *
00095 *       (7) ZHEGV with ITYPE = 2 and UPLO ='U':
00096 *
00097 *               | A B Z - Z D | / ( |A| |Z| n ulp )
00098 *
00099 *       (8) as (7) but calling ZHPGV
00100 *       (9) as (7) but with UPLO = 'L'
00101 *       (10) as (9) but calling ZHPGV
00102 *
00103 *       (11) ZHEGV with ITYPE = 3 and UPLO ='U':
00104 *
00105 *               | B A Z - Z D | / ( |A| |Z| n ulp )
00106 *
00107 *       (12) as (11) but calling ZHPGV
00108 *       (13) as (11) but with UPLO = 'L'
00109 *       (14) as (13) but calling ZHPGV
00110 *
00111 *       ZHEGVD, ZHPGVD and ZHBGVD performed the same 14 tests.
00112 *
00113 *       ZHEGVX, ZHPGVX and ZHBGVX performed the above 14 tests with
00114 *       the parameter RANGE = 'A', 'N' and 'I', respectively.
00115 *
00116 *       The "sizes" are specified by an array NN(1:NSIZES); the value of
00117 *       each element NN(j) specifies one size.
00118 *       The "types" are specified by a logical array DOTYPE( 1:NTYPES );
00119 *       if DOTYPE(j) is .TRUE., then matrix type "j" will be generated.
00120 *       This type is used for the matrix A which has half-bandwidth KA.
00121 *       B is generated as a well-conditioned positive definite matrix
00122 *       with half-bandwidth KB (<= KA).
00123 *       Currently, the list of possible types for A is:
00124 *
00125 *       (1)  The zero matrix.
00126 *       (2)  The identity matrix.
00127 *
00128 *       (3)  A diagonal matrix with evenly spaced entries
00129 *            1, ..., ULP  and random signs.
00130 *            (ULP = (first number larger than 1) - 1 )
00131 *       (4)  A diagonal matrix with geometrically spaced entries
00132 *            1, ..., ULP  and random signs.
00133 *       (5)  A diagonal matrix with "clustered" entries 1, ULP, ..., ULP
00134 *            and random signs.
00135 *
00136 *       (6)  Same as (4), but multiplied by SQRT( overflow threshold )
00137 *       (7)  Same as (4), but multiplied by SQRT( underflow threshold )
00138 *
00139 *       (8)  A matrix of the form  U* D U, where U is unitary and
00140 *            D has evenly spaced entries 1, ..., ULP with random signs
00141 *            on the diagonal.
00142 *
00143 *       (9)  A matrix of the form  U* D U, where U is unitary and
00144 *            D has geometrically spaced entries 1, ..., ULP with random
00145 *            signs on the diagonal.
00146 *
00147 *       (10) A matrix of the form  U* D U, where U is unitary and
00148 *            D has "clustered" entries 1, ULP,..., ULP with random
00149 *            signs on the diagonal.
00150 *
00151 *       (11) Same as (8), but multiplied by SQRT( overflow threshold )
00152 *       (12) Same as (8), but multiplied by SQRT( underflow threshold )
00153 *
00154 *       (13) Hermitian matrix with random entries chosen from (-1,1).
00155 *       (14) Same as (13), but multiplied by SQRT( overflow threshold )
00156 *       (15) Same as (13), but multiplied by SQRT( underflow threshold )
00157 *
00158 *       (16) Same as (8), but with KA = 1 and KB = 1
00159 *       (17) Same as (8), but with KA = 2 and KB = 1
00160 *       (18) Same as (8), but with KA = 2 and KB = 2
00161 *       (19) Same as (8), but with KA = 3 and KB = 1
00162 *       (20) Same as (8), but with KA = 3 and KB = 2
00163 *       (21) Same as (8), but with KA = 3 and KB = 3
00164 *
00165 *  Arguments
00166 *  =========
00167 *
00168 *  NSIZES  INTEGER
00169 *          The number of sizes of matrices to use.  If it is zero,
00170 *          ZDRVSG does nothing.  It must be at least zero.
00171 *          Not modified.
00172 *
00173 *  NN      INTEGER array, dimension (NSIZES)
00174 *          An array containing the sizes to be used for the matrices.
00175 *          Zero values will be skipped.  The values must be at least
00176 *          zero.
00177 *          Not modified.
00178 *
00179 *  NTYPES  INTEGER
00180 *          The number of elements in DOTYPE.   If it is zero, ZDRVSG
00181 *          does nothing.  It must be at least zero.  If it is MAXTYP+1
00182 *          and NSIZES is 1, then an additional type, MAXTYP+1 is
00183 *          defined, which is to use whatever matrix is in A.  This
00184 *          is only useful if DOTYPE(1:MAXTYP) is .FALSE. and
00185 *          DOTYPE(MAXTYP+1) is .TRUE. .
00186 *          Not modified.
00187 *
00188 *  DOTYPE  LOGICAL array, dimension (NTYPES)
00189 *          If DOTYPE(j) is .TRUE., then for each size in NN a
00190 *          matrix of that size and of type j will be generated.
00191 *          If NTYPES is smaller than the maximum number of types
00192 *          defined (PARAMETER MAXTYP), then types NTYPES+1 through
00193 *          MAXTYP will not be generated.  If NTYPES is larger
00194 *          than MAXTYP, DOTYPE(MAXTYP+1) through DOTYPE(NTYPES)
00195 *          will be ignored.
00196 *          Not modified.
00197 *
00198 *  ISEED   INTEGER array, dimension (4)
00199 *          On entry ISEED specifies the seed of the random number
00200 *          generator. The array elements should be between 0 and 4095;
00201 *          if not they will be reduced mod 4096.  Also, ISEED(4) must
00202 *          be odd.  The random number generator uses a linear
00203 *          congruential sequence limited to small integers, and so
00204 *          should produce machine independent random numbers. The
00205 *          values of ISEED are changed on exit, and can be used in the
00206 *          next call to ZDRVSG to continue the same random number
00207 *          sequence.
00208 *          Modified.
00209 *
00210 *  THRESH  DOUBLE PRECISION
00211 *          A test will count as "failed" if the "error", computed as
00212 *          described above, exceeds THRESH.  Note that the error
00213 *          is scaled to be O(1), so THRESH should be a reasonably
00214 *          small multiple of 1, e.g., 10 or 100.  In particular,
00215 *          it should not depend on the precision (single vs. double)
00216 *          or the size of the matrix.  It must be at least zero.
00217 *          Not modified.
00218 *
00219 *  NOUNIT  INTEGER
00220 *          The FORTRAN unit number for printing out error messages
00221 *          (e.g., if a routine returns IINFO not equal to 0.)
00222 *          Not modified.
00223 *
00224 *  A       COMPLEX*16 array, dimension (LDA , max(NN))
00225 *          Used to hold the matrix whose eigenvalues are to be
00226 *          computed.  On exit, A contains the last matrix actually
00227 *          used.
00228 *          Modified.
00229 *
00230 *  LDA     INTEGER
00231 *          The leading dimension of A.  It must be at
00232 *          least 1 and at least max( NN ).
00233 *          Not modified.
00234 *
00235 *  B       COMPLEX*16 array, dimension (LDB , max(NN))
00236 *          Used to hold the Hermitian positive definite matrix for
00237 *          the generailzed problem.
00238 *          On exit, B contains the last matrix actually
00239 *          used.
00240 *          Modified.
00241 *
00242 *  LDB     INTEGER
00243 *          The leading dimension of B.  It must be at
00244 *          least 1 and at least max( NN ).
00245 *          Not modified.
00246 *
00247 *  D       DOUBLE PRECISION array, dimension (max(NN))
00248 *          The eigenvalues of A. On exit, the eigenvalues in D
00249 *          correspond with the matrix in A.
00250 *          Modified.
00251 *
00252 *  Z       COMPLEX*16 array, dimension (LDZ, max(NN))
00253 *          The matrix of eigenvectors.
00254 *          Modified.
00255 *
00256 *  LDZ     INTEGER
00257 *          The leading dimension of ZZ.  It must be at least 1 and
00258 *          at least max( NN ).
00259 *          Not modified.
00260 *
00261 *  AB      COMPLEX*16 array, dimension (LDA, max(NN))
00262 *          Workspace.
00263 *          Modified.
00264 *
00265 *  BB      COMPLEX*16 array, dimension (LDB, max(NN))
00266 *          Workspace.
00267 *          Modified.
00268 *
00269 *  AP      COMPLEX*16 array, dimension (max(NN)**2)
00270 *          Workspace.
00271 *          Modified.
00272 *
00273 *  BP      COMPLEX*16 array, dimension (max(NN)**2)
00274 *          Workspace.
00275 *          Modified.
00276 *
00277 *  WORK    COMPLEX*16 array, dimension (NWORK)
00278 *          Workspace.
00279 *          Modified.
00280 *
00281 *  NWORK   INTEGER
00282 *          The number of entries in WORK.  This must be at least
00283 *          2*N + N**2  where  N = max( NN(j), 2 ).
00284 *          Not modified.
00285 *
00286 *  RWORK   DOUBLE PRECISION array, dimension (LRWORK)
00287 *          Workspace.
00288 *          Modified.
00289 *
00290 *  LRWORK  INTEGER
00291 *          The number of entries in RWORK.  This must be at least
00292 *          max( 7*N, 1 + 4*N + 2*N*lg(N) + 3*N**2 ) where
00293 *          N = max( NN(j) ) and lg( N ) = smallest integer k such
00294 *          that 2**k >= N .
00295 *          Not modified.
00296 *
00297 *  IWORK   INTEGER array, dimension (LIWORK))
00298 *          Workspace.
00299 *          Modified.
00300 *
00301 *  LIWORK  INTEGER
00302 *          The number of entries in IWORK.  This must be at least
00303 *          2 + 5*max( NN(j) ).
00304 *          Not modified.
00305 *
00306 *  RESULT  DOUBLE PRECISION array, dimension (70)
00307 *          The values computed by the 70 tests described above.
00308 *          Modified.
00309 *
00310 *  INFO    INTEGER
00311 *          If 0, then everything ran OK.
00312 *           -1: NSIZES < 0
00313 *           -2: Some NN(j) < 0
00314 *           -3: NTYPES < 0
00315 *           -5: THRESH < 0
00316 *           -9: LDA < 1 or LDA < NMAX, where NMAX is max( NN(j) ).
00317 *          -16: LDZ < 1 or LDZ < NMAX.
00318 *          -21: NWORK too small.
00319 *          -23: LRWORK too small.
00320 *          -25: LIWORK too small.
00321 *          If  ZLATMR, CLATMS, ZHEGV, ZHPGV, ZHBGV, CHEGVD, CHPGVD,
00322 *              ZHPGVD, ZHEGVX, CHPGVX, ZHBGVX returns an error code,
00323 *              the absolute value of it is returned.
00324 *          Modified.
00325 *
00326 *-----------------------------------------------------------------------
00327 *
00328 *       Some Local Variables and Parameters:
00329 *       ---- ----- --------- --- ----------
00330 *       ZERO, ONE       Real 0 and 1.
00331 *       MAXTYP          The number of types defined.
00332 *       NTEST           The number of tests that have been run
00333 *                       on this matrix.
00334 *       NTESTT          The total number of tests for this call.
00335 *       NMAX            Largest value in NN.
00336 *       NMATS           The number of matrices generated so far.
00337 *       NERRS           The number of tests which have exceeded THRESH
00338 *                       so far (computed by DLAFTS).
00339 *       COND, IMODE     Values to be passed to the matrix generators.
00340 *       ANORM           Norm of A; passed to matrix generators.
00341 *
00342 *       OVFL, UNFL      Overflow and underflow thresholds.
00343 *       ULP, ULPINV     Finest relative precision and its inverse.
00344 *       RTOVFL, RTUNFL  Square roots of the previous 2 values.
00345 *               The following four arrays decode JTYPE:
00346 *       KTYPE(j)        The general type (1-10) for type "j".
00347 *       KMODE(j)        The MODE value to be passed to the matrix
00348 *                       generator for type "j".
00349 *       KMAGN(j)        The order of magnitude ( O(1),
00350 *                       O(overflow^(1/2) ), O(underflow^(1/2) )
00351 *
00352 *  =====================================================================
00353 *
00354 *     .. Parameters ..
00355       DOUBLE PRECISION   ZERO, ONE, TEN
00356       PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0, TEN = 10.0D+0 )
00357       COMPLEX*16         CZERO, CONE
00358       PARAMETER          ( CZERO = ( 0.0D+0, 0.0D+0 ),
00359      $                   CONE = ( 1.0D+0, 0.0D+0 ) )
00360       INTEGER            MAXTYP
00361       PARAMETER          ( MAXTYP = 21 )
00362 *     ..
00363 *     .. Local Scalars ..
00364       LOGICAL            BADNN
00365       CHARACTER          UPLO
00366       INTEGER            I, IBTYPE, IBUPLO, IINFO, IJ, IL, IMODE, ITEMP,
00367      $                   ITYPE, IU, J, JCOL, JSIZE, JTYPE, KA, KA9, KB,
00368      $                   KB9, M, MTYPES, N, NERRS, NMATS, NMAX, NTEST,
00369      $                   NTESTT
00370       DOUBLE PRECISION   ABSTOL, ANINV, ANORM, COND, OVFL, RTOVFL,
00371      $                   RTUNFL, ULP, ULPINV, UNFL, VL, VU
00372 *     ..
00373 *     .. Local Arrays ..
00374       INTEGER            IDUMMA( 1 ), IOLDSD( 4 ), ISEED2( 4 ),
00375      $                   KMAGN( MAXTYP ), KMODE( MAXTYP ),
00376      $                   KTYPE( MAXTYP )
00377 *     ..
00378 *     .. External Functions ..
00379       LOGICAL            LSAME
00380       DOUBLE PRECISION   DLAMCH, DLARND
00381       EXTERNAL           LSAME, DLAMCH, DLARND
00382 *     ..
00383 *     .. External Subroutines ..
00384       EXTERNAL           DLABAD, DLAFTS, DLASUM, XERBLA, ZHBGV, ZHBGVD,
00385      $                   ZHBGVX, ZHEGV, ZHEGVD, ZHEGVX, ZHPGV, ZHPGVD,
00386      $                   ZHPGVX, ZLACPY, ZLASET, ZLATMR, ZLATMS, ZSGT01
00387 *     ..
00388 *     .. Intrinsic Functions ..
00389       INTRINSIC          ABS, DBLE, MAX, MIN, SQRT
00390 *     ..
00391 *     .. Data statements ..
00392       DATA               KTYPE / 1, 2, 5*4, 5*5, 3*8, 6*9 /
00393       DATA               KMAGN / 2*1, 1, 1, 1, 2, 3, 1, 1, 1, 2, 3, 1,
00394      $                   2, 3, 6*1 /
00395       DATA               KMODE / 2*0, 4, 3, 1, 4, 4, 4, 3, 1, 4, 4, 0,
00396      $                   0, 0, 6*4 /
00397 *     ..
00398 *     .. Executable Statements ..
00399 *
00400 *     1)      Check for errors
00401 *
00402       NTESTT = 0
00403       INFO = 0
00404 *
00405       BADNN = .FALSE.
00406       NMAX = 0
00407       DO 10 J = 1, NSIZES
00408          NMAX = MAX( NMAX, NN( J ) )
00409          IF( NN( J ).LT.0 )
00410      $      BADNN = .TRUE.
00411    10 CONTINUE
00412 *
00413 *     Check for errors
00414 *
00415       IF( NSIZES.LT.0 ) THEN
00416          INFO = -1
00417       ELSE IF( BADNN ) THEN
00418          INFO = -2
00419       ELSE IF( NTYPES.LT.0 ) THEN
00420          INFO = -3
00421       ELSE IF( LDA.LE.1 .OR. LDA.LT.NMAX ) THEN
00422          INFO = -9
00423       ELSE IF( LDZ.LE.1 .OR. LDZ.LT.NMAX ) THEN
00424          INFO = -16
00425       ELSE IF( 2*MAX( NMAX, 2 )**2.GT.NWORK ) THEN
00426          INFO = -21
00427       ELSE IF( 2*MAX( NMAX, 2 )**2.GT.LRWORK ) THEN
00428          INFO = -23
00429       ELSE IF( 2*MAX( NMAX, 2 )**2.GT.LIWORK ) THEN
00430          INFO = -25
00431       END IF
00432 *
00433       IF( INFO.NE.0 ) THEN
00434          CALL XERBLA( 'ZDRVSG', -INFO )
00435          RETURN
00436       END IF
00437 *
00438 *     Quick return if possible
00439 *
00440       IF( NSIZES.EQ.0 .OR. NTYPES.EQ.0 )
00441      $   RETURN
00442 *
00443 *     More Important constants
00444 *
00445       UNFL = DLAMCH( 'Safe minimum' )
00446       OVFL = DLAMCH( 'Overflow' )
00447       CALL DLABAD( UNFL, OVFL )
00448       ULP = DLAMCH( 'Epsilon' )*DLAMCH( 'Base' )
00449       ULPINV = ONE / ULP
00450       RTUNFL = SQRT( UNFL )
00451       RTOVFL = SQRT( OVFL )
00452 *
00453       DO 20 I = 1, 4
00454          ISEED2( I ) = ISEED( I )
00455    20 CONTINUE
00456 *
00457 *     Loop over sizes, types
00458 *
00459       NERRS = 0
00460       NMATS = 0
00461 *
00462       DO 650 JSIZE = 1, NSIZES
00463          N = NN( JSIZE )
00464          ANINV = ONE / DBLE( MAX( 1, N ) )
00465 *
00466          IF( NSIZES.NE.1 ) THEN
00467             MTYPES = MIN( MAXTYP, NTYPES )
00468          ELSE
00469             MTYPES = MIN( MAXTYP+1, NTYPES )
00470          END IF
00471 *
00472          KA9 = 0
00473          KB9 = 0
00474          DO 640 JTYPE = 1, MTYPES
00475             IF( .NOT.DOTYPE( JTYPE ) )
00476      $         GO TO 640
00477             NMATS = NMATS + 1
00478             NTEST = 0
00479 *
00480             DO 30 J = 1, 4
00481                IOLDSD( J ) = ISEED( J )
00482    30       CONTINUE
00483 *
00484 *           2)      Compute "A"
00485 *
00486 *                   Control parameters:
00487 *
00488 *               KMAGN  KMODE        KTYPE
00489 *           =1  O(1)   clustered 1  zero
00490 *           =2  large  clustered 2  identity
00491 *           =3  small  exponential  (none)
00492 *           =4         arithmetic   diagonal, w/ eigenvalues
00493 *           =5         random log   hermitian, w/ eigenvalues
00494 *           =6         random       (none)
00495 *           =7                      random diagonal
00496 *           =8                      random hermitian
00497 *           =9                      banded, w/ eigenvalues
00498 *
00499             IF( MTYPES.GT.MAXTYP )
00500      $         GO TO 90
00501 *
00502             ITYPE = KTYPE( JTYPE )
00503             IMODE = KMODE( JTYPE )
00504 *
00505 *           Compute norm
00506 *
00507             GO TO ( 40, 50, 60 )KMAGN( JTYPE )
00508 *
00509    40       CONTINUE
00510             ANORM = ONE
00511             GO TO 70
00512 *
00513    50       CONTINUE
00514             ANORM = ( RTOVFL*ULP )*ANINV
00515             GO TO 70
00516 *
00517    60       CONTINUE
00518             ANORM = RTUNFL*N*ULPINV
00519             GO TO 70
00520 *
00521    70       CONTINUE
00522 *
00523             IINFO = 0
00524             COND = ULPINV
00525 *
00526 *           Special Matrices -- Identity & Jordan block
00527 *
00528             IF( ITYPE.EQ.1 ) THEN
00529 *
00530 *              Zero
00531 *
00532                KA = 0
00533                KB = 0
00534                CALL ZLASET( 'Full', LDA, N, CZERO, CZERO, A, LDA )
00535 *
00536             ELSE IF( ITYPE.EQ.2 ) THEN
00537 *
00538 *              Identity
00539 *
00540                KA = 0
00541                KB = 0
00542                CALL ZLASET( 'Full', LDA, N, CZERO, CZERO, A, LDA )
00543                DO 80 JCOL = 1, N
00544                   A( JCOL, JCOL ) = ANORM
00545    80          CONTINUE
00546 *
00547             ELSE IF( ITYPE.EQ.4 ) THEN
00548 *
00549 *              Diagonal Matrix, [Eigen]values Specified
00550 *
00551                KA = 0
00552                KB = 0
00553                CALL ZLATMS( N, N, 'S', ISEED, 'H', RWORK, IMODE, COND,
00554      $                      ANORM, 0, 0, 'N', A, LDA, WORK, IINFO )
00555 *
00556             ELSE IF( ITYPE.EQ.5 ) THEN
00557 *
00558 *              Hermitian, eigenvalues specified
00559 *
00560                KA = MAX( 0, N-1 )
00561                KB = KA
00562                CALL ZLATMS( N, N, 'S', ISEED, 'H', RWORK, IMODE, COND,
00563      $                      ANORM, N, N, 'N', A, LDA, WORK, IINFO )
00564 *
00565             ELSE IF( ITYPE.EQ.7 ) THEN
00566 *
00567 *              Diagonal, random eigenvalues
00568 *
00569                KA = 0
00570                KB = 0
00571                CALL ZLATMR( N, N, 'S', ISEED, 'H', WORK, 6, ONE, CONE,
00572      $                      'T', 'N', WORK( N+1 ), 1, ONE,
00573      $                      WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, 0, 0,
00574      $                      ZERO, ANORM, 'NO', A, LDA, IWORK, IINFO )
00575 *
00576             ELSE IF( ITYPE.EQ.8 ) THEN
00577 *
00578 *              Hermitian, random eigenvalues
00579 *
00580                KA = MAX( 0, N-1 )
00581                KB = KA
00582                CALL ZLATMR( N, N, 'S', ISEED, 'H', WORK, 6, ONE, CONE,
00583      $                      'T', 'N', WORK( N+1 ), 1, ONE,
00584      $                      WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, N, N,
00585      $                      ZERO, ANORM, 'NO', A, LDA, IWORK, IINFO )
00586 *
00587             ELSE IF( ITYPE.EQ.9 ) THEN
00588 *
00589 *              Hermitian banded, eigenvalues specified
00590 *
00591 *              The following values are used for the half-bandwidths:
00592 *
00593 *                ka = 1   kb = 1
00594 *                ka = 2   kb = 1
00595 *                ka = 2   kb = 2
00596 *                ka = 3   kb = 1
00597 *                ka = 3   kb = 2
00598 *                ka = 3   kb = 3
00599 *
00600                KB9 = KB9 + 1
00601                IF( KB9.GT.KA9 ) THEN
00602                   KA9 = KA9 + 1
00603                   KB9 = 1
00604                END IF
00605                KA = MAX( 0, MIN( N-1, KA9 ) )
00606                KB = MAX( 0, MIN( N-1, KB9 ) )
00607                CALL ZLATMS( N, N, 'S', ISEED, 'H', RWORK, IMODE, COND,
00608      $                      ANORM, KA, KA, 'N', A, LDA, WORK, IINFO )
00609 *
00610             ELSE
00611 *
00612                IINFO = 1
00613             END IF
00614 *
00615             IF( IINFO.NE.0 ) THEN
00616                WRITE( NOUNIT, FMT = 9999 )'Generator', IINFO, N, JTYPE,
00617      $            IOLDSD
00618                INFO = ABS( IINFO )
00619                RETURN
00620             END IF
00621 *
00622    90       CONTINUE
00623 *
00624             ABSTOL = UNFL + UNFL
00625             IF( N.LE.1 ) THEN
00626                IL = 1
00627                IU = N
00628             ELSE
00629                IL = 1 + ( N-1 )*DLARND( 1, ISEED2 )
00630                IU = 1 + ( N-1 )*DLARND( 1, ISEED2 )
00631                IF( IL.GT.IU ) THEN
00632                   ITEMP = IL
00633                   IL = IU
00634                   IU = ITEMP
00635                END IF
00636             END IF
00637 *
00638 *           3) Call ZHEGV, ZHPGV, ZHBGV, CHEGVD, CHPGVD, CHBGVD,
00639 *              ZHEGVX, ZHPGVX and ZHBGVX, do tests.
00640 *
00641 *           loop over the three generalized problems
00642 *                 IBTYPE = 1: A*x = (lambda)*B*x
00643 *                 IBTYPE = 2: A*B*x = (lambda)*x
00644 *                 IBTYPE = 3: B*A*x = (lambda)*x
00645 *
00646             DO 630 IBTYPE = 1, 3
00647 *
00648 *              loop over the setting UPLO
00649 *
00650                DO 620 IBUPLO = 1, 2
00651                   IF( IBUPLO.EQ.1 )
00652      $               UPLO = 'U'
00653                   IF( IBUPLO.EQ.2 )
00654      $               UPLO = 'L'
00655 *
00656 *                 Generate random well-conditioned positive definite
00657 *                 matrix B, of bandwidth not greater than that of A.
00658 *
00659                   CALL ZLATMS( N, N, 'U', ISEED, 'P', RWORK, 5, TEN,
00660      $                         ONE, KB, KB, UPLO, B, LDB, WORK( N+1 ),
00661      $                         IINFO )
00662 *
00663 *                 Test ZHEGV
00664 *
00665                   NTEST = NTEST + 1
00666 *
00667                   CALL ZLACPY( ' ', N, N, A, LDA, Z, LDZ )
00668                   CALL ZLACPY( UPLO, N, N, B, LDB, BB, LDB )
00669 *
00670                   CALL ZHEGV( IBTYPE, 'V', UPLO, N, Z, LDZ, BB, LDB, D,
00671      $                        WORK, NWORK, RWORK, IINFO )
00672                   IF( IINFO.NE.0 ) THEN
00673                      WRITE( NOUNIT, FMT = 9999 )'ZHEGV(V,' // UPLO //
00674      $                  ')', IINFO, N, JTYPE, IOLDSD
00675                      INFO = ABS( IINFO )
00676                      IF( IINFO.LT.0 ) THEN
00677                         RETURN
00678                      ELSE
00679                         RESULT( NTEST ) = ULPINV
00680                         GO TO 100
00681                      END IF
00682                   END IF
00683 *
00684 *                 Do Test
00685 *
00686                   CALL ZSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
00687      $                         LDZ, D, WORK, RWORK, RESULT( NTEST ) )
00688 *
00689 *                 Test ZHEGVD
00690 *
00691                   NTEST = NTEST + 1
00692 *
00693                   CALL ZLACPY( ' ', N, N, A, LDA, Z, LDZ )
00694                   CALL ZLACPY( UPLO, N, N, B, LDB, BB, LDB )
00695 *
00696                   CALL ZHEGVD( IBTYPE, 'V', UPLO, N, Z, LDZ, BB, LDB, D,
00697      $                         WORK, NWORK, RWORK, LRWORK, IWORK,
00698      $                         LIWORK, IINFO )
00699                   IF( IINFO.NE.0 ) THEN
00700                      WRITE( NOUNIT, FMT = 9999 )'ZHEGVD(V,' // UPLO //
00701      $                  ')', IINFO, N, JTYPE, IOLDSD
00702                      INFO = ABS( IINFO )
00703                      IF( IINFO.LT.0 ) THEN
00704                         RETURN
00705                      ELSE
00706                         RESULT( NTEST ) = ULPINV
00707                         GO TO 100
00708                      END IF
00709                   END IF
00710 *
00711 *                 Do Test
00712 *
00713                   CALL ZSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
00714      $                         LDZ, D, WORK, RWORK, RESULT( NTEST ) )
00715 *
00716 *                 Test ZHEGVX
00717 *
00718                   NTEST = NTEST + 1
00719 *
00720                   CALL ZLACPY( ' ', N, N, A, LDA, AB, LDA )
00721                   CALL ZLACPY( UPLO, N, N, B, LDB, BB, LDB )
00722 *
00723                   CALL ZHEGVX( IBTYPE, 'V', 'A', UPLO, N, AB, LDA, BB,
00724      $                         LDB, VL, VU, IL, IU, ABSTOL, M, D, Z,
00725      $                         LDZ, WORK, NWORK, RWORK, IWORK( N+1 ),
00726      $                         IWORK, IINFO )
00727                   IF( IINFO.NE.0 ) THEN
00728                      WRITE( NOUNIT, FMT = 9999 )'ZHEGVX(V,A' // UPLO //
00729      $                  ')', IINFO, N, JTYPE, IOLDSD
00730                      INFO = ABS( IINFO )
00731                      IF( IINFO.LT.0 ) THEN
00732                         RETURN
00733                      ELSE
00734                         RESULT( NTEST ) = ULPINV
00735                         GO TO 100
00736                      END IF
00737                   END IF
00738 *
00739 *                 Do Test
00740 *
00741                   CALL ZSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
00742      $                         LDZ, D, WORK, RWORK, RESULT( NTEST ) )
00743 *
00744                   NTEST = NTEST + 1
00745 *
00746                   CALL ZLACPY( ' ', N, N, A, LDA, AB, LDA )
00747                   CALL ZLACPY( UPLO, N, N, B, LDB, BB, LDB )
00748 *
00749 *                 since we do not know the exact eigenvalues of this
00750 *                 eigenpair, we just set VL and VU as constants.
00751 *                 It is quite possible that there are no eigenvalues
00752 *                 in this interval.
00753 *
00754                   VL = ZERO
00755                   VU = ANORM
00756                   CALL ZHEGVX( IBTYPE, 'V', 'V', UPLO, N, AB, LDA, BB,
00757      $                         LDB, VL, VU, IL, IU, ABSTOL, M, D, Z,
00758      $                         LDZ, WORK, NWORK, RWORK, IWORK( N+1 ),
00759      $                         IWORK, IINFO )
00760                   IF( IINFO.NE.0 ) THEN
00761                      WRITE( NOUNIT, FMT = 9999 )'ZHEGVX(V,V,' //
00762      $                  UPLO // ')', IINFO, N, JTYPE, IOLDSD
00763                      INFO = ABS( IINFO )
00764                      IF( IINFO.LT.0 ) THEN
00765                         RETURN
00766                      ELSE
00767                         RESULT( NTEST ) = ULPINV
00768                         GO TO 100
00769                      END IF
00770                   END IF
00771 *
00772 *                 Do Test
00773 *
00774                   CALL ZSGT01( IBTYPE, UPLO, N, M, A, LDA, B, LDB, Z,
00775      $                         LDZ, D, WORK, RWORK, RESULT( NTEST ) )
00776 *
00777                   NTEST = NTEST + 1
00778 *
00779                   CALL ZLACPY( ' ', N, N, A, LDA, AB, LDA )
00780                   CALL ZLACPY( UPLO, N, N, B, LDB, BB, LDB )
00781 *
00782                   CALL ZHEGVX( IBTYPE, 'V', 'I', UPLO, N, AB, LDA, BB,
00783      $                         LDB, VL, VU, IL, IU, ABSTOL, M, D, Z,
00784      $                         LDZ, WORK, NWORK, RWORK, IWORK( N+1 ),
00785      $                         IWORK, IINFO )
00786                   IF( IINFO.NE.0 ) THEN
00787                      WRITE( NOUNIT, FMT = 9999 )'ZHEGVX(V,I,' //
00788      $                  UPLO // ')', IINFO, N, JTYPE, IOLDSD
00789                      INFO = ABS( IINFO )
00790                      IF( IINFO.LT.0 ) THEN
00791                         RETURN
00792                      ELSE
00793                         RESULT( NTEST ) = ULPINV
00794                         GO TO 100
00795                      END IF
00796                   END IF
00797 *
00798 *                 Do Test
00799 *
00800                   CALL ZSGT01( IBTYPE, UPLO, N, M, A, LDA, B, LDB, Z,
00801      $                         LDZ, D, WORK, RWORK, RESULT( NTEST ) )
00802 *
00803   100             CONTINUE
00804 *
00805 *                 Test ZHPGV
00806 *
00807                   NTEST = NTEST + 1
00808 *
00809 *                 Copy the matrices into packed storage.
00810 *
00811                   IF( LSAME( UPLO, 'U' ) ) THEN
00812                      IJ = 1
00813                      DO 120 J = 1, N
00814                         DO 110 I = 1, J
00815                            AP( IJ ) = A( I, J )
00816                            BP( IJ ) = B( I, J )
00817                            IJ = IJ + 1
00818   110                   CONTINUE
00819   120                CONTINUE
00820                   ELSE
00821                      IJ = 1
00822                      DO 140 J = 1, N
00823                         DO 130 I = J, N
00824                            AP( IJ ) = A( I, J )
00825                            BP( IJ ) = B( I, J )
00826                            IJ = IJ + 1
00827   130                   CONTINUE
00828   140                CONTINUE
00829                   END IF
00830 *
00831                   CALL ZHPGV( IBTYPE, 'V', UPLO, N, AP, BP, D, Z, LDZ,
00832      $                        WORK, RWORK, IINFO )
00833                   IF( IINFO.NE.0 ) THEN
00834                      WRITE( NOUNIT, FMT = 9999 )'ZHPGV(V,' // UPLO //
00835      $                  ')', IINFO, N, JTYPE, IOLDSD
00836                      INFO = ABS( IINFO )
00837                      IF( IINFO.LT.0 ) THEN
00838                         RETURN
00839                      ELSE
00840                         RESULT( NTEST ) = ULPINV
00841                         GO TO 310
00842                      END IF
00843                   END IF
00844 *
00845 *                 Do Test
00846 *
00847                   CALL ZSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
00848      $                         LDZ, D, WORK, RWORK, RESULT( NTEST ) )
00849 *
00850 *                 Test ZHPGVD
00851 *
00852                   NTEST = NTEST + 1
00853 *
00854 *                 Copy the matrices into packed storage.
00855 *
00856                   IF( LSAME( UPLO, 'U' ) ) THEN
00857                      IJ = 1
00858                      DO 160 J = 1, N
00859                         DO 150 I = 1, J
00860                            AP( IJ ) = A( I, J )
00861                            BP( IJ ) = B( I, J )
00862                            IJ = IJ + 1
00863   150                   CONTINUE
00864   160                CONTINUE
00865                   ELSE
00866                      IJ = 1
00867                      DO 180 J = 1, N
00868                         DO 170 I = J, N
00869                            AP( IJ ) = A( I, J )
00870                            BP( IJ ) = B( I, J )
00871                            IJ = IJ + 1
00872   170                   CONTINUE
00873   180                CONTINUE
00874                   END IF
00875 *
00876                   CALL ZHPGVD( IBTYPE, 'V', UPLO, N, AP, BP, D, Z, LDZ,
00877      $                         WORK, NWORK, RWORK, LRWORK, IWORK,
00878      $                         LIWORK, IINFO )
00879                   IF( IINFO.NE.0 ) THEN
00880                      WRITE( NOUNIT, FMT = 9999 )'ZHPGVD(V,' // UPLO //
00881      $                  ')', IINFO, N, JTYPE, IOLDSD
00882                      INFO = ABS( IINFO )
00883                      IF( IINFO.LT.0 ) THEN
00884                         RETURN
00885                      ELSE
00886                         RESULT( NTEST ) = ULPINV
00887                         GO TO 310
00888                      END IF
00889                   END IF
00890 *
00891 *                 Do Test
00892 *
00893                   CALL ZSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
00894      $                         LDZ, D, WORK, RWORK, RESULT( NTEST ) )
00895 *
00896 *                 Test ZHPGVX
00897 *
00898                   NTEST = NTEST + 1
00899 *
00900 *                 Copy the matrices into packed storage.
00901 *
00902                   IF( LSAME( UPLO, 'U' ) ) THEN
00903                      IJ = 1
00904                      DO 200 J = 1, N
00905                         DO 190 I = 1, J
00906                            AP( IJ ) = A( I, J )
00907                            BP( IJ ) = B( I, J )
00908                            IJ = IJ + 1
00909   190                   CONTINUE
00910   200                CONTINUE
00911                   ELSE
00912                      IJ = 1
00913                      DO 220 J = 1, N
00914                         DO 210 I = J, N
00915                            AP( IJ ) = A( I, J )
00916                            BP( IJ ) = B( I, J )
00917                            IJ = IJ + 1
00918   210                   CONTINUE
00919   220                CONTINUE
00920                   END IF
00921 *
00922                   CALL ZHPGVX( IBTYPE, 'V', 'A', UPLO, N, AP, BP, VL,
00923      $                         VU, IL, IU, ABSTOL, M, D, Z, LDZ, WORK,
00924      $                         RWORK, IWORK( N+1 ), IWORK, INFO )
00925                   IF( IINFO.NE.0 ) THEN
00926                      WRITE( NOUNIT, FMT = 9999 )'ZHPGVX(V,A' // UPLO //
00927      $                  ')', IINFO, N, JTYPE, IOLDSD
00928                      INFO = ABS( IINFO )
00929                      IF( IINFO.LT.0 ) THEN
00930                         RETURN
00931                      ELSE
00932                         RESULT( NTEST ) = ULPINV
00933                         GO TO 310
00934                      END IF
00935                   END IF
00936 *
00937 *                 Do Test
00938 *
00939                   CALL ZSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
00940      $                         LDZ, D, WORK, RWORK, RESULT( NTEST ) )
00941 *
00942                   NTEST = NTEST + 1
00943 *
00944 *                 Copy the matrices into packed storage.
00945 *
00946                   IF( LSAME( UPLO, 'U' ) ) THEN
00947                      IJ = 1
00948                      DO 240 J = 1, N
00949                         DO 230 I = 1, J
00950                            AP( IJ ) = A( I, J )
00951                            BP( IJ ) = B( I, J )
00952                            IJ = IJ + 1
00953   230                   CONTINUE
00954   240                CONTINUE
00955                   ELSE
00956                      IJ = 1
00957                      DO 260 J = 1, N
00958                         DO 250 I = J, N
00959                            AP( IJ ) = A( I, J )
00960                            BP( IJ ) = B( I, J )
00961                            IJ = IJ + 1
00962   250                   CONTINUE
00963   260                CONTINUE
00964                   END IF
00965 *
00966                   VL = ZERO
00967                   VU = ANORM
00968                   CALL ZHPGVX( IBTYPE, 'V', 'V', UPLO, N, AP, BP, VL,
00969      $                         VU, IL, IU, ABSTOL, M, D, Z, LDZ, WORK,
00970      $                         RWORK, IWORK( N+1 ), IWORK, INFO )
00971                   IF( IINFO.NE.0 ) THEN
00972                      WRITE( NOUNIT, FMT = 9999 )'ZHPGVX(V,V' // UPLO //
00973      $                  ')', IINFO, N, JTYPE, IOLDSD
00974                      INFO = ABS( IINFO )
00975                      IF( IINFO.LT.0 ) THEN
00976                         RETURN
00977                      ELSE
00978                         RESULT( NTEST ) = ULPINV
00979                         GO TO 310
00980                      END IF
00981                   END IF
00982 *
00983 *                 Do Test
00984 *
00985                   CALL ZSGT01( IBTYPE, UPLO, N, M, A, LDA, B, LDB, Z,
00986      $                         LDZ, D, WORK, RWORK, RESULT( NTEST ) )
00987 *
00988                   NTEST = NTEST + 1
00989 *
00990 *                 Copy the matrices into packed storage.
00991 *
00992                   IF( LSAME( UPLO, 'U' ) ) THEN
00993                      IJ = 1
00994                      DO 280 J = 1, N
00995                         DO 270 I = 1, J
00996                            AP( IJ ) = A( I, J )
00997                            BP( IJ ) = B( I, J )
00998                            IJ = IJ + 1
00999   270                   CONTINUE
01000   280                CONTINUE
01001                   ELSE
01002                      IJ = 1
01003                      DO 300 J = 1, N
01004                         DO 290 I = J, N
01005                            AP( IJ ) = A( I, J )
01006                            BP( IJ ) = B( I, J )
01007                            IJ = IJ + 1
01008   290                   CONTINUE
01009   300                CONTINUE
01010                   END IF
01011 *
01012                   CALL ZHPGVX( IBTYPE, 'V', 'I', UPLO, N, AP, BP, VL,
01013      $                         VU, IL, IU, ABSTOL, M, D, Z, LDZ, WORK,
01014      $                         RWORK, IWORK( N+1 ), IWORK, INFO )
01015                   IF( IINFO.NE.0 ) THEN
01016                      WRITE( NOUNIT, FMT = 9999 )'ZHPGVX(V,I' // UPLO //
01017      $                  ')', IINFO, N, JTYPE, IOLDSD
01018                      INFO = ABS( IINFO )
01019                      IF( IINFO.LT.0 ) THEN
01020                         RETURN
01021                      ELSE
01022                         RESULT( NTEST ) = ULPINV
01023                         GO TO 310
01024                      END IF
01025                   END IF
01026 *
01027 *                 Do Test
01028 *
01029                   CALL ZSGT01( IBTYPE, UPLO, N, M, A, LDA, B, LDB, Z,
01030      $                         LDZ, D, WORK, RWORK, RESULT( NTEST ) )
01031 *
01032   310             CONTINUE
01033 *
01034                   IF( IBTYPE.EQ.1 ) THEN
01035 *
01036 *                    TEST ZHBGV
01037 *
01038                      NTEST = NTEST + 1
01039 *
01040 *                    Copy the matrices into band storage.
01041 *
01042                      IF( LSAME( UPLO, 'U' ) ) THEN
01043                         DO 340 J = 1, N
01044                            DO 320 I = MAX( 1, J-KA ), J
01045                               AB( KA+1+I-J, J ) = A( I, J )
01046   320                      CONTINUE
01047                            DO 330 I = MAX( 1, J-KB ), J
01048                               BB( KB+1+I-J, J ) = B( I, J )
01049   330                      CONTINUE
01050   340                   CONTINUE
01051                      ELSE
01052                         DO 370 J = 1, N
01053                            DO 350 I = J, MIN( N, J+KA )
01054                               AB( 1+I-J, J ) = A( I, J )
01055   350                      CONTINUE
01056                            DO 360 I = J, MIN( N, J+KB )
01057                               BB( 1+I-J, J ) = B( I, J )
01058   360                      CONTINUE
01059   370                   CONTINUE
01060                      END IF
01061 *
01062                      CALL ZHBGV( 'V', UPLO, N, KA, KB, AB, LDA, BB, LDB,
01063      $                           D, Z, LDZ, WORK, RWORK, IINFO )
01064                      IF( IINFO.NE.0 ) THEN
01065                         WRITE( NOUNIT, FMT = 9999 )'ZHBGV(V,' //
01066      $                     UPLO // ')', IINFO, N, JTYPE, IOLDSD
01067                         INFO = ABS( IINFO )
01068                         IF( IINFO.LT.0 ) THEN
01069                            RETURN
01070                         ELSE
01071                            RESULT( NTEST ) = ULPINV
01072                            GO TO 620
01073                         END IF
01074                      END IF
01075 *
01076 *                    Do Test
01077 *
01078                      CALL ZSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
01079      $                            LDZ, D, WORK, RWORK, RESULT( NTEST ) )
01080 *
01081 *                    TEST ZHBGVD
01082 *
01083                      NTEST = NTEST + 1
01084 *
01085 *                    Copy the matrices into band storage.
01086 *
01087                      IF( LSAME( UPLO, 'U' ) ) THEN
01088                         DO 400 J = 1, N
01089                            DO 380 I = MAX( 1, J-KA ), J
01090                               AB( KA+1+I-J, J ) = A( I, J )
01091   380                      CONTINUE
01092                            DO 390 I = MAX( 1, J-KB ), J
01093                               BB( KB+1+I-J, J ) = B( I, J )
01094   390                      CONTINUE
01095   400                   CONTINUE
01096                      ELSE
01097                         DO 430 J = 1, N
01098                            DO 410 I = J, MIN( N, J+KA )
01099                               AB( 1+I-J, J ) = A( I, J )
01100   410                      CONTINUE
01101                            DO 420 I = J, MIN( N, J+KB )
01102                               BB( 1+I-J, J ) = B( I, J )
01103   420                      CONTINUE
01104   430                   CONTINUE
01105                      END IF
01106 *
01107                      CALL ZHBGVD( 'V', UPLO, N, KA, KB, AB, LDA, BB,
01108      $                            LDB, D, Z, LDZ, WORK, NWORK, RWORK,
01109      $                            LRWORK, IWORK, LIWORK, IINFO )
01110                      IF( IINFO.NE.0 ) THEN
01111                         WRITE( NOUNIT, FMT = 9999 )'ZHBGVD(V,' //
01112      $                     UPLO // ')', IINFO, N, JTYPE, IOLDSD
01113                         INFO = ABS( IINFO )
01114                         IF( IINFO.LT.0 ) THEN
01115                            RETURN
01116                         ELSE
01117                            RESULT( NTEST ) = ULPINV
01118                            GO TO 620
01119                         END IF
01120                      END IF
01121 *
01122 *                    Do Test
01123 *
01124                      CALL ZSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
01125      $                            LDZ, D, WORK, RWORK, RESULT( NTEST ) )
01126 *
01127 *                    Test ZHBGVX
01128 *
01129                      NTEST = NTEST + 1
01130 *
01131 *                    Copy the matrices into band storage.
01132 *
01133                      IF( LSAME( UPLO, 'U' ) ) THEN
01134                         DO 460 J = 1, N
01135                            DO 440 I = MAX( 1, J-KA ), J
01136                               AB( KA+1+I-J, J ) = A( I, J )
01137   440                      CONTINUE
01138                            DO 450 I = MAX( 1, J-KB ), J
01139                               BB( KB+1+I-J, J ) = B( I, J )
01140   450                      CONTINUE
01141   460                   CONTINUE
01142                      ELSE
01143                         DO 490 J = 1, N
01144                            DO 470 I = J, MIN( N, J+KA )
01145                               AB( 1+I-J, J ) = A( I, J )
01146   470                      CONTINUE
01147                            DO 480 I = J, MIN( N, J+KB )
01148                               BB( 1+I-J, J ) = B( I, J )
01149   480                      CONTINUE
01150   490                   CONTINUE
01151                      END IF
01152 *
01153                      CALL ZHBGVX( 'V', 'A', UPLO, N, KA, KB, AB, LDA,
01154      $                            BB, LDB, BP, MAX( 1, N ), VL, VU, IL,
01155      $                            IU, ABSTOL, M, D, Z, LDZ, WORK, RWORK,
01156      $                            IWORK( N+1 ), IWORK, IINFO )
01157                      IF( IINFO.NE.0 ) THEN
01158                         WRITE( NOUNIT, FMT = 9999 )'ZHBGVX(V,A' //
01159      $                     UPLO // ')', IINFO, N, JTYPE, IOLDSD
01160                         INFO = ABS( IINFO )
01161                         IF( IINFO.LT.0 ) THEN
01162                            RETURN
01163                         ELSE
01164                            RESULT( NTEST ) = ULPINV
01165                            GO TO 620
01166                         END IF
01167                      END IF
01168 *
01169 *                    Do Test
01170 *
01171                      CALL ZSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
01172      $                            LDZ, D, WORK, RWORK, RESULT( NTEST ) )
01173 *
01174                      NTEST = NTEST + 1
01175 *
01176 *                    Copy the matrices into band storage.
01177 *
01178                      IF( LSAME( UPLO, 'U' ) ) THEN
01179                         DO 520 J = 1, N
01180                            DO 500 I = MAX( 1, J-KA ), J
01181                               AB( KA+1+I-J, J ) = A( I, J )
01182   500                      CONTINUE
01183                            DO 510 I = MAX( 1, J-KB ), J
01184                               BB( KB+1+I-J, J ) = B( I, J )
01185   510                      CONTINUE
01186   520                   CONTINUE
01187                      ELSE
01188                         DO 550 J = 1, N
01189                            DO 530 I = J, MIN( N, J+KA )
01190                               AB( 1+I-J, J ) = A( I, J )
01191   530                      CONTINUE
01192                            DO 540 I = J, MIN( N, J+KB )
01193                               BB( 1+I-J, J ) = B( I, J )
01194   540                      CONTINUE
01195   550                   CONTINUE
01196                      END IF
01197 *
01198                      VL = ZERO
01199                      VU = ANORM
01200                      CALL ZHBGVX( 'V', 'V', UPLO, N, KA, KB, AB, LDA,
01201      $                            BB, LDB, BP, MAX( 1, N ), VL, VU, IL,
01202      $                            IU, ABSTOL, M, D, Z, LDZ, WORK, RWORK,
01203      $                            IWORK( N+1 ), IWORK, IINFO )
01204                      IF( IINFO.NE.0 ) THEN
01205                         WRITE( NOUNIT, FMT = 9999 )'ZHBGVX(V,V' //
01206      $                     UPLO // ')', IINFO, N, JTYPE, IOLDSD
01207                         INFO = ABS( IINFO )
01208                         IF( IINFO.LT.0 ) THEN
01209                            RETURN
01210                         ELSE
01211                            RESULT( NTEST ) = ULPINV
01212                            GO TO 620
01213                         END IF
01214                      END IF
01215 *
01216 *                    Do Test
01217 *
01218                      CALL ZSGT01( IBTYPE, UPLO, N, M, A, LDA, B, LDB, Z,
01219      $                            LDZ, D, WORK, RWORK, RESULT( NTEST ) )
01220 *
01221                      NTEST = NTEST + 1
01222 *
01223 *                    Copy the matrices into band storage.
01224 *
01225                      IF( LSAME( UPLO, 'U' ) ) THEN
01226                         DO 580 J = 1, N
01227                            DO 560 I = MAX( 1, J-KA ), J
01228                               AB( KA+1+I-J, J ) = A( I, J )
01229   560                      CONTINUE
01230                            DO 570 I = MAX( 1, J-KB ), J
01231                               BB( KB+1+I-J, J ) = B( I, J )
01232   570                      CONTINUE
01233   580                   CONTINUE
01234                      ELSE
01235                         DO 610 J = 1, N
01236                            DO 590 I = J, MIN( N, J+KA )
01237                               AB( 1+I-J, J ) = A( I, J )
01238   590                      CONTINUE
01239                            DO 600 I = J, MIN( N, J+KB )
01240                               BB( 1+I-J, J ) = B( I, J )
01241   600                      CONTINUE
01242   610                   CONTINUE
01243                      END IF
01244 *
01245                      CALL ZHBGVX( 'V', 'I', UPLO, N, KA, KB, AB, LDA,
01246      $                            BB, LDB, BP, MAX( 1, N ), VL, VU, IL,
01247      $                            IU, ABSTOL, M, D, Z, LDZ, WORK, RWORK,
01248      $                            IWORK( N+1 ), IWORK, IINFO )
01249                      IF( IINFO.NE.0 ) THEN
01250                         WRITE( NOUNIT, FMT = 9999 )'ZHBGVX(V,I' //
01251      $                     UPLO // ')', IINFO, N, JTYPE, IOLDSD
01252                         INFO = ABS( IINFO )
01253                         IF( IINFO.LT.0 ) THEN
01254                            RETURN
01255                         ELSE
01256                            RESULT( NTEST ) = ULPINV
01257                            GO TO 620
01258                         END IF
01259                      END IF
01260 *
01261 *                    Do Test
01262 *
01263                      CALL ZSGT01( IBTYPE, UPLO, N, M, A, LDA, B, LDB, Z,
01264      $                            LDZ, D, WORK, RWORK, RESULT( NTEST ) )
01265 *
01266                   END IF
01267 *
01268   620          CONTINUE
01269   630       CONTINUE
01270 *
01271 *           End of Loop -- Check for RESULT(j) > THRESH
01272 *
01273             NTESTT = NTESTT + NTEST
01274             CALL DLAFTS( 'ZSG', N, N, JTYPE, NTEST, RESULT, IOLDSD,
01275      $                   THRESH, NOUNIT, NERRS )
01276   640    CONTINUE
01277   650 CONTINUE
01278 *
01279 *     Summary
01280 *
01281       CALL DLASUM( 'ZSG', NOUNIT, NERRS, NTESTT )
01282 *
01283       RETURN
01284 *
01285  9999 FORMAT( ' ZDRVSG: ', A, ' returned INFO=', I6, '.', / 9X, 'N=',
01286      $      I6, ', JTYPE=', I6, ', ISEED=(', 3( I5, ',' ), I5, ')' )
01287 *
01288 *     End of ZDRVSG
01289 *
01290       END