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