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