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