TESTING/MATGEN/slatmr.f

   1 *> \brief \b SLATMR
   2 *
   3 *  =========== DOCUMENTATION ===========
   4 *
   5 * Online html documentation available at
   6 *            http://www.netlib.org/lapack/explore-html/
   7 *
   8 *  Definition:
   9 *  ===========
  10 *
  11 *       SUBROUTINE SLATMR( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX,
  12 *                          RSIGN, GRADE, DL, MODEL, CONDL, DR, MODER,
  13 *                          CONDR, PIVTNG, IPIVOT, KL, KU, SPARSE, ANORM,
  14 *                          PACK, A, LDA, IWORK, INFO )
  15 *
  16 *       .. Scalar Arguments ..
  17 *       CHARACTER          DIST, GRADE, PACK, PIVTNG, RSIGN, SYM
  18 *       INTEGER            INFO, KL, KU, LDA, M, MODE, MODEL, MODER, N
  19 *       REAL               ANORM, COND, CONDL, CONDR, DMAX, SPARSE
  20 *       ..
  21 *       .. Array Arguments ..
  22 *       INTEGER            IPIVOT( * ), ISEED( 4 ), IWORK( * )
  23 *       REAL               A( LDA, * ), D( * ), DL( * ), DR( * )
  24 *       ..
  25 *
  26 *
  27 *> \par Purpose:
  28 *  =============
  29 *>
  30 *> \verbatim
  31 *>
  32 *>    SLATMR generates random matrices of various types for testing
  33 *>    LAPACK programs.
  34 *>
  35 *>    SLATMR operates by applying the following sequence of
  36 *>    operations:
  37 *>
  38 *>      Generate a matrix A with random entries of distribution DIST
  39 *>         which is symmetric if SYM='S', and nonsymmetric
  40 *>         if SYM='N'.
  41 *>
  42 *>      Set the diagonal to D, where D may be input or
  43 *>         computed according to MODE, COND, DMAX and RSIGN
  44 *>         as described below.
  45 *>
  46 *>      Grade the matrix, if desired, from the left and/or right
  47 *>         as specified by GRADE. The inputs DL, MODEL, CONDL, DR,
  48 *>         MODER and CONDR also determine the grading as described
  49 *>         below.
  50 *>
  51 *>      Permute, if desired, the rows and/or columns as specified by
  52 *>         PIVTNG and IPIVOT.
  53 *>
  54 *>      Set random entries to zero, if desired, to get a random sparse
  55 *>         matrix as specified by SPARSE.
  56 *>
  57 *>      Make A a band matrix, if desired, by zeroing out the matrix
  58 *>         outside a band of lower bandwidth KL and upper bandwidth KU.
  59 *>
  60 *>      Scale A, if desired, to have maximum entry ANORM.
  61 *>
  62 *>      Pack the matrix if desired. Options specified by PACK are:
  63 *>         no packing
  64 *>         zero out upper half (if symmetric)
  65 *>         zero out lower half (if symmetric)
  66 *>         store the upper half columnwise (if symmetric or
  67 *>             square upper triangular)
  68 *>         store the lower half columnwise (if symmetric or
  69 *>             square lower triangular)
  70 *>             same as upper half rowwise if symmetric
  71 *>         store the lower triangle in banded format (if symmetric)
  72 *>         store the upper triangle in banded format (if symmetric)
  73 *>         store the entire matrix in banded format
  74 *>
  75 *>    Note: If two calls to SLATMR differ only in the PACK parameter,
  76 *>          they will generate mathematically equivalent matrices.
  77 *>
  78 *>          If two calls to SLATMR both have full bandwidth (KL = M-1
  79 *>          and KU = N-1), and differ only in the PIVTNG and PACK
  80 *>          parameters, then the matrices generated will differ only
  81 *>          in the order of the rows and/or columns, and otherwise
  82 *>          contain the same data. This consistency cannot be and
  83 *>          is not maintained with less than full bandwidth.
  84 *> \endverbatim
  85 *
  86 *  Arguments:
  87 *  ==========
  88 *
  89 *> \param[in] M
  90 *> \verbatim
  91 *>          M is INTEGER
  92 *>           Number of rows of A. Not modified.
  93 *> \endverbatim
  94 *>
  95 *> \param[in] N
  96 *> \verbatim
  97 *>          N is INTEGER
  98 *>           Number of columns of A. Not modified.
  99 *> \endverbatim
 100 *>
 101 *> \param[in] DIST
 102 *> \verbatim
 103 *>          DIST is CHARACTER*1
 104 *>           On entry, DIST specifies the type of distribution to be used
 105 *>           to generate a random matrix .
 106 *>           'U' => UNIFORM( 0, 1 )  ( 'U' for uniform )
 107 *>           'S' => UNIFORM( -1, 1 ) ( 'S' for symmetric )
 108 *>           'N' => NORMAL( 0, 1 )   ( 'N' for normal )
 109 *>           Not modified.
 110 *> \endverbatim
 111 *>
 112 *> \param[in,out] ISEED
 113 *> \verbatim
 114 *>          ISEED is INTEGER array, dimension (4)
 115 *>           On entry ISEED specifies the seed of the random number
 116 *>           generator. They should lie between 0 and 4095 inclusive,
 117 *>           and ISEED(4) should be odd. The random number generator
 118 *>           uses a linear congruential sequence limited to small
 119 *>           integers, and so should produce machine independent
 120 *>           random numbers. The values of ISEED are changed on
 121 *>           exit, and can be used in the next call to SLATMR
 122 *>           to continue the same random number sequence.
 123 *>           Changed on exit.
 124 *> \endverbatim
 125 *>
 126 *> \param[in] SYM
 127 *> \verbatim
 128 *>          SYM is CHARACTER*1
 129 *>           If SYM='S' or 'H', generated matrix is symmetric.
 130 *>           If SYM='N', generated matrix is nonsymmetric.
 131 *>           Not modified.
 132 *> \endverbatim
 133 *>
 134 *> \param[in] D
 135 *> \verbatim
 136 *>          D is REAL array, dimension (min(M,N))
 137 *>           On entry this array specifies the diagonal entries
 138 *>           of the diagonal of A.  D may either be specified
 139 *>           on entry, or set according to MODE and COND as described
 140 *>           below. May be changed on exit if MODE is nonzero.
 141 *> \endverbatim
 142 *>
 143 *> \param[in] MODE
 144 *> \verbatim
 145 *>          MODE is INTEGER
 146 *>           On entry describes how D is to be used:
 147 *>           MODE = 0 means use D as input
 148 *>           MODE = 1 sets D(1)=1 and D(2:N)=1.0/COND
 149 *>           MODE = 2 sets D(1:N-1)=1 and D(N)=1.0/COND
 150 *>           MODE = 3 sets D(I)=COND**(-(I-1)/(N-1))
 151 *>           MODE = 4 sets D(i)=1 - (i-1)/(N-1)*(1 - 1/COND)
 152 *>           MODE = 5 sets D to random numbers in the range
 153 *>                    ( 1/COND , 1 ) such that their logarithms
 154 *>                    are uniformly distributed.
 155 *>           MODE = 6 set D to random numbers from same distribution
 156 *>                    as the rest of the matrix.
 157 *>           MODE < 0 has the same meaning as ABS(MODE), except that
 158 *>              the order of the elements of D is reversed.
 159 *>           Thus if MODE is positive, D has entries ranging from
 160 *>              1 to 1/COND, if negative, from 1/COND to 1,
 161 *>           Not modified.
 162 *> \endverbatim
 163 *>
 164 *> \param[in] COND
 165 *> \verbatim
 166 *>          COND is REAL
 167 *>           On entry, used as described under MODE above.
 168 *>           If used, it must be >= 1. Not modified.
 169 *> \endverbatim
 170 *>
 171 *> \param[in] DMAX
 172 *> \verbatim
 173 *>          DMAX is REAL
 174 *>           If MODE neither -6, 0 nor 6, the diagonal is scaled by
 175 *>           DMAX / max(abs(D(i))), so that maximum absolute entry
 176 *>           of diagonal is abs(DMAX). If DMAX is negative (or zero),
 177 *>           diagonal will be scaled by a negative number (or zero).
 178 *> \endverbatim
 179 *>
 180 *> \param[in] RSIGN
 181 *> \verbatim
 182 *>          RSIGN is CHARACTER*1
 183 *>           If MODE neither -6, 0 nor 6, specifies sign of diagonal
 184 *>           as follows:
 185 *>           'T' => diagonal entries are multiplied by 1 or -1
 186 *>                  with probability .5
 187 *>           'F' => diagonal unchanged
 188 *>           Not modified.
 189 *> \endverbatim
 190 *>
 191 *> \param[in] GRADE
 192 *> \verbatim
 193 *>          GRADE is CHARACTER*1
 194 *>           Specifies grading of matrix as follows:
 195 *>           'N'  => no grading
 196 *>           'L'  => matrix premultiplied by diag( DL )
 197 *>                   (only if matrix nonsymmetric)
 198 *>           'R'  => matrix postmultiplied by diag( DR )
 199 *>                   (only if matrix nonsymmetric)
 200 *>           'B'  => matrix premultiplied by diag( DL ) and
 201 *>                         postmultiplied by diag( DR )
 202 *>                   (only if matrix nonsymmetric)
 203 *>           'S' or 'H'  => matrix premultiplied by diag( DL ) and
 204 *>                          postmultiplied by diag( DL )
 205 *>                          ('S' for symmetric, or 'H' for Hermitian)
 206 *>           'E'  => matrix premultiplied by diag( DL ) and
 207 *>                         postmultiplied by inv( diag( DL ) )
 208 *>                         ( 'E' for eigenvalue invariance)
 209 *>                   (only if matrix nonsymmetric)
 210 *>                   Note: if GRADE='E', then M must equal N.
 211 *>           Not modified.
 212 *> \endverbatim
 213 *>
 214 *> \param[in,out] DL
 215 *> \verbatim
 216 *>          DL is REAL array, dimension (M)
 217 *>           If MODEL=0, then on entry this array specifies the diagonal
 218 *>           entries of a diagonal matrix used as described under GRADE
 219 *>           above. If MODEL is not zero, then DL will be set according
 220 *>           to MODEL and CONDL, analogous to the way D is set according
 221 *>           to MODE and COND (except there is no DMAX parameter for DL).
 222 *>           If GRADE='E', then DL cannot have zero entries.
 223 *>           Not referenced if GRADE = 'N' or 'R'. Changed on exit.
 224 *> \endverbatim
 225 *>
 226 *> \param[in] MODEL
 227 *> \verbatim
 228 *>          MODEL is INTEGER
 229 *>           This specifies how the diagonal array DL is to be computed,
 230 *>           just as MODE specifies how D is to be computed.
 231 *>           Not modified.
 232 *> \endverbatim
 233 *>
 234 *> \param[in] CONDL
 235 *> \verbatim
 236 *>          CONDL is REAL
 237 *>           When MODEL is not zero, this specifies the condition number
 238 *>           of the computed DL.  Not modified.
 239 *> \endverbatim
 240 *>
 241 *> \param[in,out] DR
 242 *> \verbatim
 243 *>          DR is REAL array, dimension (N)
 244 *>           If MODER=0, then on entry this array specifies the diagonal
 245 *>           entries of a diagonal matrix used as described under GRADE
 246 *>           above. If MODER is not zero, then DR will be set according
 247 *>           to MODER and CONDR, analogous to the way D is set according
 248 *>           to MODE and COND (except there is no DMAX parameter for DR).
 249 *>           Not referenced if GRADE = 'N', 'L', 'H', 'S' or 'E'.
 250 *>           Changed on exit.
 251 *> \endverbatim
 252 *>
 253 *> \param[in] MODER
 254 *> \verbatim
 255 *>          MODER is INTEGER
 256 *>           This specifies how the diagonal array DR is to be computed,
 257 *>           just as MODE specifies how D is to be computed.
 258 *>           Not modified.
 259 *> \endverbatim
 260 *>
 261 *> \param[in] CONDR
 262 *> \verbatim
 263 *>          CONDR is REAL
 264 *>           When MODER is not zero, this specifies the condition number
 265 *>           of the computed DR.  Not modified.
 266 *> \endverbatim
 267 *>
 268 *> \param[in] PIVTNG
 269 *> \verbatim
 270 *>          PIVTNG is CHARACTER*1
 271 *>           On entry specifies pivoting permutations as follows:
 272 *>           'N' or ' ' => none.
 273 *>           'L' => left or row pivoting (matrix must be nonsymmetric).
 274 *>           'R' => right or column pivoting (matrix must be
 275 *>                  nonsymmetric).
 276 *>           'B' or 'F' => both or full pivoting, i.e., on both sides.
 277 *>                         In this case, M must equal N
 278 *>
 279 *>           If two calls to SLATMR both have full bandwidth (KL = M-1
 280 *>           and KU = N-1), and differ only in the PIVTNG and PACK
 281 *>           parameters, then the matrices generated will differ only
 282 *>           in the order of the rows and/or columns, and otherwise
 283 *>           contain the same data. This consistency cannot be
 284 *>           maintained with less than full bandwidth.
 285 *> \endverbatim
 286 *>
 287 *> \param[in] IPIVOT
 288 *> \verbatim
 289 *>          IPIVOT is INTEGER array, dimension (N or M)
 290 *>           This array specifies the permutation used.  After the
 291 *>           basic matrix is generated, the rows, columns, or both
 292 *>           are permuted.   If, say, row pivoting is selected, SLATMR
 293 *>           starts with the *last* row and interchanges the M-th and
 294 *>           IPIVOT(M)-th rows, then moves to the next-to-last row,
 295 *>           interchanging the (M-1)-th and the IPIVOT(M-1)-th rows,
 296 *>           and so on.  In terms of "2-cycles", the permutation is
 297 *>           (1 IPIVOT(1)) (2 IPIVOT(2)) ... (M IPIVOT(M))
 298 *>           where the rightmost cycle is applied first.  This is the
 299 *>           *inverse* of the effect of pivoting in LINPACK.  The idea
 300 *>           is that factoring (with pivoting) an identity matrix
 301 *>           which has been inverse-pivoted in this way should
 302 *>           result in a pivot vector identical to IPIVOT.
 303 *>           Not referenced if PIVTNG = 'N'. Not modified.
 304 *> \endverbatim
 305 *>
 306 *> \param[in] SPARSE
 307 *> \verbatim
 308 *>          SPARSE is REAL
 309 *>           On entry specifies the sparsity of the matrix if a sparse
 310 *>           matrix is to be generated. SPARSE should lie between
 311 *>           0 and 1. To generate a sparse matrix, for each matrix entry
 312 *>           a uniform ( 0, 1 ) random number x is generated and
 313 *>           compared to SPARSE; if x is larger the matrix entry
 314 *>           is unchanged and if x is smaller the entry is set
 315 *>           to zero. Thus on the average a fraction SPARSE of the
 316 *>           entries will be set to zero.
 317 *>           Not modified.
 318 *> \endverbatim
 319 *>
 320 *> \param[in] KL
 321 *> \verbatim
 322 *>          KL is INTEGER
 323 *>           On entry specifies the lower bandwidth of the  matrix. For
 324 *>           example, KL=0 implies upper triangular, KL=1 implies upper
 325 *>           Hessenberg, and KL at least M-1 implies the matrix is not
 326 *>           banded. Must equal KU if matrix is symmetric.
 327 *>           Not modified.
 328 *> \endverbatim
 329 *>
 330 *> \param[in] KU
 331 *> \verbatim
 332 *>          KU is INTEGER
 333 *>           On entry specifies the upper bandwidth of the  matrix. For
 334 *>           example, KU=0 implies lower triangular, KU=1 implies lower
 335 *>           Hessenberg, and KU at least N-1 implies the matrix is not
 336 *>           banded. Must equal KL if matrix is symmetric.
 337 *>           Not modified.
 338 *> \endverbatim
 339 *>
 340 *> \param[in] ANORM
 341 *> \verbatim
 342 *>          ANORM is REAL
 343 *>           On entry specifies maximum entry of output matrix
 344 *>           (output matrix will by multiplied by a constant so that
 345 *>           its largest absolute entry equal ANORM)
 346 *>           if ANORM is nonnegative. If ANORM is negative no scaling
 347 *>           is done. Not modified.
 348 *> \endverbatim
 349 *>
 350 *> \param[in] PACK
 351 *> \verbatim
 352 *>          PACK is CHARACTER*1
 353 *>           On entry specifies packing of matrix as follows:
 354 *>           'N' => no packing
 355 *>           'U' => zero out all subdiagonal entries (if symmetric)
 356 *>           'L' => zero out all superdiagonal entries (if symmetric)
 357 *>           'C' => store the upper triangle columnwise
 358 *>                  (only if matrix symmetric or square upper triangular)
 359 *>           'R' => store the lower triangle columnwise
 360 *>                  (only if matrix symmetric or square lower triangular)
 361 *>                  (same as upper half rowwise if symmetric)
 362 *>           'B' => store the lower triangle in band storage scheme
 363 *>                  (only if matrix symmetric)
 364 *>           'Q' => store the upper triangle in band storage scheme
 365 *>                  (only if matrix symmetric)
 366 *>           'Z' => store the entire matrix in band storage scheme
 367 *>                      (pivoting can be provided for by using this
 368 *>                      option to store A in the trailing rows of
 369 *>                      the allocated storage)
 370 *>
 371 *>           Using these options, the various LAPACK packed and banded
 372 *>           storage schemes can be obtained:
 373 *>           GB               - use 'Z'
 374 *>           PB, SB or TB     - use 'B' or 'Q'
 375 *>           PP, SP or TP     - use 'C' or 'R'
 376 *>
 377 *>           If two calls to SLATMR differ only in the PACK parameter,
 378 *>           they will generate mathematically equivalent matrices.
 379 *>           Not modified.
 380 *> \endverbatim
 381 *>
 382 *> \param[in,out] A
 383 *> \verbatim
 384 *>          A is REAL array, dimension (LDA,N)
 385 *>           On exit A is the desired test matrix. Only those
 386 *>           entries of A which are significant on output
 387 *>           will be referenced (even if A is in packed or band
 388 *>           storage format). The 'unoccupied corners' of A in
 389 *>           band format will be zeroed out.
 390 *> \endverbatim
 391 *>
 392 *> \param[in] LDA
 393 *> \verbatim
 394 *>          LDA is INTEGER
 395 *>           on entry LDA specifies the first dimension of A as
 396 *>           declared in the calling program.
 397 *>           If PACK='N', 'U' or 'L', LDA must be at least max ( 1, M ).
 398 *>           If PACK='C' or 'R', LDA must be at least 1.
 399 *>           If PACK='B', or 'Q', LDA must be MIN ( KU+1, N )
 400 *>           If PACK='Z', LDA must be at least KUU+KLL+1, where
 401 *>           KUU = MIN ( KU, N-1 ) and KLL = MIN ( KL, N-1 )
 402 *>           Not modified.
 403 *> \endverbatim
 404 *>
 405 *> \param[out] IWORK
 406 *> \verbatim
 407 *>          IWORK is INTEGER array, dimension ( N or M)
 408 *>           Workspace. Not referenced if PIVTNG = 'N'. Changed on exit.
 409 *> \endverbatim
 410 *>
 411 *> \param[out] INFO
 412 *> \verbatim
 413 *>          INFO is INTEGER
 414 *>           Error parameter on exit:
 415 *>             0 => normal return
 416 *>            -1 => M negative or unequal to N and SYM='S' or 'H'
 417 *>            -2 => N negative
 418 *>            -3 => DIST illegal string
 419 *>            -5 => SYM illegal string
 420 *>            -7 => MODE not in range -6 to 6
 421 *>            -8 => COND less than 1.0, and MODE neither -6, 0 nor 6
 422 *>           -10 => MODE neither -6, 0 nor 6 and RSIGN illegal string
 423 *>           -11 => GRADE illegal string, or GRADE='E' and
 424 *>                  M not equal to N, or GRADE='L', 'R', 'B' or 'E' and
 425 *>                  SYM = 'S' or 'H'
 426 *>           -12 => GRADE = 'E' and DL contains zero
 427 *>           -13 => MODEL not in range -6 to 6 and GRADE= 'L', 'B', 'H',
 428 *>                  'S' or 'E'
 429 *>           -14 => CONDL less than 1.0, GRADE='L', 'B', 'H', 'S' or 'E',
 430 *>                  and MODEL neither -6, 0 nor 6
 431 *>           -16 => MODER not in range -6 to 6 and GRADE= 'R' or 'B'
 432 *>           -17 => CONDR less than 1.0, GRADE='R' or 'B', and
 433 *>                  MODER neither -6, 0 nor 6
 434 *>           -18 => PIVTNG illegal string, or PIVTNG='B' or 'F' and
 435 *>                  M not equal to N, or PIVTNG='L' or 'R' and SYM='S'
 436 *>                  or 'H'
 437 *>           -19 => IPIVOT contains out of range number and
 438 *>                  PIVTNG not equal to 'N'
 439 *>           -20 => KL negative
 440 *>           -21 => KU negative, or SYM='S' or 'H' and KU not equal to KL
 441 *>           -22 => SPARSE not in range 0. to 1.
 442 *>           -24 => PACK illegal string, or PACK='U', 'L', 'B' or 'Q'
 443 *>                  and SYM='N', or PACK='C' and SYM='N' and either KL
 444 *>                  not equal to 0 or N not equal to M, or PACK='R' and
 445 *>                  SYM='N', and either KU not equal to 0 or N not equal
 446 *>                  to M
 447 *>           -26 => LDA too small
 448 *>             1 => Error return from SLATM1 (computing D)
 449 *>             2 => Cannot scale diagonal to DMAX (max. entry is 0)
 450 *>             3 => Error return from SLATM1 (computing DL)
 451 *>             4 => Error return from SLATM1 (computing DR)
 452 *>             5 => ANORM is positive, but matrix constructed prior to
 453 *>                  attempting to scale it to have norm ANORM, is zero
 454 *> \endverbatim
 455 *
 456 *  Authors:
 457 *  ========
 458 *
 459 *> \author Univ. of Tennessee
 460 *> \author Univ. of California Berkeley
 461 *> \author Univ. of Colorado Denver
 462 *> \author NAG Ltd.
 463 *
 464 *> \date November 2011
 465 *
 466 *> \ingroup real_matgen
 467 *
 468 *  =====================================================================
 469       SUBROUTINE SLATMR( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX,
 470      $                   RSIGN, GRADE, DL, MODEL, CONDL, DR, MODER,
 471      $                   CONDR, PIVTNG, IPIVOT, KL, KU, SPARSE, ANORM,
 472      $                   PACK, A, LDA, IWORK, INFO )
 473 *
 474 *  -- LAPACK computational routine (version 3.4.0) --
 475 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 476 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
 477 *     November 2011
 478 *
 479 *     .. Scalar Arguments ..
 480       CHARACTER          DIST, GRADE, PACK, PIVTNG, RSIGN, SYM
 481       INTEGER            INFO, KL, KU, LDA, M, MODE, MODEL, MODER, N
 482       REAL               ANORM, COND, CONDL, CONDR, DMAX, SPARSE
 483 *     ..
 484 *     .. Array Arguments ..
 485       INTEGER            IPIVOT( * ), ISEED( 4 ), IWORK( * )
 486       REAL               A( LDA, * ), D( * ), DL( * ), DR( * )
 487 *     ..
 488 *
 489 *  =====================================================================
 490 *
 491 *     .. Parameters ..
 492       REAL               ZERO
 493       PARAMETER          ( ZERO = 0.0E0 )
 494       REAL               ONE
 495       PARAMETER          ( ONE = 1.0E0 )
 496 *     ..
 497 *     .. Local Scalars ..
 498       LOGICAL            BADPVT, DZERO, FULBND
 499       INTEGER            I, IDIST, IGRADE, IISUB, IPACK, IPVTNG, IRSIGN,
 500      $                   ISUB, ISYM, J, JJSUB, JSUB, K, KLL, KUU, MNMIN,
 501      $                   MNSUB, MXSUB, NPVTS
 502       REAL               ALPHA, ONORM, TEMP
 503 *     ..
 504 *     .. Local Arrays ..
 505       REAL               TEMPA( 1 )
 506 *     ..
 507 *     .. External Functions ..
 508       LOGICAL            LSAME
 509       REAL               SLANGB, SLANGE, SLANSB, SLANSP, SLANSY, SLATM2,
 510      $                   SLATM3
 511       EXTERNAL           LSAME, SLANGB, SLANGE, SLANSB, SLANSP, SLANSY,
 512      $                   SLATM2, SLATM3
 513 *     ..
 514 *     .. External Subroutines ..
 515       EXTERNAL           SLATM1, SSCAL, XERBLA
 516 *     ..
 517 *     .. Intrinsic Functions ..
 518       INTRINSIC          ABS, MAX, MIN, MOD
 519 *     ..
 520 *     .. Executable Statements ..
 521 *
 522 *     1)      Decode and Test the input parameters.
 523 *             Initialize flags & seed.
 524 *
 525       INFO = 0
 526 *
 527 *     Quick return if possible
 528 *
 529       IF( M.EQ.0 .OR. N.EQ.0 )
 530      $   RETURN
 531 *
 532 *     Decode DIST
 533 *
 534       IF( LSAME( DIST, 'U' ) ) THEN
 535          IDIST = 1
 536       ELSE IF( LSAME( DIST, 'S' ) ) THEN
 537          IDIST = 2
 538       ELSE IF( LSAME( DIST, 'N' ) ) THEN
 539          IDIST = 3
 540       ELSE
 541          IDIST = -1
 542       END IF
 543 *
 544 *     Decode SYM
 545 *
 546       IF( LSAME( SYM, 'S' ) ) THEN
 547          ISYM = 0
 548       ELSE IF( LSAME( SYM, 'N' ) ) THEN
 549          ISYM = 1
 550       ELSE IF( LSAME( SYM, 'H' ) ) THEN
 551          ISYM = 0
 552       ELSE
 553          ISYM = -1
 554       END IF
 555 *
 556 *     Decode RSIGN
 557 *
 558       IF( LSAME( RSIGN, 'F' ) ) THEN
 559          IRSIGN = 0
 560       ELSE IF( LSAME( RSIGN, 'T' ) ) THEN
 561          IRSIGN = 1
 562       ELSE
 563          IRSIGN = -1
 564       END IF
 565 *
 566 *     Decode PIVTNG
 567 *
 568       IF( LSAME( PIVTNG, 'N' ) ) THEN
 569          IPVTNG = 0
 570       ELSE IF( LSAME( PIVTNG, ' ' ) ) THEN
 571          IPVTNG = 0
 572       ELSE IF( LSAME( PIVTNG, 'L' ) ) THEN
 573          IPVTNG = 1
 574          NPVTS = M
 575       ELSE IF( LSAME( PIVTNG, 'R' ) ) THEN
 576          IPVTNG = 2
 577          NPVTS = N
 578       ELSE IF( LSAME( PIVTNG, 'B' ) ) THEN
 579          IPVTNG = 3
 580          NPVTS = MIN( N, M )
 581       ELSE IF( LSAME( PIVTNG, 'F' ) ) THEN
 582          IPVTNG = 3
 583          NPVTS = MIN( N, M )
 584       ELSE
 585          IPVTNG = -1
 586       END IF
 587 *
 588 *     Decode GRADE
 589 *
 590       IF( LSAME( GRADE, 'N' ) ) THEN
 591          IGRADE = 0
 592       ELSE IF( LSAME( GRADE, 'L' ) ) THEN
 593          IGRADE = 1
 594       ELSE IF( LSAME( GRADE, 'R' ) ) THEN
 595          IGRADE = 2
 596       ELSE IF( LSAME( GRADE, 'B' ) ) THEN
 597          IGRADE = 3
 598       ELSE IF( LSAME( GRADE, 'E' ) ) THEN
 599          IGRADE = 4
 600       ELSE IF( LSAME( GRADE, 'H' ) .OR. LSAME( GRADE, 'S' ) ) THEN
 601          IGRADE = 5
 602       ELSE
 603          IGRADE = -1
 604       END IF
 605 *
 606 *     Decode PACK
 607 *
 608       IF( LSAME( PACK, 'N' ) ) THEN
 609          IPACK = 0
 610       ELSE IF( LSAME( PACK, 'U' ) ) THEN
 611          IPACK = 1
 612       ELSE IF( LSAME( PACK, 'L' ) ) THEN
 613          IPACK = 2
 614       ELSE IF( LSAME( PACK, 'C' ) ) THEN
 615          IPACK = 3
 616       ELSE IF( LSAME( PACK, 'R' ) ) THEN
 617          IPACK = 4
 618       ELSE IF( LSAME( PACK, 'B' ) ) THEN
 619          IPACK = 5
 620       ELSE IF( LSAME( PACK, 'Q' ) ) THEN
 621          IPACK = 6
 622       ELSE IF( LSAME( PACK, 'Z' ) ) THEN
 623          IPACK = 7
 624       ELSE
 625          IPACK = -1
 626       END IF
 627 *
 628 *     Set certain internal parameters
 629 *
 630       MNMIN = MIN( M, N )
 631       KLL = MIN( KL, M-1 )
 632       KUU = MIN( KU, N-1 )
 633 *
 634 *     If inv(DL) is used, check to see if DL has a zero entry.
 635 *
 636       DZERO = .FALSE.
 637       IF( IGRADE.EQ.4 .AND. MODEL.EQ.0 ) THEN
 638          DO 10 I = 1, M
 639             IF( DL( I ).EQ.ZERO )
 640      $         DZERO = .TRUE.
 641    10    CONTINUE
 642       END IF
 643 *
 644 *     Check values in IPIVOT
 645 *
 646       BADPVT = .FALSE.
 647       IF( IPVTNG.GT.0 ) THEN
 648          DO 20 J = 1, NPVTS
 649             IF( IPIVOT( J ).LE.0 .OR. IPIVOT( J ).GT.NPVTS )
 650      $         BADPVT = .TRUE.
 651    20    CONTINUE
 652       END IF
 653 *
 654 *     Set INFO if an error
 655 *
 656       IF( M.LT.0 ) THEN
 657          INFO = -1
 658       ELSE IF( M.NE.N .AND. ISYM.EQ.0 ) THEN
 659          INFO = -1
 660       ELSE IF( N.LT.0 ) THEN
 661          INFO = -2
 662       ELSE IF( IDIST.EQ.-1 ) THEN
 663          INFO = -3
 664       ELSE IF( ISYM.EQ.-1 ) THEN
 665          INFO = -5
 666       ELSE IF( MODE.LT.-6 .OR. MODE.GT.6 ) THEN
 667          INFO = -7
 668       ELSE IF( ( MODE.NE.-6 .AND. MODE.NE.0 .AND. MODE.NE.6 ) .AND.
 669      $         COND.LT.ONE ) THEN
 670          INFO = -8
 671       ELSE IF( ( MODE.NE.-6 .AND. MODE.NE.0 .AND. MODE.NE.6 ) .AND.
 672      $         IRSIGN.EQ.-1 ) THEN
 673          INFO = -10
 674       ELSE IF( IGRADE.EQ.-1 .OR. ( IGRADE.EQ.4 .AND. M.NE.N ) .OR.
 675      $         ( ( IGRADE.GE.1 .AND. IGRADE.LE.4 ) .AND. ISYM.EQ.0 ) )
 676      $          THEN
 677          INFO = -11
 678       ELSE IF( IGRADE.EQ.4 .AND. DZERO ) THEN
 679          INFO = -12
 680       ELSE IF( ( IGRADE.EQ.1 .OR. IGRADE.EQ.3 .OR. IGRADE.EQ.4 .OR.
 681      $         IGRADE.EQ.5 ) .AND. ( MODEL.LT.-6 .OR. MODEL.GT.6 ) )
 682      $          THEN
 683          INFO = -13
 684       ELSE IF( ( IGRADE.EQ.1 .OR. IGRADE.EQ.3 .OR. IGRADE.EQ.4 .OR.
 685      $         IGRADE.EQ.5 ) .AND. ( MODEL.NE.-6 .AND. MODEL.NE.0 .AND.
 686      $         MODEL.NE.6 ) .AND. CONDL.LT.ONE ) THEN
 687          INFO = -14
 688       ELSE IF( ( IGRADE.EQ.2 .OR. IGRADE.EQ.3 ) .AND.
 689      $         ( MODER.LT.-6 .OR. MODER.GT.6 ) ) THEN
 690          INFO = -16
 691       ELSE IF( ( IGRADE.EQ.2 .OR. IGRADE.EQ.3 ) .AND.
 692      $         ( MODER.NE.-6 .AND. MODER.NE.0 .AND. MODER.NE.6 ) .AND.
 693      $         CONDR.LT.ONE ) THEN
 694          INFO = -17
 695       ELSE IF( IPVTNG.EQ.-1 .OR. ( IPVTNG.EQ.3 .AND. M.NE.N ) .OR.
 696      $         ( ( IPVTNG.EQ.1 .OR. IPVTNG.EQ.2 ) .AND. ISYM.EQ.0 ) )
 697      $          THEN
 698          INFO = -18
 699       ELSE IF( IPVTNG.NE.0 .AND. BADPVT ) THEN
 700          INFO = -19
 701       ELSE IF( KL.LT.0 ) THEN
 702          INFO = -20
 703       ELSE IF( KU.LT.0 .OR. ( ISYM.EQ.0 .AND. KL.NE.KU ) ) THEN
 704          INFO = -21
 705       ELSE IF( SPARSE.LT.ZERO .OR. SPARSE.GT.ONE ) THEN
 706          INFO = -22
 707       ELSE IF( IPACK.EQ.-1 .OR. ( ( IPACK.EQ.1 .OR. IPACK.EQ.2 .OR.
 708      $         IPACK.EQ.5 .OR. IPACK.EQ.6 ) .AND. ISYM.EQ.1 ) .OR.
 709      $         ( IPACK.EQ.3 .AND. ISYM.EQ.1 .AND. ( KL.NE.0 .OR. M.NE.
 710      $         N ) ) .OR. ( IPACK.EQ.4 .AND. ISYM.EQ.1 .AND. ( KU.NE.
 711      $         0 .OR. M.NE.N ) ) ) THEN
 712          INFO = -24
 713       ELSE IF( ( ( IPACK.EQ.0 .OR. IPACK.EQ.1 .OR. IPACK.EQ.2 ) .AND.
 714      $         LDA.LT.MAX( 1, M ) ) .OR. ( ( IPACK.EQ.3 .OR. IPACK.EQ.
 715      $         4 ) .AND. LDA.LT.1 ) .OR. ( ( IPACK.EQ.5 .OR. IPACK.EQ.
 716      $         6 ) .AND. LDA.LT.KUU+1 ) .OR.
 717      $         ( IPACK.EQ.7 .AND. LDA.LT.KLL+KUU+1 ) ) THEN
 718          INFO = -26
 719       END IF
 720 *
 721       IF( INFO.NE.0 ) THEN
 722          CALL XERBLA( 'SLATMR', -INFO )
 723          RETURN
 724       END IF
 725 *
 726 *     Decide if we can pivot consistently
 727 *
 728       FULBND = .FALSE.
 729       IF( KUU.EQ.N-1 .AND. KLL.EQ.M-1 )
 730      $   FULBND = .TRUE.
 731 *
 732 *     Initialize random number generator
 733 *
 734       DO 30 I = 1, 4
 735          ISEED( I ) = MOD( ABS( ISEED( I ) ), 4096 )
 736    30 CONTINUE
 737 *
 738       ISEED( 4 ) = 2*( ISEED( 4 ) / 2 ) + 1
 739 *
 740 *     2)      Set up D, DL, and DR, if indicated.
 741 *
 742 *             Compute D according to COND and MODE
 743 *
 744       CALL SLATM1( MODE, COND, IRSIGN, IDIST, ISEED, D, MNMIN, INFO )
 745       IF( INFO.NE.0 ) THEN
 746          INFO = 1
 747          RETURN
 748       END IF
 749       IF( MODE.NE.0 .AND. MODE.NE.-6 .AND. MODE.NE.6 ) THEN
 750 *
 751 *        Scale by DMAX
 752 *
 753          TEMP = ABS( D( 1 ) )
 754          DO 40 I = 2, MNMIN
 755             TEMP = MAX( TEMP, ABS( D( I ) ) )
 756    40    CONTINUE
 757          IF( TEMP.EQ.ZERO .AND. DMAX.NE.ZERO ) THEN
 758             INFO = 2
 759             RETURN
 760          END IF
 761          IF( TEMP.NE.ZERO ) THEN
 762             ALPHA = DMAX / TEMP
 763          ELSE
 764             ALPHA = ONE
 765          END IF
 766          DO 50 I = 1, MNMIN
 767             D( I ) = ALPHA*D( I )
 768    50    CONTINUE
 769 *
 770       END IF
 771 *
 772 *     Compute DL if grading set
 773 *
 774       IF( IGRADE.EQ.1 .OR. IGRADE.EQ.3 .OR. IGRADE.EQ.4 .OR. IGRADE.EQ.
 775      $    5 ) THEN
 776          CALL SLATM1( MODEL, CONDL, 0, IDIST, ISEED, DL, M, INFO )
 777          IF( INFO.NE.0 ) THEN
 778             INFO = 3
 779             RETURN
 780          END IF
 781       END IF
 782 *
 783 *     Compute DR if grading set
 784 *
 785       IF( IGRADE.EQ.2 .OR. IGRADE.EQ.3 ) THEN
 786          CALL SLATM1( MODER, CONDR, 0, IDIST, ISEED, DR, N, INFO )
 787          IF( INFO.NE.0 ) THEN
 788             INFO = 4
 789             RETURN
 790          END IF
 791       END IF
 792 *
 793 *     3)     Generate IWORK if pivoting
 794 *
 795       IF( IPVTNG.GT.0 ) THEN
 796          DO 60 I = 1, NPVTS
 797             IWORK( I ) = I
 798    60    CONTINUE
 799          IF( FULBND ) THEN
 800             DO 70 I = 1, NPVTS
 801                K = IPIVOT( I )
 802                J = IWORK( I )
 803                IWORK( I ) = IWORK( K )
 804                IWORK( K ) = J
 805    70       CONTINUE
 806          ELSE
 807             DO 80 I = NPVTS, 1, -1
 808                K = IPIVOT( I )
 809                J = IWORK( I )
 810                IWORK( I ) = IWORK( K )
 811                IWORK( K ) = J
 812    80       CONTINUE
 813          END IF
 814       END IF
 815 *
 816 *     4)      Generate matrices for each kind of PACKing
 817 *             Always sweep matrix columnwise (if symmetric, upper
 818 *             half only) so that matrix generated does not depend
 819 *             on PACK
 820 *
 821       IF( FULBND ) THEN
 822 *
 823 *        Use SLATM3 so matrices generated with differing PIVOTing only
 824 *        differ only in the order of their rows and/or columns.
 825 *
 826          IF( IPACK.EQ.0 ) THEN
 827             IF( ISYM.EQ.0 ) THEN
 828                DO 100 J = 1, N
 829                   DO 90 I = 1, J
 830                      TEMP = SLATM3( M, N, I, J, ISUB, JSUB, KL, KU,
 831      $                      IDIST, ISEED, D, IGRADE, DL, DR, IPVTNG,
 832      $                      IWORK, SPARSE )
 833                      A( ISUB, JSUB ) = TEMP
 834                      A( JSUB, ISUB ) = TEMP
 835    90             CONTINUE
 836   100          CONTINUE
 837             ELSE IF( ISYM.EQ.1 ) THEN
 838                DO 120 J = 1, N
 839                   DO 110 I = 1, M
 840                      TEMP = SLATM3( M, N, I, J, ISUB, JSUB, KL, KU,
 841      $                      IDIST, ISEED, D, IGRADE, DL, DR, IPVTNG,
 842      $                      IWORK, SPARSE )
 843                      A( ISUB, JSUB ) = TEMP
 844   110             CONTINUE
 845   120          CONTINUE
 846             END IF
 847 *
 848          ELSE IF( IPACK.EQ.1 ) THEN
 849 *
 850             DO 140 J = 1, N
 851                DO 130 I = 1, J
 852                   TEMP = SLATM3( M, N, I, J, ISUB, JSUB, KL, KU, IDIST,
 853      $                   ISEED, D, IGRADE, DL, DR, IPVTNG, IWORK,
 854      $                   SPARSE )
 855                   MNSUB = MIN( ISUB, JSUB )
 856                   MXSUB = MAX( ISUB, JSUB )
 857                   A( MNSUB, MXSUB ) = TEMP
 858                   IF( MNSUB.NE.MXSUB )
 859      $               A( MXSUB, MNSUB ) = ZERO
 860   130          CONTINUE
 861   140       CONTINUE
 862 *
 863          ELSE IF( IPACK.EQ.2 ) THEN
 864 *
 865             DO 160 J = 1, N
 866                DO 150 I = 1, J
 867                   TEMP = SLATM3( M, N, I, J, ISUB, JSUB, KL, KU, IDIST,
 868      $                   ISEED, D, IGRADE, DL, DR, IPVTNG, IWORK,
 869      $                   SPARSE )
 870                   MNSUB = MIN( ISUB, JSUB )
 871                   MXSUB = MAX( ISUB, JSUB )
 872                   A( MXSUB, MNSUB ) = TEMP
 873                   IF( MNSUB.NE.MXSUB )
 874      $               A( MNSUB, MXSUB ) = ZERO
 875   150          CONTINUE
 876   160       CONTINUE
 877 *
 878          ELSE IF( IPACK.EQ.3 ) THEN
 879 *
 880             DO 180 J = 1, N
 881                DO 170 I = 1, J
 882                   TEMP = SLATM3( M, N, I, J, ISUB, JSUB, KL, KU, IDIST,
 883      $                   ISEED, D, IGRADE, DL, DR, IPVTNG, IWORK,
 884      $                   SPARSE )
 885 *
 886 *                 Compute K = location of (ISUB,JSUB) entry in packed
 887 *                 array
 888 *
 889                   MNSUB = MIN( ISUB, JSUB )
 890                   MXSUB = MAX( ISUB, JSUB )
 891                   K = MXSUB*( MXSUB-1 ) / 2 + MNSUB
 892 *
 893 *                 Convert K to (IISUB,JJSUB) location
 894 *
 895                   JJSUB = ( K-1 ) / LDA + 1
 896                   IISUB = K - LDA*( JJSUB-1 )
 897 *
 898                   A( IISUB, JJSUB ) = TEMP
 899   170          CONTINUE
 900   180       CONTINUE
 901 *
 902          ELSE IF( IPACK.EQ.4 ) THEN
 903 *
 904             DO 200 J = 1, N
 905                DO 190 I = 1, J
 906                   TEMP = SLATM3( M, N, I, J, ISUB, JSUB, KL, KU, IDIST,
 907      $                   ISEED, D, IGRADE, DL, DR, IPVTNG, IWORK,
 908      $                   SPARSE )
 909 *
 910 *                 Compute K = location of (I,J) entry in packed array
 911 *
 912                   MNSUB = MIN( ISUB, JSUB )
 913                   MXSUB = MAX( ISUB, JSUB )
 914                   IF( MNSUB.EQ.1 ) THEN
 915                      K = MXSUB
 916                   ELSE
 917                      K = N*( N+1 ) / 2 - ( N-MNSUB+1 )*( N-MNSUB+2 ) /
 918      $                   2 + MXSUB - MNSUB + 1
 919                   END IF
 920 *
 921 *                 Convert K to (IISUB,JJSUB) location
 922 *
 923                   JJSUB = ( K-1 ) / LDA + 1
 924                   IISUB = K - LDA*( JJSUB-1 )
 925 *
 926                   A( IISUB, JJSUB ) = TEMP
 927   190          CONTINUE
 928   200       CONTINUE
 929 *
 930          ELSE IF( IPACK.EQ.5 ) THEN
 931 *
 932             DO 220 J = 1, N
 933                DO 210 I = J - KUU, J
 934                   IF( I.LT.1 ) THEN
 935                      A( J-I+1, I+N ) = ZERO
 936                   ELSE
 937                      TEMP = SLATM3( M, N, I, J, ISUB, JSUB, KL, KU,
 938      $                      IDIST, ISEED, D, IGRADE, DL, DR, IPVTNG,
 939      $                      IWORK, SPARSE )
 940                      MNSUB = MIN( ISUB, JSUB )
 941                      MXSUB = MAX( ISUB, JSUB )
 942                      A( MXSUB-MNSUB+1, MNSUB ) = TEMP
 943                   END IF
 944   210          CONTINUE
 945   220       CONTINUE
 946 *
 947          ELSE IF( IPACK.EQ.6 ) THEN
 948 *
 949             DO 240 J = 1, N
 950                DO 230 I = J - KUU, J
 951                   TEMP = SLATM3( M, N, I, J, ISUB, JSUB, KL, KU, IDIST,
 952      $                   ISEED, D, IGRADE, DL, DR, IPVTNG, IWORK,
 953      $                   SPARSE )
 954                   MNSUB = MIN( ISUB, JSUB )
 955                   MXSUB = MAX( ISUB, JSUB )
 956                   A( MNSUB-MXSUB+KUU+1, MXSUB ) = TEMP
 957   230          CONTINUE
 958   240       CONTINUE
 959 *
 960          ELSE IF( IPACK.EQ.7 ) THEN
 961 *
 962             IF( ISYM.EQ.0 ) THEN
 963                DO 260 J = 1, N
 964                   DO 250 I = J - KUU, J
 965                      TEMP = SLATM3( M, N, I, J, ISUB, JSUB, KL, KU,
 966      $                      IDIST, ISEED, D, IGRADE, DL, DR, IPVTNG,
 967      $                      IWORK, SPARSE )
 968                      MNSUB = MIN( ISUB, JSUB )
 969                      MXSUB = MAX( ISUB, JSUB )
 970                      A( MNSUB-MXSUB+KUU+1, MXSUB ) = TEMP
 971                      IF( I.LT.1 )
 972      $                  A( J-I+1+KUU, I+N ) = ZERO
 973                      IF( I.GE.1 .AND. MNSUB.NE.MXSUB )
 974      $                  A( MXSUB-MNSUB+1+KUU, MNSUB ) = TEMP
 975   250             CONTINUE
 976   260          CONTINUE
 977             ELSE IF( ISYM.EQ.1 ) THEN
 978                DO 280 J = 1, N
 979                   DO 270 I = J - KUU, J + KLL
 980                      TEMP = SLATM3( M, N, I, J, ISUB, JSUB, KL, KU,
 981      $                      IDIST, ISEED, D, IGRADE, DL, DR, IPVTNG,
 982      $                      IWORK, SPARSE )
 983                      A( ISUB-JSUB+KUU+1, JSUB ) = TEMP
 984   270             CONTINUE
 985   280          CONTINUE
 986             END IF
 987 *
 988          END IF
 989 *
 990       ELSE
 991 *
 992 *        Use SLATM2
 993 *
 994          IF( IPACK.EQ.0 ) THEN
 995             IF( ISYM.EQ.0 ) THEN
 996                DO 300 J = 1, N
 997                   DO 290 I = 1, J
 998                      A( I, J ) = SLATM2( M, N, I, J, KL, KU, IDIST,
 999      $                           ISEED, D, IGRADE, DL, DR, IPVTNG,
1000      $                           IWORK, SPARSE )
1001                      A( J, I ) = A( I, J )
1002   290             CONTINUE
1003   300          CONTINUE
1004             ELSE IF( ISYM.EQ.1 ) THEN
1005                DO 320 J = 1, N
1006                   DO 310 I = 1, M
1007                      A( I, J ) = SLATM2( M, N, I, J, KL, KU, IDIST,
1008      $                           ISEED, D, IGRADE, DL, DR, IPVTNG,
1009      $                           IWORK, SPARSE )
1010   310             CONTINUE
1011   320          CONTINUE
1012             END IF
1013 *
1014          ELSE IF( IPACK.EQ.1 ) THEN
1015 *
1016             DO 340 J = 1, N
1017                DO 330 I = 1, J
1018                   A( I, J ) = SLATM2( M, N, I, J, KL, KU, IDIST, ISEED,
1019      $                        D, IGRADE, DL, DR, IPVTNG, IWORK, SPARSE )
1020                   IF( I.NE.J )
1021      $               A( J, I ) = ZERO
1022   330          CONTINUE
1023   340       CONTINUE
1024 *
1025          ELSE IF( IPACK.EQ.2 ) THEN
1026 *
1027             DO 360 J = 1, N
1028                DO 350 I = 1, J
1029                   A( J, I ) = SLATM2( M, N, I, J, KL, KU, IDIST, ISEED,
1030      $                        D, IGRADE, DL, DR, IPVTNG, IWORK, SPARSE )
1031                   IF( I.NE.J )
1032      $               A( I, J ) = ZERO
1033   350          CONTINUE
1034   360       CONTINUE
1035 *
1036          ELSE IF( IPACK.EQ.3 ) THEN
1037 *
1038             ISUB = 0
1039             JSUB = 1
1040             DO 380 J = 1, N
1041                DO 370 I = 1, J
1042                   ISUB = ISUB + 1
1043                   IF( ISUB.GT.LDA ) THEN
1044                      ISUB = 1
1045                      JSUB = JSUB + 1
1046                   END IF
1047                   A( ISUB, JSUB ) = SLATM2( M, N, I, J, KL, KU, IDIST,
1048      $                              ISEED, D, IGRADE, DL, DR, IPVTNG,
1049      $                              IWORK, SPARSE )
1050   370          CONTINUE
1051   380       CONTINUE
1052 *
1053          ELSE IF( IPACK.EQ.4 ) THEN
1054 *
1055             IF( ISYM.EQ.0 ) THEN
1056                DO 400 J = 1, N
1057                   DO 390 I = 1, J
1058 *
1059 *                    Compute K = location of (I,J) entry in packed array
1060 *
1061                      IF( I.EQ.1 ) THEN
1062                         K = J
1063                      ELSE
1064                         K = N*( N+1 ) / 2 - ( N-I+1 )*( N-I+2 ) / 2 +
1065      $                      J - I + 1
1066                      END IF
1067 *
1068 *                    Convert K to (ISUB,JSUB) location
1069 *
1070                      JSUB = ( K-1 ) / LDA + 1
1071                      ISUB = K - LDA*( JSUB-1 )
1072 *
1073                      A( ISUB, JSUB ) = SLATM2( M, N, I, J, KL, KU,
1074      $                                 IDIST, ISEED, D, IGRADE, DL, DR,
1075      $                                 IPVTNG, IWORK, SPARSE )
1076   390             CONTINUE
1077   400          CONTINUE
1078             ELSE
1079                ISUB = 0
1080                JSUB = 1
1081                DO 420 J = 1, N
1082                   DO 410 I = J, M
1083                      ISUB = ISUB + 1
1084                      IF( ISUB.GT.LDA ) THEN
1085                         ISUB = 1
1086                         JSUB = JSUB + 1
1087                      END IF
1088                      A( ISUB, JSUB ) = SLATM2( M, N, I, J, KL, KU,
1089      $                                 IDIST, ISEED, D, IGRADE, DL, DR,
1090      $                                 IPVTNG, IWORK, SPARSE )
1091   410             CONTINUE
1092   420          CONTINUE
1093             END IF
1094 *
1095          ELSE IF( IPACK.EQ.5 ) THEN
1096 *
1097             DO 440 J = 1, N
1098                DO 430 I = J - KUU, J
1099                   IF( I.LT.1 ) THEN
1100                      A( J-I+1, I+N ) = ZERO
1101                   ELSE
1102                      A( J-I+1, I ) = SLATM2( M, N, I, J, KL, KU, IDIST,
1103      $                               ISEED, D, IGRADE, DL, DR, IPVTNG,
1104      $                               IWORK, SPARSE )
1105                   END IF
1106   430          CONTINUE
1107   440       CONTINUE
1108 *
1109          ELSE IF( IPACK.EQ.6 ) THEN
1110 *
1111             DO 460 J = 1, N
1112                DO 450 I = J - KUU, J
1113                   A( I-J+KUU+1, J ) = SLATM2( M, N, I, J, KL, KU, IDIST,
1114      $                                ISEED, D, IGRADE, DL, DR, IPVTNG,
1115      $                                IWORK, SPARSE )
1116   450          CONTINUE
1117   460       CONTINUE
1118 *
1119          ELSE IF( IPACK.EQ.7 ) THEN
1120 *
1121             IF( ISYM.EQ.0 ) THEN
1122                DO 480 J = 1, N
1123                   DO 470 I = J - KUU, J
1124                      A( I-J+KUU+1, J ) = SLATM2( M, N, I, J, KL, KU,
1125      $                                   IDIST, ISEED, D, IGRADE, DL,
1126      $                                   DR, IPVTNG, IWORK, SPARSE )
1127                      IF( I.LT.1 )
1128      $                  A( J-I+1+KUU, I+N ) = ZERO
1129                      IF( I.GE.1 .AND. I.NE.J )
1130      $                  A( J-I+1+KUU, I ) = A( I-J+KUU+1, J )
1131   470             CONTINUE
1132   480          CONTINUE
1133             ELSE IF( ISYM.EQ.1 ) THEN
1134                DO 500 J = 1, N
1135                   DO 490 I = J - KUU, J + KLL
1136                      A( I-J+KUU+1, J ) = SLATM2( M, N, I, J, KL, KU,
1137      $                                   IDIST, ISEED, D, IGRADE, DL,
1138      $                                   DR, IPVTNG, IWORK, SPARSE )
1139   490             CONTINUE
1140   500          CONTINUE
1141             END IF
1142 *
1143          END IF
1144 *
1145       END IF
1146 *
1147 *     5)      Scaling the norm
1148 *
1149       IF( IPACK.EQ.0 ) THEN
1150          ONORM = SLANGE( 'M', M, N, A, LDA, TEMPA )
1151       ELSE IF( IPACK.EQ.1 ) THEN
1152          ONORM = SLANSY( 'M', 'U', N, A, LDA, TEMPA )
1153       ELSE IF( IPACK.EQ.2 ) THEN
1154          ONORM = SLANSY( 'M', 'L', N, A, LDA, TEMPA )
1155       ELSE IF( IPACK.EQ.3 ) THEN
1156          ONORM = SLANSP( 'M', 'U', N, A, TEMPA )
1157       ELSE IF( IPACK.EQ.4 ) THEN
1158          ONORM = SLANSP( 'M', 'L', N, A, TEMPA )
1159       ELSE IF( IPACK.EQ.5 ) THEN
1160          ONORM = SLANSB( 'M', 'L', N, KLL, A, LDA, TEMPA )
1161       ELSE IF( IPACK.EQ.6 ) THEN
1162          ONORM = SLANSB( 'M', 'U', N, KUU, A, LDA, TEMPA )
1163       ELSE IF( IPACK.EQ.7 ) THEN
1164          ONORM = SLANGB( 'M', N, KLL, KUU, A, LDA, TEMPA )
1165       END IF
1166 *
1167       IF( ANORM.GE.ZERO ) THEN
1168 *
1169          IF( ANORM.GT.ZERO .AND. ONORM.EQ.ZERO ) THEN
1170 *
1171 *           Desired scaling impossible
1172 *
1173             INFO = 5
1174             RETURN
1175 *
1176          ELSE IF( ( ANORM.GT.ONE .AND. ONORM.LT.ONE ) .OR.
1177      $            ( ANORM.LT.ONE .AND. ONORM.GT.ONE ) ) THEN
1178 *
1179 *           Scale carefully to avoid over / underflow
1180 *
1181             IF( IPACK.LE.2 ) THEN
1182                DO 510 J = 1, N
1183                   CALL SSCAL( M, ONE / ONORM, A( 1, J ), 1 )
1184                   CALL SSCAL( M, ANORM, A( 1, J ), 1 )
1185   510          CONTINUE
1186 *
1187             ELSE IF( IPACK.EQ.3 .OR. IPACK.EQ.4 ) THEN
1188 *
1189                CALL SSCAL( N*( N+1 ) / 2, ONE / ONORM, A, 1 )
1190                CALL SSCAL( N*( N+1 ) / 2, ANORM, A, 1 )
1191 *
1192             ELSE IF( IPACK.GE.5 ) THEN
1193 *
1194                DO 520 J = 1, N
1195                   CALL SSCAL( KLL+KUU+1, ONE / ONORM, A( 1, J ), 1 )
1196                   CALL SSCAL( KLL+KUU+1, ANORM, A( 1, J ), 1 )
1197   520          CONTINUE
1198 *
1199             END IF
1200 *
1201          ELSE
1202 *
1203 *           Scale straightforwardly
1204 *
1205             IF( IPACK.LE.2 ) THEN
1206                DO 530 J = 1, N
1207                   CALL SSCAL( M, ANORM / ONORM, A( 1, J ), 1 )
1208   530          CONTINUE
1209 *
1210             ELSE IF( IPACK.EQ.3 .OR. IPACK.EQ.4 ) THEN
1211 *
1212                CALL SSCAL( N*( N+1 ) / 2, ANORM / ONORM, A, 1 )
1213 *
1214             ELSE IF( IPACK.GE.5 ) THEN
1215 *
1216                DO 540 J = 1, N
1217                   CALL SSCAL( KLL+KUU+1, ANORM / ONORM, A( 1, J ), 1 )
1218   540          CONTINUE
1219             END IF
1220 *
1221          END IF
1222 *
1223       END IF
1224 *
1225 *     End of SLATMR
1226 *
1227       END