LAPACK: TESTING/MATGEN/dlatmr.f Source File

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