LAPACK: TESTING/MATGEN/clatmr.f Source File

Go to the documentation of this file.
00001       SUBROUTINE CLATMR( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX,
00002      $                   RSIGN, GRADE, DL, MODEL, CONDL, DR, MODER,
00003      $                   CONDR, PIVTNG, IPIVOT, KL, KU, SPARSE, ANORM,
00004      $                   PACK, A, LDA, IWORK, INFO )
00005 *
00006 *  -- LAPACK test routine (version 3.1) --
00007 *     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
00008 *     June 2010
00009 *
00010 *     .. Scalar Arguments ..
00011       CHARACTER          DIST, GRADE, PACK, PIVTNG, RSIGN, SYM
00012       INTEGER            INFO, KL, KU, LDA, M, MODE, MODEL, MODER, N
00013       REAL               ANORM, COND, CONDL, CONDR, SPARSE
00014       COMPLEX            DMAX
00015 *     ..
00016 *     .. Array Arguments ..
00017       INTEGER            IPIVOT( * ), ISEED( 4 ), IWORK( * )
00018       COMPLEX            A( LDA, * ), D( * ), DL( * ), DR( * )
00019 *     ..
00020 *
00021 *  Purpose
00022 *  =======
00023 *
00024 *     CLATMR generates random matrices of various types for testing
00025 *     LAPACK programs.
00026 *
00027 *     CLATMR operates by applying the following sequence of
00028 *     operations:
00029 *
00030 *       Generate a matrix A with random entries of distribution DIST
00031 *          which is symmetric if SYM='S', Hermitian if SYM='H', and
00032 *          nonsymmetric if SYM='N'.
00033 *
00034 *       Set the diagonal to D, where D may be input or
00035 *          computed according to MODE, COND, DMAX and RSIGN
00036 *          as described below.
00037 *
00038 *       Grade the matrix, if desired, from the left and/or right
00039 *          as specified by GRADE. The inputs DL, MODEL, CONDL, DR,
00040 *          MODER and CONDR also determine the grading as described
00041 *          below.
00042 *
00043 *       Permute, if desired, the rows and/or columns as specified by
00044 *          PIVTNG and IPIVOT.
00045 *
00046 *       Set random entries to zero, if desired, to get a random sparse
00047 *          matrix as specified by SPARSE.
00048 *
00049 *       Make A a band matrix, if desired, by zeroing out the matrix
00050 *          outside a band of lower bandwidth KL and upper bandwidth KU.
00051 *
00052 *       Scale A, if desired, to have maximum entry ANORM.
00053 *
00054 *       Pack the matrix if desired. Options specified by PACK are:
00055 *          no packing
00056 *          zero out upper half (if symmetric or Hermitian)
00057 *          zero out lower half (if symmetric or Hermitian)
00058 *          store the upper half columnwise (if symmetric or Hermitian
00059 *              or square upper triangular)
00060 *          store the lower half columnwise (if symmetric or Hermitian
00061 *              or square lower triangular)
00062 *              same as upper half rowwise if symmetric
00063 *              same as conjugate upper half rowwise if Hermitian
00064 *          store the lower triangle in banded format
00065 *              (if symmetric or Hermitian)
00066 *          store the upper triangle in banded format
00067 *              (if symmetric or Hermitian)
00068 *          store the entire matrix in banded format
00069 *
00070 *     Note: If two calls to CLATMR differ only in the PACK parameter,
00071 *           they will generate mathematically equivalent matrices.
00072 *
00073 *           If two calls to CLATMR both have full bandwidth (KL = M-1
00074 *           and KU = N-1), and differ only in the PIVTNG and PACK
00075 *           parameters, then the matrices generated will differ only
00076 *           in the order of the rows and/or columns, and otherwise
00077 *           contain the same data. This consistency cannot be and
00078 *           is not maintained with less than full bandwidth.
00079 *
00080 *  Arguments
00081 *  =========
00082 *
00083 *  M        (input) INTEGER
00084 *           Number of rows of A. Not modified.
00085 *
00086 *  N        (input) INTEGER
00087 *           Number of columns of A. Not modified.
00088 *
00089 *  DIST     (input) CHARACTER*1
00090 *           On entry, DIST specifies the type of distribution to be used
00091 *           to generate a random matrix .
00092 *           'U' => real and imaginary parts are independent
00093 *                  UNIFORM( 0, 1 )  ( 'U' for uniform )
00094 *           'S' => real and imaginary parts are independent
00095 *                  UNIFORM( -1, 1 ) ( 'S' for symmetric )
00096 *           'N' => real and imaginary parts are independent
00097 *                  NORMAL( 0, 1 )   ( 'N' for normal )
00098 *           'D' => uniform on interior of unit disk ( 'D' for disk )
00099 *           Not modified.
00100 *
00101 *  ISEED    (input/output) INTEGER array, dimension (4)
00102 *           On entry ISEED specifies the seed of the random number
00103 *           generator. They should lie between 0 and 4095 inclusive,
00104 *           and ISEED(4) should be odd. The random number generator
00105 *           uses a linear congruential sequence limited to small
00106 *           integers, and so should produce machine independent
00107 *           random numbers. The values of ISEED are changed on
00108 *           exit, and can be used in the next call to CLATMR
00109 *           to continue the same random number sequence.
00110 *           Changed on exit.
00111 *
00112 *  SYM      (input) CHARACTER*1
00113 *           If SYM='S', generated matrix is symmetric.
00114 *           If SYM='H', generated matrix is Hermitian.
00115 *           If SYM='N', generated matrix is nonsymmetric.
00116 *           Not modified.
00117 *
00118 *  D        (input/output) COMPLEX array, dimension (min(M,N))
00119 *           On entry this array specifies the diagonal entries
00120 *           of the diagonal of A.  D may either be specified
00121 *           on entry, or set according to MODE and COND as described
00122 *           below. If the matrix is Hermitian, the real part of D
00123 *           will be taken. May be changed on exit if MODE is nonzero.
00124 *
00125 *  MODE     (input) INTEGER
00126 *           On entry describes how D is to be used:
00127 *           MODE = 0 means use D as input
00128 *           MODE = 1 sets D(1)=1 and D(2:N)=1.0/COND
00129 *           MODE = 2 sets D(1:N-1)=1 and D(N)=1.0/COND
00130 *           MODE = 3 sets D(I)=COND**(-(I-1)/(N-1))
00131 *           MODE = 4 sets D(i)=1 - (i-1)/(N-1)*(1 - 1/COND)
00132 *           MODE = 5 sets D to random numbers in the range
00133 *                    ( 1/COND , 1 ) such that their logarithms
00134 *                    are uniformly distributed.
00135 *           MODE = 6 set D to random numbers from same distribution
00136 *                    as the rest of the matrix.
00137 *           MODE < 0 has the same meaning as ABS(MODE), except that
00138 *              the order of the elements of D is reversed.
00139 *           Thus if MODE is positive, D has entries ranging from
00140 *              1 to 1/COND, if negative, from 1/COND to 1,
00141 *           Not modified.
00142 *
00143 *  COND     (input) REAL
00144 *           On entry, used as described under MODE above.
00145 *           If used, it must be >= 1. Not modified.
00146 *
00147 *  DMAX     (input) COMPLEX
00148 *           If MODE neither -6, 0 nor 6, the diagonal is scaled by
00149 *           DMAX / max(abs(D(i))), so that maximum absolute entry
00150 *           of diagonal is abs(DMAX). If DMAX is complex (or zero),
00151 *           diagonal will be scaled by a complex number (or zero).
00152 *
00153 *  RSIGN    (input) CHARACTER*1
00154 *           If MODE neither -6, 0 nor 6, specifies sign of diagonal
00155 *           as follows:
00156 *           'T' => diagonal entries are multiplied by a random complex
00157 *                  number uniformly distributed with absolute value 1
00158 *           'F' => diagonal unchanged
00159 *           Not modified.
00160 *
00161 *  GRADE    (input) CHARACTER*1
00162 *           Specifies grading of matrix as follows:
00163 *           'N'  => no grading
00164 *           'L'  => matrix premultiplied by diag( DL )
00165 *                   (only if matrix nonsymmetric)
00166 *           'R'  => matrix postmultiplied by diag( DR )
00167 *                   (only if matrix nonsymmetric)
00168 *           'B'  => matrix premultiplied by diag( DL ) and
00169 *                         postmultiplied by diag( DR )
00170 *                   (only if matrix nonsymmetric)
00171 *           'H'  => matrix premultiplied by diag( DL ) and
00172 *                         postmultiplied by diag( CONJG(DL) )
00173 *                   (only if matrix Hermitian or nonsymmetric)
00174 *           'S'  => matrix premultiplied by diag( DL ) and
00175 *                         postmultiplied by diag( DL )
00176 *                   (only if matrix symmetric or nonsymmetric)
00177 *           'E'  => matrix premultiplied by diag( DL ) and
00178 *                         postmultiplied by inv( diag( DL ) )
00179 *                         ( 'S' for similarity )
00180 *                   (only if matrix nonsymmetric)
00181 *                   Note: if GRADE='S', then M must equal N.
00182 *           Not modified.
00183 *
00184 *  DL       (input/output) COMPLEX array, dimension (M)
00185 *           If MODEL=0, then on entry this array specifies the diagonal
00186 *           entries of a diagonal matrix used as described under GRADE
00187 *           above. If MODEL is not zero, then DL will be set according
00188 *           to MODEL and CONDL, analogous to the way D is set according
00189 *           to MODE and COND (except there is no DMAX parameter for DL).
00190 *           If GRADE='E', then DL cannot have zero entries.
00191 *           Not referenced if GRADE = 'N' or 'R'. Changed on exit.
00192 *
00193 *  MODEL    (input) INTEGER
00194 *           This specifies how the diagonal array DL is to be computed,
00195 *           just as MODE specifies how D is to be computed.
00196 *           Not modified.
00197 *
00198 *  CONDL    (input) REAL
00199 *           When MODEL is not zero, this specifies the condition number
00200 *           of the computed DL.  Not modified.
00201 *
00202 *  DR       (input/output) COMPLEX array, dimension (N)
00203 *           If MODER=0, then on entry this array specifies the diagonal
00204 *           entries of a diagonal matrix used as described under GRADE
00205 *           above. If MODER is not zero, then DR will be set according
00206 *           to MODER and CONDR, analogous to the way D is set according
00207 *           to MODE and COND (except there is no DMAX parameter for DR).
00208 *           Not referenced if GRADE = 'N', 'L', 'H' or 'S'.
00209 *           Changed on exit.
00210 *
00211 *  MODER    (input) INTEGER
00212 *           This specifies how the diagonal array DR is to be computed,
00213 *           just as MODE specifies how D is to be computed.
00214 *           Not modified.
00215 *
00216 *  CONDR    (input) REAL
00217 *           When MODER is not zero, this specifies the condition number
00218 *           of the computed DR.  Not modified.
00219 *
00220 *  PIVTNG   (input) CHARACTER*1
00221 *           On entry specifies pivoting permutations as follows:
00222 *           'N' or ' ' => none.
00223 *           'L' => left or row pivoting (matrix must be nonsymmetric).
00224 *           'R' => right or column pivoting (matrix must be
00225 *                  nonsymmetric).
00226 *           'B' or 'F' => both or full pivoting, i.e., on both sides.
00227 *                         In this case, M must equal N
00228 *
00229 *           If two calls to CLATMR both have full bandwidth (KL = M-1
00230 *           and KU = N-1), and differ only in the PIVTNG and PACK
00231 *           parameters, then the matrices generated will differ only
00232 *           in the order of the rows and/or columns, and otherwise
00233 *           contain the same data. This consistency cannot be
00234 *           maintained with less than full bandwidth.
00235 *
00236 *  IPIVOT   (input) INTEGER array, dimension (N or M)
00237 *           This array specifies the permutation used.  After the
00238 *           basic matrix is generated, the rows, columns, or both
00239 *           are permuted.   If, say, row pivoting is selected, CLATMR
00240 *           starts with the *last* row and interchanges the M-th and
00241 *           IPIVOT(M)-th rows, then moves to the next-to-last row,
00242 *           interchanging the (M-1)-th and the IPIVOT(M-1)-th rows,
00243 *           and so on.  In terms of "2-cycles", the permutation is
00244 *           (1 IPIVOT(1)) (2 IPIVOT(2)) ... (M IPIVOT(M))
00245 *           where the rightmost cycle is applied first.  This is the
00246 *           *inverse* of the effect of pivoting in LINPACK.  The idea
00247 *           is that factoring (with pivoting) an identity matrix
00248 *           which has been inverse-pivoted in this way should
00249 *           result in a pivot vector identical to IPIVOT.
00250 *           Not referenced if PIVTNG = 'N'. Not modified.
00251 *
00252 *  SPARSE   (input) REAL
00253 *           On entry specifies the sparsity of the matrix if a sparse
00254 *           matrix is to be generated. SPARSE should lie between
00255 *           0 and 1. To generate a sparse matrix, for each matrix entry
00256 *           a uniform ( 0, 1 ) random number x is generated and
00257 *           compared to SPARSE; if x is larger the matrix entry
00258 *           is unchanged and if x is smaller the entry is set
00259 *           to zero. Thus on the average a fraction SPARSE of the
00260 *           entries will be set to zero.
00261 *           Not modified.
00262 *
00263 *  KL       (input) INTEGER
00264 *           On entry specifies the lower bandwidth of the  matrix. For
00265 *           example, KL=0 implies upper triangular, KL=1 implies upper
00266 *           Hessenberg, and KL at least M-1 implies the matrix is not
00267 *           banded. Must equal KU if matrix is symmetric or Hermitian.
00268 *           Not modified.
00269 *
00270 *  KU       (input) INTEGER
00271 *           On entry specifies the upper bandwidth of the  matrix. For
00272 *           example, KU=0 implies lower triangular, KU=1 implies lower
00273 *           Hessenberg, and KU at least N-1 implies the matrix is not
00274 *           banded. Must equal KL if matrix is symmetric or Hermitian.
00275 *           Not modified.
00276 *
00277 *  ANORM    (input) REAL
00278 *           On entry specifies maximum entry of output matrix
00279 *           (output matrix will by multiplied by a constant so that
00280 *           its largest absolute entry equal ANORM)
00281 *           if ANORM is nonnegative. If ANORM is negative no scaling
00282 *           is done. Not modified.
00283 *
00284 *  PACK     (input) CHARACTER*1
00285 *           On entry specifies packing of matrix as follows:
00286 *           'N' => no packing
00287 *           'U' => zero out all subdiagonal entries
00288 *                  (if symmetric or Hermitian)
00289 *           'L' => zero out all superdiagonal entries
00290 *                  (if symmetric or Hermitian)
00291 *           'C' => store the upper triangle columnwise
00292 *                  (only if matrix symmetric or Hermitian or
00293 *                   square upper triangular)
00294 *           'R' => store the lower triangle columnwise
00295 *                  (only if matrix symmetric or Hermitian or
00296 *                   square lower triangular)
00297 *                  (same as upper half rowwise if symmetric)
00298 *                  (same as conjugate upper half rowwise if Hermitian)
00299 *           'B' => store the lower triangle in band storage scheme
00300 *                  (only if matrix symmetric or Hermitian)
00301 *           'Q' => store the upper triangle in band storage scheme
00302 *                  (only if matrix symmetric or Hermitian)
00303 *           'Z' => store the entire matrix in band storage scheme
00304 *                      (pivoting can be provided for by using this
00305 *                      option to store A in the trailing rows of
00306 *                      the allocated storage)
00307 *
00308 *           Using these options, the various LAPACK packed and banded
00309 *           storage schemes can be obtained:
00310 *           GB               - use 'Z'
00311 *           PB, HB or TB     - use 'B' or 'Q'
00312 *           PP, HP or TP     - use 'C' or 'R'
00313 *
00314 *           If two calls to CLATMR differ only in the PACK parameter,
00315 *           they will generate mathematically equivalent matrices.
00316 *           Not modified.
00317 *
00318 *  A        (input/output) COMPLEX array, dimension (LDA,N)
00319 *           On exit A is the desired test matrix. Only those
00320 *           entries of A which are significant on output
00321 *           will be referenced (even if A is in packed or band
00322 *           storage format). The 'unoccupied corners' of A in
00323 *           band format will be zeroed out.
00324 *
00325 *  LDA      (input) INTEGER
00326 *           on entry LDA specifies the first dimension of A as
00327 *           declared in the calling program.
00328 *           If PACK='N', 'U' or 'L', LDA must be at least max ( 1, M ).
00329 *           If PACK='C' or 'R', LDA must be at least 1.
00330 *           If PACK='B', or 'Q', LDA must be MIN ( KU+1, N )
00331 *           If PACK='Z', LDA must be at least KUU+KLL+1, where
00332 *           KUU = MIN ( KU, N-1 ) and KLL = MIN ( KL, N-1 )
00333 *           Not modified.
00334 *
00335 *  IWORK    (workspace) INTEGER array, dimension (N or M)
00336 *           Workspace. Not referenced if PIVTNG = 'N'. Changed on exit.
00337 *
00338 *  INFO     (output) INTEGER
00339 *           Error parameter on exit:
00340 *             0 => normal return
00341 *            -1 => M negative or unequal to N and SYM='S' or 'H'
00342 *            -2 => N negative
00343 *            -3 => DIST illegal string
00344 *            -5 => SYM illegal string
00345 *            -7 => MODE not in range -6 to 6
00346 *            -8 => COND less than 1.0, and MODE neither -6, 0 nor 6
00347 *           -10 => MODE neither -6, 0 nor 6 and RSIGN illegal string
00348 *           -11 => GRADE illegal string, or GRADE='E' and
00349 *                  M not equal to N, or GRADE='L', 'R', 'B', 'S' or 'E'
00350 *                  and SYM = 'H', or GRADE='L', 'R', 'B', 'H' or 'E'
00351 *                  and SYM = 'S'
00352 *           -12 => GRADE = 'E' and DL contains zero
00353 *           -13 => MODEL not in range -6 to 6 and GRADE= 'L', 'B', 'H',
00354 *                  'S' or 'E'
00355 *           -14 => CONDL less than 1.0, GRADE='L', 'B', 'H', 'S' or 'E',
00356 *                  and MODEL neither -6, 0 nor 6
00357 *           -16 => MODER not in range -6 to 6 and GRADE= 'R' or 'B'
00358 *           -17 => CONDR less than 1.0, GRADE='R' or 'B', and
00359 *                  MODER neither -6, 0 nor 6
00360 *           -18 => PIVTNG illegal string, or PIVTNG='B' or 'F' and
00361 *                  M not equal to N, or PIVTNG='L' or 'R' and SYM='S'
00362 *                  or 'H'
00363 *           -19 => IPIVOT contains out of range number and
00364 *                  PIVTNG not equal to 'N'
00365 *           -20 => KL negative
00366 *           -21 => KU negative, or SYM='S' or 'H' and KU not equal to KL
00367 *           -22 => SPARSE not in range 0. to 1.
00368 *           -24 => PACK illegal string, or PACK='U', 'L', 'B' or 'Q'
00369 *                  and SYM='N', or PACK='C' and SYM='N' and either KL
00370 *                  not equal to 0 or N not equal to M, or PACK='R' and
00371 *                  SYM='N', and either KU not equal to 0 or N not equal
00372 *                  to M
00373 *           -26 => LDA too small
00374 *             1 => Error return from CLATM1 (computing D)
00375 *             2 => Cannot scale diagonal to DMAX (max. entry is 0)
00376 *             3 => Error return from CLATM1 (computing DL)
00377 *             4 => Error return from CLATM1 (computing DR)
00378 *             5 => ANORM is positive, but matrix constructed prior to
00379 *                  attempting to scale it to have norm ANORM, is zero
00380 *
00381 *  =====================================================================
00382 *
00383 *     .. Parameters ..
00384       REAL               ZERO
00385       PARAMETER          ( ZERO = 0.0E0 )
00386       REAL               ONE
00387       PARAMETER          ( ONE = 1.0E0 )
00388       COMPLEX            CONE
00389       PARAMETER          ( CONE = ( 1.0E0, 0.0E0 ) )
00390       COMPLEX            CZERO
00391       PARAMETER          ( CZERO = ( 0.0E0, 0.0E0 ) )
00392 *     ..
00393 *     .. Local Scalars ..
00394       LOGICAL            BADPVT, DZERO, FULBND
00395       INTEGER            I, IDIST, IGRADE, IISUB, IPACK, IPVTNG, IRSIGN,
00396      $                   ISUB, ISYM, J, JJSUB, JSUB, K, KLL, KUU, MNMIN,
00397      $                   MNSUB, MXSUB, NPVTS
00398       REAL               ONORM, TEMP
00399       COMPLEX            CALPHA, CTEMP
00400 *     ..
00401 *     .. Local Arrays ..
00402       REAL               TEMPA( 1 )
00403 *     ..
00404 *     .. External Functions ..
00405       LOGICAL            LSAME
00406       REAL               CLANGB, CLANGE, CLANSB, CLANSP, CLANSY
00407       COMPLEX            CLATM2, CLATM3
00408       EXTERNAL           LSAME, CLANGB, CLANGE, CLANSB, CLANSP, CLANSY,
00409      $                   CLATM2, CLATM3
00410 *     ..
00411 *     .. External Subroutines ..
00412       EXTERNAL           CLATM1, CSSCAL, XERBLA
00413 *     ..
00414 *     .. Intrinsic Functions ..
00415       INTRINSIC          ABS, CONJG, MAX, MIN, MOD, REAL
00416 *     ..
00417 *     .. Executable Statements ..
00418 *
00419 *     1)      Decode and Test the input parameters.
00420 *             Initialize flags & seed.
00421 *
00422       INFO = 0
00423 *
00424 *     Quick return if possible
00425 *
00426       IF( M.EQ.0 .OR. N.EQ.0 )
00427      $   RETURN
00428 *
00429 *     Decode DIST
00430 *
00431       IF( LSAME( DIST, 'U' ) ) THEN
00432          IDIST = 1
00433       ELSE IF( LSAME( DIST, 'S' ) ) THEN
00434          IDIST = 2
00435       ELSE IF( LSAME( DIST, 'N' ) ) THEN
00436          IDIST = 3
00437       ELSE IF( LSAME( DIST, 'D' ) ) THEN
00438          IDIST = 4
00439       ELSE
00440          IDIST = -1
00441       END IF
00442 *
00443 *     Decode SYM
00444 *
00445       IF( LSAME( SYM, 'H' ) ) THEN
00446          ISYM = 0
00447       ELSE IF( LSAME( SYM, 'N' ) ) THEN
00448          ISYM = 1
00449       ELSE IF( LSAME( SYM, 'S' ) ) THEN
00450          ISYM = 2
00451       ELSE
00452          ISYM = -1
00453       END IF
00454 *
00455 *     Decode RSIGN
00456 *
00457       IF( LSAME( RSIGN, 'F' ) ) THEN
00458          IRSIGN = 0
00459       ELSE IF( LSAME( RSIGN, 'T' ) ) THEN
00460          IRSIGN = 1
00461       ELSE
00462          IRSIGN = -1
00463       END IF
00464 *
00465 *     Decode PIVTNG
00466 *
00467       IF( LSAME( PIVTNG, 'N' ) ) THEN
00468          IPVTNG = 0
00469       ELSE IF( LSAME( PIVTNG, ' ' ) ) THEN
00470          IPVTNG = 0
00471       ELSE IF( LSAME( PIVTNG, 'L' ) ) THEN
00472          IPVTNG = 1
00473          NPVTS = M
00474       ELSE IF( LSAME( PIVTNG, 'R' ) ) THEN
00475          IPVTNG = 2
00476          NPVTS = N
00477       ELSE IF( LSAME( PIVTNG, 'B' ) ) THEN
00478          IPVTNG = 3
00479          NPVTS = MIN( N, M )
00480       ELSE IF( LSAME( PIVTNG, 'F' ) ) THEN
00481          IPVTNG = 3
00482          NPVTS = MIN( N, M )
00483       ELSE
00484          IPVTNG = -1
00485       END IF
00486 *
00487 *     Decode GRADE
00488 *
00489       IF( LSAME( GRADE, 'N' ) ) THEN
00490          IGRADE = 0
00491       ELSE IF( LSAME( GRADE, 'L' ) ) THEN
00492          IGRADE = 1
00493       ELSE IF( LSAME( GRADE, 'R' ) ) THEN
00494          IGRADE = 2
00495       ELSE IF( LSAME( GRADE, 'B' ) ) THEN
00496          IGRADE = 3
00497       ELSE IF( LSAME( GRADE, 'E' ) ) THEN
00498          IGRADE = 4
00499       ELSE IF( LSAME( GRADE, 'H' ) ) THEN
00500          IGRADE = 5
00501       ELSE IF( LSAME( GRADE, 'S' ) ) THEN
00502          IGRADE = 6
00503       ELSE
00504          IGRADE = -1
00505       END IF
00506 *
00507 *     Decode PACK
00508 *
00509       IF( LSAME( PACK, 'N' ) ) THEN
00510          IPACK = 0
00511       ELSE IF( LSAME( PACK, 'U' ) ) THEN
00512          IPACK = 1
00513       ELSE IF( LSAME( PACK, 'L' ) ) THEN
00514          IPACK = 2
00515       ELSE IF( LSAME( PACK, 'C' ) ) THEN
00516          IPACK = 3
00517       ELSE IF( LSAME( PACK, 'R' ) ) THEN
00518          IPACK = 4
00519       ELSE IF( LSAME( PACK, 'B' ) ) THEN
00520          IPACK = 5
00521       ELSE IF( LSAME( PACK, 'Q' ) ) THEN
00522          IPACK = 6
00523       ELSE IF( LSAME( PACK, 'Z' ) ) THEN
00524          IPACK = 7
00525       ELSE
00526          IPACK = -1
00527       END IF
00528 *
00529 *     Set certain internal parameters
00530 *
00531       MNMIN = MIN( M, N )
00532       KLL = MIN( KL, M-1 )
00533       KUU = MIN( KU, N-1 )
00534 *
00535 *     If inv(DL) is used, check to see if DL has a zero entry.
00536 *
00537       DZERO = .FALSE.
00538       IF( IGRADE.EQ.4 .AND. MODEL.EQ.0 ) THEN
00539          DO 10 I = 1, M
00540             IF( DL( I ).EQ.CZERO )
00541      $         DZERO = .TRUE.
00542    10    CONTINUE
00543       END IF
00544 *
00545 *     Check values in IPIVOT
00546 *
00547       BADPVT = .FALSE.
00548       IF( IPVTNG.GT.0 ) THEN
00549          DO 20 J = 1, NPVTS
00550             IF( IPIVOT( J ).LE.0 .OR. IPIVOT( J ).GT.NPVTS )
00551      $         BADPVT = .TRUE.
00552    20    CONTINUE
00553       END IF
00554 *
00555 *     Set INFO if an error
00556 *
00557       IF( M.LT.0 ) THEN
00558          INFO = -1
00559       ELSE IF( M.NE.N .AND. ( ISYM.EQ.0 .OR. ISYM.EQ.2 ) ) THEN
00560          INFO = -1
00561       ELSE IF( N.LT.0 ) THEN
00562          INFO = -2
00563       ELSE IF( IDIST.EQ.-1 ) THEN
00564          INFO = -3
00565       ELSE IF( ISYM.EQ.-1 ) THEN
00566          INFO = -5
00567       ELSE IF( MODE.LT.-6 .OR. MODE.GT.6 ) THEN
00568          INFO = -7
00569       ELSE IF( ( MODE.NE.-6 .AND. MODE.NE.0 .AND. MODE.NE.6 ) .AND.
00570      $         COND.LT.ONE ) THEN
00571          INFO = -8
00572       ELSE IF( ( MODE.NE.-6 .AND. MODE.NE.0 .AND. MODE.NE.6 ) .AND.
00573      $         IRSIGN.EQ.-1 ) THEN
00574          INFO = -10
00575       ELSE IF( IGRADE.EQ.-1 .OR. ( IGRADE.EQ.4 .AND. M.NE.N ) .OR.
00576      $         ( ( IGRADE.EQ.1 .OR. IGRADE.EQ.2 .OR. IGRADE.EQ.3 .OR.
00577      $         IGRADE.EQ.4 .OR. IGRADE.EQ.6 ) .AND. ISYM.EQ.0 ) .OR.
00578      $         ( ( IGRADE.EQ.1 .OR. IGRADE.EQ.2 .OR. IGRADE.EQ.3 .OR.
00579      $         IGRADE.EQ.4 .OR. IGRADE.EQ.5 ) .AND. ISYM.EQ.2 ) ) THEN
00580          INFO = -11
00581       ELSE IF( IGRADE.EQ.4 .AND. DZERO ) THEN
00582          INFO = -12
00583       ELSE IF( ( IGRADE.EQ.1 .OR. IGRADE.EQ.3 .OR. IGRADE.EQ.4 .OR.
00584      $         IGRADE.EQ.5 .OR. IGRADE.EQ.6 ) .AND.
00585      $         ( MODEL.LT.-6 .OR. MODEL.GT.6 ) ) THEN
00586          INFO = -13
00587       ELSE IF( ( IGRADE.EQ.1 .OR. IGRADE.EQ.3 .OR. IGRADE.EQ.4 .OR.
00588      $         IGRADE.EQ.5 .OR. IGRADE.EQ.6 ) .AND.
00589      $         ( MODEL.NE.-6 .AND. MODEL.NE.0 .AND. MODEL.NE.6 ) .AND.
00590      $         CONDL.LT.ONE ) THEN
00591          INFO = -14
00592       ELSE IF( ( IGRADE.EQ.2 .OR. IGRADE.EQ.3 ) .AND.
00593      $         ( MODER.LT.-6 .OR. MODER.GT.6 ) ) THEN
00594          INFO = -16
00595       ELSE IF( ( IGRADE.EQ.2 .OR. IGRADE.EQ.3 ) .AND.
00596      $         ( MODER.NE.-6 .AND. MODER.NE.0 .AND. MODER.NE.6 ) .AND.
00597      $         CONDR.LT.ONE ) THEN
00598          INFO = -17
00599       ELSE IF( IPVTNG.EQ.-1 .OR. ( IPVTNG.EQ.3 .AND. M.NE.N ) .OR.
00600      $         ( ( IPVTNG.EQ.1 .OR. IPVTNG.EQ.2 ) .AND. ( ISYM.EQ.0 .OR.
00601      $         ISYM.EQ.2 ) ) ) THEN
00602          INFO = -18
00603       ELSE IF( IPVTNG.NE.0 .AND. BADPVT ) THEN
00604          INFO = -19
00605       ELSE IF( KL.LT.0 ) THEN
00606          INFO = -20
00607       ELSE IF( KU.LT.0 .OR. ( ( ISYM.EQ.0 .OR. ISYM.EQ.2 ) .AND. KL.NE.
00608      $         KU ) ) THEN
00609          INFO = -21
00610       ELSE IF( SPARSE.LT.ZERO .OR. SPARSE.GT.ONE ) THEN
00611          INFO = -22
00612       ELSE IF( IPACK.EQ.-1 .OR. ( ( IPACK.EQ.1 .OR. IPACK.EQ.2 .OR.
00613      $         IPACK.EQ.5 .OR. IPACK.EQ.6 ) .AND. ISYM.EQ.1 ) .OR.
00614      $         ( IPACK.EQ.3 .AND. ISYM.EQ.1 .AND. ( KL.NE.0 .OR. M.NE.
00615      $         N ) ) .OR. ( IPACK.EQ.4 .AND. ISYM.EQ.1 .AND. ( KU.NE.
00616      $         0 .OR. M.NE.N ) ) ) THEN
00617          INFO = -24
00618       ELSE IF( ( ( IPACK.EQ.0 .OR. IPACK.EQ.1 .OR. IPACK.EQ.2 ) .AND.
00619      $         LDA.LT.MAX( 1, M ) ) .OR. ( ( IPACK.EQ.3 .OR. IPACK.EQ.
00620      $         4 ) .AND. LDA.LT.1 ) .OR. ( ( IPACK.EQ.5 .OR. IPACK.EQ.
00621      $         6 ) .AND. LDA.LT.KUU+1 ) .OR.
00622      $         ( IPACK.EQ.7 .AND. LDA.LT.KLL+KUU+1 ) ) THEN
00623          INFO = -26
00624       END IF
00625 *
00626       IF( INFO.NE.0 ) THEN
00627          CALL XERBLA( 'CLATMR', -INFO )
00628          RETURN
00629       END IF
00630 *
00631 *     Decide if we can pivot consistently
00632 *
00633       FULBND = .FALSE.
00634       IF( KUU.EQ.N-1 .AND. KLL.EQ.M-1 )
00635      $   FULBND = .TRUE.
00636 *
00637 *     Initialize random number generator
00638 *
00639       DO 30 I = 1, 4
00640          ISEED( I ) = MOD( ABS( ISEED( I ) ), 4096 )
00641    30 CONTINUE
00642 *
00643       ISEED( 4 ) = 2*( ISEED( 4 ) / 2 ) + 1
00644 *
00645 *     2)      Set up D, DL, and DR, if indicated.
00646 *
00647 *             Compute D according to COND and MODE
00648 *
00649       CALL CLATM1( MODE, COND, IRSIGN, IDIST, ISEED, D, MNMIN, INFO )
00650       IF( INFO.NE.0 ) THEN
00651          INFO = 1
00652          RETURN
00653       END IF
00654       IF( MODE.NE.0 .AND. MODE.NE.-6 .AND. MODE.NE.6 ) THEN
00655 *
00656 *        Scale by DMAX
00657 *
00658          TEMP = ABS( D( 1 ) )
00659          DO 40 I = 2, MNMIN
00660             TEMP = MAX( TEMP, ABS( D( I ) ) )
00661    40    CONTINUE
00662          IF( TEMP.EQ.ZERO .AND. DMAX.NE.CZERO ) THEN
00663             INFO = 2
00664             RETURN
00665          END IF
00666          IF( TEMP.NE.ZERO ) THEN
00667             CALPHA = DMAX / TEMP
00668          ELSE
00669             CALPHA = CONE
00670          END IF
00671          DO 50 I = 1, MNMIN
00672             D( I ) = CALPHA*D( I )
00673    50    CONTINUE
00674 *
00675       END IF
00676 *
00677 *     If matrix Hermitian, make D real
00678 *
00679       IF( ISYM.EQ.0 ) THEN
00680          DO 60 I = 1, MNMIN
00681             D( I ) = REAL( D( I ) )
00682    60    CONTINUE
00683       END IF
00684 *
00685 *     Compute DL if grading set
00686 *
00687       IF( IGRADE.EQ.1 .OR. IGRADE.EQ.3 .OR. IGRADE.EQ.4 .OR. IGRADE.EQ.
00688      $    5 .OR. IGRADE.EQ.6 ) THEN
00689          CALL CLATM1( MODEL, CONDL, 0, IDIST, ISEED, DL, M, INFO )
00690          IF( INFO.NE.0 ) THEN
00691             INFO = 3
00692             RETURN
00693          END IF
00694       END IF
00695 *
00696 *     Compute DR if grading set
00697 *
00698       IF( IGRADE.EQ.2 .OR. IGRADE.EQ.3 ) THEN
00699          CALL CLATM1( MODER, CONDR, 0, IDIST, ISEED, DR, N, INFO )
00700          IF( INFO.NE.0 ) THEN
00701             INFO = 4
00702             RETURN
00703          END IF
00704       END IF
00705 *
00706 *     3)     Generate IWORK if pivoting
00707 *
00708       IF( IPVTNG.GT.0 ) THEN
00709          DO 70 I = 1, NPVTS
00710             IWORK( I ) = I
00711    70    CONTINUE
00712          IF( FULBND ) THEN
00713             DO 80 I = 1, NPVTS
00714                K = IPIVOT( I )
00715                J = IWORK( I )
00716                IWORK( I ) = IWORK( K )
00717                IWORK( K ) = J
00718    80       CONTINUE
00719          ELSE
00720             DO 90 I = NPVTS, 1, -1
00721                K = IPIVOT( I )
00722                J = IWORK( I )
00723                IWORK( I ) = IWORK( K )
00724                IWORK( K ) = J
00725    90       CONTINUE
00726          END IF
00727       END IF
00728 *
00729 *     4)      Generate matrices for each kind of PACKing
00730 *             Always sweep matrix columnwise (if symmetric, upper
00731 *             half only) so that matrix generated does not depend
00732 *             on PACK
00733 *
00734       IF( FULBND ) THEN
00735 *
00736 *        Use CLATM3 so matrices generated with differing PIVOTing only
00737 *        differ only in the order of their rows and/or columns.
00738 *
00739          IF( IPACK.EQ.0 ) THEN
00740             IF( ISYM.EQ.0 ) THEN
00741                DO 110 J = 1, N
00742                   DO 100 I = 1, J
00743                      CTEMP = CLATM3( M, N, I, J, ISUB, JSUB, KL, KU,
00744      $                       IDIST, ISEED, D, IGRADE, DL, DR, IPVTNG,
00745      $                       IWORK, SPARSE )
00746                      A( ISUB, JSUB ) = CTEMP
00747                      A( JSUB, ISUB ) = CONJG( CTEMP )
00748   100             CONTINUE
00749   110          CONTINUE
00750             ELSE IF( ISYM.EQ.1 ) THEN
00751                DO 130 J = 1, N
00752                   DO 120 I = 1, M
00753                      CTEMP = CLATM3( M, N, I, J, ISUB, JSUB, KL, KU,
00754      $                       IDIST, ISEED, D, IGRADE, DL, DR, IPVTNG,
00755      $                       IWORK, SPARSE )
00756                      A( ISUB, JSUB ) = CTEMP
00757   120             CONTINUE
00758   130          CONTINUE
00759             ELSE IF( ISYM.EQ.2 ) THEN
00760                DO 150 J = 1, N
00761                   DO 140 I = 1, J
00762                      CTEMP = CLATM3( M, N, I, J, ISUB, JSUB, KL, KU,
00763      $                       IDIST, ISEED, D, IGRADE, DL, DR, IPVTNG,
00764      $                       IWORK, SPARSE )
00765                      A( ISUB, JSUB ) = CTEMP
00766                      A( JSUB, ISUB ) = CTEMP
00767   140             CONTINUE
00768   150          CONTINUE
00769             END IF
00770 *
00771          ELSE IF( IPACK.EQ.1 ) THEN
00772 *
00773             DO 170 J = 1, N
00774                DO 160 I = 1, J
00775                   CTEMP = CLATM3( M, N, I, J, ISUB, JSUB, KL, KU, IDIST,
00776      $                    ISEED, D, IGRADE, DL, DR, IPVTNG, IWORK,
00777      $                    SPARSE )
00778                   MNSUB = MIN( ISUB, JSUB )
00779                   MXSUB = MAX( ISUB, JSUB )
00780                   IF( MXSUB.EQ.ISUB .AND. ISYM.EQ.0 ) THEN
00781                      A( MNSUB, MXSUB ) = CONJG( CTEMP )
00782                   ELSE
00783                      A( MNSUB, MXSUB ) = CTEMP
00784                   END IF
00785                   IF( MNSUB.NE.MXSUB )
00786      $               A( MXSUB, MNSUB ) = CZERO
00787   160          CONTINUE
00788   170       CONTINUE
00789 *
00790          ELSE IF( IPACK.EQ.2 ) THEN
00791 *
00792             DO 190 J = 1, N
00793                DO 180 I = 1, J
00794                   CTEMP = CLATM3( M, N, I, J, ISUB, JSUB, KL, KU, IDIST,
00795      $                    ISEED, D, IGRADE, DL, DR, IPVTNG, IWORK,
00796      $                    SPARSE )
00797                   MNSUB = MIN( ISUB, JSUB )
00798                   MXSUB = MAX( ISUB, JSUB )
00799                   IF( MXSUB.EQ.JSUB .AND. ISYM.EQ.0 ) THEN
00800                      A( MXSUB, MNSUB ) = CONJG( CTEMP )
00801                   ELSE
00802                      A( MXSUB, MNSUB ) = CTEMP
00803                   END IF
00804                   IF( MNSUB.NE.MXSUB )
00805      $               A( MNSUB, MXSUB ) = CZERO
00806   180          CONTINUE
00807   190       CONTINUE
00808 *
00809          ELSE IF( IPACK.EQ.3 ) THEN
00810 *
00811             DO 210 J = 1, N
00812                DO 200 I = 1, J
00813                   CTEMP = CLATM3( M, N, I, J, ISUB, JSUB, KL, KU, IDIST,
00814      $                    ISEED, D, IGRADE, DL, DR, IPVTNG, IWORK,
00815      $                    SPARSE )
00816 *
00817 *                 Compute K = location of (ISUB,JSUB) entry in packed
00818 *                 array
00819 *
00820                   MNSUB = MIN( ISUB, JSUB )
00821                   MXSUB = MAX( ISUB, JSUB )
00822                   K = MXSUB*( MXSUB-1 ) / 2 + MNSUB
00823 *
00824 *                 Convert K to (IISUB,JJSUB) location
00825 *
00826                   JJSUB = ( K-1 ) / LDA + 1
00827                   IISUB = K - LDA*( JJSUB-1 )
00828 *
00829                   IF( MXSUB.EQ.ISUB .AND. ISYM.EQ.0 ) THEN
00830                      A( IISUB, JJSUB ) = CONJG( CTEMP )
00831                   ELSE
00832                      A( IISUB, JJSUB ) = CTEMP
00833                   END IF
00834   200          CONTINUE
00835   210       CONTINUE
00836 *
00837          ELSE IF( IPACK.EQ.4 ) THEN
00838 *
00839             DO 230 J = 1, N
00840                DO 220 I = 1, J
00841                   CTEMP = CLATM3( M, N, I, J, ISUB, JSUB, KL, KU, IDIST,
00842      $                    ISEED, D, IGRADE, DL, DR, IPVTNG, IWORK,
00843      $                    SPARSE )
00844 *
00845 *                 Compute K = location of (I,J) entry in packed array
00846 *
00847                   MNSUB = MIN( ISUB, JSUB )
00848                   MXSUB = MAX( ISUB, JSUB )
00849                   IF( MNSUB.EQ.1 ) THEN
00850                      K = MXSUB
00851                   ELSE
00852                      K = N*( N+1 ) / 2 - ( N-MNSUB+1 )*( N-MNSUB+2 ) /
00853      $                   2 + MXSUB - MNSUB + 1
00854                   END IF
00855 *
00856 *                 Convert K to (IISUB,JJSUB) location
00857 *
00858                   JJSUB = ( K-1 ) / LDA + 1
00859                   IISUB = K - LDA*( JJSUB-1 )
00860 *
00861                   IF( MXSUB.EQ.JSUB .AND. ISYM.EQ.0 ) THEN
00862                      A( IISUB, JJSUB ) = CONJG( CTEMP )
00863                   ELSE
00864                      A( IISUB, JJSUB ) = CTEMP
00865                   END IF
00866   220          CONTINUE
00867   230       CONTINUE
00868 *
00869          ELSE IF( IPACK.EQ.5 ) THEN
00870 *
00871             DO 250 J = 1, N
00872                DO 240 I = J - KUU, J
00873                   IF( I.LT.1 ) THEN
00874                      A( J-I+1, I+N ) = CZERO
00875                   ELSE
00876                      CTEMP = CLATM3( M, N, I, J, ISUB, JSUB, KL, KU,
00877      $                       IDIST, ISEED, D, IGRADE, DL, DR, IPVTNG,
00878      $                       IWORK, SPARSE )
00879                      MNSUB = MIN( ISUB, JSUB )
00880                      MXSUB = MAX( ISUB, JSUB )
00881                      IF( MXSUB.EQ.JSUB .AND. ISYM.EQ.0 ) THEN
00882                         A( MXSUB-MNSUB+1, MNSUB ) = CONJG( CTEMP )
00883                      ELSE
00884                         A( MXSUB-MNSUB+1, MNSUB ) = CTEMP
00885                      END IF
00886                   END IF
00887   240          CONTINUE
00888   250       CONTINUE
00889 *
00890          ELSE IF( IPACK.EQ.6 ) THEN
00891 *
00892             DO 270 J = 1, N
00893                DO 260 I = J - KUU, J
00894                   CTEMP = CLATM3( M, N, I, J, ISUB, JSUB, KL, KU, IDIST,
00895      $                    ISEED, D, IGRADE, DL, DR, IPVTNG, IWORK,
00896      $                    SPARSE )
00897                   MNSUB = MIN( ISUB, JSUB )
00898                   MXSUB = MAX( ISUB, JSUB )
00899                   IF( MXSUB.EQ.ISUB .AND. ISYM.EQ.0 ) THEN
00900                      A( MNSUB-MXSUB+KUU+1, MXSUB ) = CONJG( CTEMP )
00901                   ELSE
00902                      A( MNSUB-MXSUB+KUU+1, MXSUB ) = CTEMP
00903                   END IF
00904   260          CONTINUE
00905   270       CONTINUE
00906 *
00907          ELSE IF( IPACK.EQ.7 ) THEN
00908 *
00909             IF( ISYM.NE.1 ) THEN
00910                DO 290 J = 1, N
00911                   DO 280 I = J - KUU, J
00912                      CTEMP = CLATM3( M, N, I, J, ISUB, JSUB, KL, KU,
00913      $                       IDIST, ISEED, D, IGRADE, DL, DR, IPVTNG,
00914      $                       IWORK, SPARSE )
00915                      MNSUB = MIN( ISUB, JSUB )
00916                      MXSUB = MAX( ISUB, JSUB )
00917                      IF( I.LT.1 )
00918      $                  A( J-I+1+KUU, I+N ) = CZERO
00919                      IF( MXSUB.EQ.ISUB .AND. ISYM.EQ.0 ) THEN
00920                         A( MNSUB-MXSUB+KUU+1, MXSUB ) = CONJG( CTEMP )
00921                      ELSE
00922                         A( MNSUB-MXSUB+KUU+1, MXSUB ) = CTEMP
00923                      END IF
00924                      IF( I.GE.1 .AND. MNSUB.NE.MXSUB ) THEN
00925                         IF( MNSUB.EQ.ISUB .AND. ISYM.EQ.0 ) THEN
00926                            A( MXSUB-MNSUB+1+KUU,
00927      $                        MNSUB ) = CONJG( CTEMP )
00928                         ELSE
00929                            A( MXSUB-MNSUB+1+KUU, MNSUB ) = CTEMP
00930                         END IF
00931                      END IF
00932   280             CONTINUE
00933   290          CONTINUE
00934             ELSE IF( ISYM.EQ.1 ) THEN
00935                DO 310 J = 1, N
00936                   DO 300 I = J - KUU, J + KLL
00937                      CTEMP = CLATM3( M, N, I, J, ISUB, JSUB, KL, KU,
00938      $                       IDIST, ISEED, D, IGRADE, DL, DR, IPVTNG,
00939      $                       IWORK, SPARSE )
00940                      A( ISUB-JSUB+KUU+1, JSUB ) = CTEMP
00941   300             CONTINUE
00942   310          CONTINUE
00943             END IF
00944 *
00945          END IF
00946 *
00947       ELSE
00948 *
00949 *        Use CLATM2
00950 *
00951          IF( IPACK.EQ.0 ) THEN
00952             IF( ISYM.EQ.0 ) THEN
00953                DO 330 J = 1, N
00954                   DO 320 I = 1, J
00955                      A( I, J ) = CLATM2( M, N, I, J, KL, KU, IDIST,
00956      $                           ISEED, D, IGRADE, DL, DR, IPVTNG,
00957      $                           IWORK, SPARSE )
00958                      A( J, I ) = CONJG( A( I, J ) )
00959   320             CONTINUE
00960   330          CONTINUE
00961             ELSE IF( ISYM.EQ.1 ) THEN
00962                DO 350 J = 1, N
00963                   DO 340 I = 1, M
00964                      A( I, J ) = CLATM2( M, N, I, J, KL, KU, IDIST,
00965      $                           ISEED, D, IGRADE, DL, DR, IPVTNG,
00966      $                           IWORK, SPARSE )
00967   340             CONTINUE
00968   350          CONTINUE
00969             ELSE IF( ISYM.EQ.2 ) THEN
00970                DO 370 J = 1, N
00971                   DO 360 I = 1, J
00972                      A( I, J ) = CLATM2( M, N, I, J, KL, KU, IDIST,
00973      $                           ISEED, D, IGRADE, DL, DR, IPVTNG,
00974      $                           IWORK, SPARSE )
00975                      A( J, I ) = A( I, J )
00976   360             CONTINUE
00977   370          CONTINUE
00978             END IF
00979 *
00980          ELSE IF( IPACK.EQ.1 ) THEN
00981 *
00982             DO 390 J = 1, N
00983                DO 380 I = 1, J
00984                   A( I, J ) = CLATM2( M, N, I, J, KL, KU, IDIST, ISEED,
00985      $                        D, IGRADE, DL, DR, IPVTNG, IWORK, SPARSE )
00986                   IF( I.NE.J )
00987      $               A( J, I ) = CZERO
00988   380          CONTINUE
00989   390       CONTINUE
00990 *
00991          ELSE IF( IPACK.EQ.2 ) THEN
00992 *
00993             DO 410 J = 1, N
00994                DO 400 I = 1, J
00995                   IF( ISYM.EQ.0 ) THEN
00996                      A( J, I ) = CONJG( CLATM2( M, N, I, J, KL, KU,
00997      $                           IDIST, ISEED, D, IGRADE, DL, DR,
00998      $                           IPVTNG, IWORK, SPARSE ) )
00999                   ELSE
01000                      A( J, I ) = CLATM2( M, N, I, J, KL, KU, IDIST,
01001      $                           ISEED, D, IGRADE, DL, DR, IPVTNG,
01002      $                           IWORK, SPARSE )
01003                   END IF
01004                   IF( I.NE.J )
01005      $               A( I, J ) = CZERO
01006   400          CONTINUE
01007   410       CONTINUE
01008 *
01009          ELSE IF( IPACK.EQ.3 ) THEN
01010 *
01011             ISUB = 0
01012             JSUB = 1
01013             DO 430 J = 1, N
01014                DO 420 I = 1, J
01015                   ISUB = ISUB + 1
01016                   IF( ISUB.GT.LDA ) THEN
01017                      ISUB = 1
01018                      JSUB = JSUB + 1
01019                   END IF
01020                   A( ISUB, JSUB ) = CLATM2( M, N, I, J, KL, KU, IDIST,
01021      $                              ISEED, D, IGRADE, DL, DR, IPVTNG,
01022      $                              IWORK, SPARSE )
01023   420          CONTINUE
01024   430       CONTINUE
01025 *
01026          ELSE IF( IPACK.EQ.4 ) THEN
01027 *
01028             IF( ISYM.EQ.0 .OR. ISYM.EQ.2 ) THEN
01029                DO 450 J = 1, N
01030                   DO 440 I = 1, J
01031 *
01032 *                    Compute K = location of (I,J) entry in packed array
01033 *
01034                      IF( I.EQ.1 ) THEN
01035                         K = J
01036                      ELSE
01037                         K = N*( N+1 ) / 2 - ( N-I+1 )*( N-I+2 ) / 2 +
01038      $                      J - I + 1
01039                      END IF
01040 *
01041 *                    Convert K to (ISUB,JSUB) location
01042 *
01043                      JSUB = ( K-1 ) / LDA + 1
01044                      ISUB = K - LDA*( JSUB-1 )
01045 *
01046                      A( ISUB, JSUB ) = CLATM2( M, N, I, J, KL, KU,
01047      $                                 IDIST, ISEED, D, IGRADE, DL, DR,
01048      $                                 IPVTNG, IWORK, SPARSE )
01049                      IF( ISYM.EQ.0 )
01050      $                  A( ISUB, JSUB ) = CONJG( A( ISUB, JSUB ) )
01051   440             CONTINUE
01052   450          CONTINUE
01053             ELSE
01054                ISUB = 0
01055                JSUB = 1
01056                DO 470 J = 1, N
01057                   DO 460 I = J, M
01058                      ISUB = ISUB + 1
01059                      IF( ISUB.GT.LDA ) THEN
01060                         ISUB = 1
01061                         JSUB = JSUB + 1
01062                      END IF
01063                      A( ISUB, JSUB ) = CLATM2( M, N, I, J, KL, KU,
01064      $                                 IDIST, ISEED, D, IGRADE, DL, DR,
01065      $                                 IPVTNG, IWORK, SPARSE )
01066   460             CONTINUE
01067   470          CONTINUE
01068             END IF
01069 *
01070          ELSE IF( IPACK.EQ.5 ) THEN
01071 *
01072             DO 490 J = 1, N
01073                DO 480 I = J - KUU, J
01074                   IF( I.LT.1 ) THEN
01075                      A( J-I+1, I+N ) = CZERO
01076                   ELSE
01077                      IF( ISYM.EQ.0 ) THEN
01078                         A( J-I+1, I ) = CONJG( CLATM2( M, N, I, J, KL,
01079      $                                  KU, IDIST, ISEED, D, IGRADE, DL,
01080      $                                  DR, IPVTNG, IWORK, SPARSE ) )
01081                      ELSE
01082                         A( J-I+1, I ) = CLATM2( M, N, I, J, KL, KU,
01083      $                                  IDIST, ISEED, D, IGRADE, DL, DR,
01084      $                                  IPVTNG, IWORK, SPARSE )
01085                      END IF
01086                   END IF
01087   480          CONTINUE
01088   490       CONTINUE
01089 *
01090          ELSE IF( IPACK.EQ.6 ) THEN
01091 *
01092             DO 510 J = 1, N
01093                DO 500 I = J - KUU, J
01094                   A( I-J+KUU+1, J ) = CLATM2( M, N, I, J, KL, KU, IDIST,
01095      $                                ISEED, D, IGRADE, DL, DR, IPVTNG,
01096      $                                IWORK, SPARSE )
01097   500          CONTINUE
01098   510       CONTINUE
01099 *
01100          ELSE IF( IPACK.EQ.7 ) THEN
01101 *
01102             IF( ISYM.NE.1 ) THEN
01103                DO 530 J = 1, N
01104                   DO 520 I = J - KUU, J
01105                      A( I-J+KUU+1, J ) = CLATM2( M, N, I, J, KL, KU,
01106      $                                   IDIST, ISEED, D, IGRADE, DL,
01107      $                                   DR, IPVTNG, IWORK, SPARSE )
01108                      IF( I.LT.1 )
01109      $                  A( J-I+1+KUU, I+N ) = CZERO
01110                      IF( I.GE.1 .AND. I.NE.J ) THEN
01111                         IF( ISYM.EQ.0 ) THEN
01112                            A( J-I+1+KUU, I ) = CONJG( A( I-J+KUU+1,
01113      $                                         J ) )
01114                         ELSE
01115                            A( J-I+1+KUU, I ) = A( I-J+KUU+1, J )
01116                         END IF
01117                      END IF
01118   520             CONTINUE
01119   530          CONTINUE
01120             ELSE IF( ISYM.EQ.1 ) THEN
01121                DO 550 J = 1, N
01122                   DO 540 I = J - KUU, J + KLL
01123                      A( I-J+KUU+1, J ) = CLATM2( M, N, I, J, KL, KU,
01124      $                                   IDIST, ISEED, D, IGRADE, DL,
01125      $                                   DR, IPVTNG, IWORK, SPARSE )
01126   540             CONTINUE
01127   550          CONTINUE
01128             END IF
01129 *
01130          END IF
01131 *
01132       END IF
01133 *
01134 *     5)      Scaling the norm
01135 *
01136       IF( IPACK.EQ.0 ) THEN
01137          ONORM = CLANGE( 'M', M, N, A, LDA, TEMPA )
01138       ELSE IF( IPACK.EQ.1 ) THEN
01139          ONORM = CLANSY( 'M', 'U', N, A, LDA, TEMPA )
01140       ELSE IF( IPACK.EQ.2 ) THEN
01141          ONORM = CLANSY( 'M', 'L', N, A, LDA, TEMPA )
01142       ELSE IF( IPACK.EQ.3 ) THEN
01143          ONORM = CLANSP( 'M', 'U', N, A, TEMPA )
01144       ELSE IF( IPACK.EQ.4 ) THEN
01145          ONORM = CLANSP( 'M', 'L', N, A, TEMPA )
01146       ELSE IF( IPACK.EQ.5 ) THEN
01147          ONORM = CLANSB( 'M', 'L', N, KLL, A, LDA, TEMPA )
01148       ELSE IF( IPACK.EQ.6 ) THEN
01149          ONORM = CLANSB( 'M', 'U', N, KUU, A, LDA, TEMPA )
01150       ELSE IF( IPACK.EQ.7 ) THEN
01151          ONORM = CLANGB( 'M', N, KLL, KUU, A, LDA, TEMPA )
01152       END IF
01153 *
01154       IF( ANORM.GE.ZERO ) THEN
01155 *
01156          IF( ANORM.GT.ZERO .AND. ONORM.EQ.ZERO ) THEN
01157 *
01158 *           Desired scaling impossible
01159 *
01160             INFO = 5
01161             RETURN
01162 *
01163          ELSE IF( ( ANORM.GT.ONE .AND. ONORM.LT.ONE ) .OR.
01164      $            ( ANORM.LT.ONE .AND. ONORM.GT.ONE ) ) THEN
01165 *
01166 *           Scale carefully to avoid over / underflow
01167 *
01168             IF( IPACK.LE.2 ) THEN
01169                DO 560 J = 1, N
01170                   CALL CSSCAL( M, ONE / ONORM, A( 1, J ), 1 )
01171                   CALL CSSCAL( M, ANORM, A( 1, J ), 1 )
01172   560          CONTINUE
01173 *
01174             ELSE IF( IPACK.EQ.3 .OR. IPACK.EQ.4 ) THEN
01175 *
01176                CALL CSSCAL( N*( N+1 ) / 2, ONE / ONORM, A, 1 )
01177                CALL CSSCAL( N*( N+1 ) / 2, ANORM, A, 1 )
01178 *
01179             ELSE IF( IPACK.GE.5 ) THEN
01180 *
01181                DO 570 J = 1, N
01182                   CALL CSSCAL( KLL+KUU+1, ONE / ONORM, A( 1, J ), 1 )
01183                   CALL CSSCAL( KLL+KUU+1, ANORM, A( 1, J ), 1 )
01184   570          CONTINUE
01185 *
01186             END IF
01187 *
01188          ELSE
01189 *
01190 *           Scale straightforwardly
01191 *
01192             IF( IPACK.LE.2 ) THEN
01193                DO 580 J = 1, N
01194                   CALL CSSCAL( M, ANORM / ONORM, A( 1, J ), 1 )
01195   580          CONTINUE
01196 *
01197             ELSE IF( IPACK.EQ.3 .OR. IPACK.EQ.4 ) THEN
01198 *
01199                CALL CSSCAL( N*( N+1 ) / 2, ANORM / ONORM, A, 1 )
01200 *
01201             ELSE IF( IPACK.GE.5 ) THEN
01202 *
01203                DO 590 J = 1, N
01204                   CALL CSSCAL( KLL+KUU+1, ANORM / ONORM, A( 1, J ), 1 )
01205   590          CONTINUE
01206             END IF
01207 *
01208          END IF
01209 *
01210       END IF
01211 *
01212 *     End of CLATMR
01213 *
01214       END