LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
dlatmt.f
Go to the documentation of this file.
00001 *> \brief \b DLATMT
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 DLATMT( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX,
00012 *                          RANK, KL, KU, PACK, A, LDA, WORK, INFO )
00013 * 
00014 *       .. Scalar Arguments ..
00015 *       DOUBLE PRECISION   COND, DMAX
00016 *       INTEGER            INFO, KL, KU, LDA, M, MODE, N, RANK
00017 *       CHARACTER          DIST, PACK, SYM
00018 *       ..
00019 *       .. Array Arguments ..
00020 *       DOUBLE PRECISION   A( LDA, * ), D( * ), WORK( * )
00021 *       INTEGER            ISEED( 4 )
00022 *       ..
00023 *  
00024 *
00025 *> \par Purpose:
00026 *  =============
00027 *>
00028 *> \verbatim
00029 *>
00030 *>    DLATMT generates random matrices with specified singular values
00031 *>    (or symmetric/hermitian with specified eigenvalues)
00032 *>    for testing LAPACK programs.
00033 *>
00034 *>    DLATMT operates by applying the following sequence of
00035 *>    operations:
00036 *>
00037 *>      Set the diagonal to D, where D may be input or
00038 *>         computed according to MODE, COND, DMAX, and SYM
00039 *>         as described below.
00040 *>
00041 *>      Generate a matrix with the appropriate band structure, by one
00042 *>         of two methods:
00043 *>
00044 *>      Method A:
00045 *>          Generate a dense M x N matrix by multiplying D on the left
00046 *>              and the right by random unitary matrices, then:
00047 *>
00048 *>          Reduce the bandwidth according to KL and KU, using
00049 *>          Householder transformations.
00050 *>
00051 *>      Method B:
00052 *>          Convert the bandwidth-0 (i.e., diagonal) matrix to a
00053 *>              bandwidth-1 matrix using Givens rotations, "chasing"
00054 *>              out-of-band elements back, much as in QR; then
00055 *>              convert the bandwidth-1 to a bandwidth-2 matrix, etc.
00056 *>              Note that for reasonably small bandwidths (relative to
00057 *>              M and N) this requires less storage, as a dense matrix
00058 *>              is not generated.  Also, for symmetric matrices, only
00059 *>              one triangle is generated.
00060 *>
00061 *>      Method A is chosen if the bandwidth is a large fraction of the
00062 *>          order of the matrix, and LDA is at least M (so a dense
00063 *>          matrix can be stored.)  Method B is chosen if the bandwidth
00064 *>          is small (< 1/2 N for symmetric, < .3 N+M for
00065 *>          non-symmetric), or LDA is less than M and not less than the
00066 *>          bandwidth.
00067 *>
00068 *>      Pack the matrix if desired. Options specified by PACK are:
00069 *>         no packing
00070 *>         zero out upper half (if symmetric)
00071 *>         zero out lower half (if symmetric)
00072 *>         store the upper half columnwise (if symmetric or upper
00073 *>               triangular)
00074 *>         store the lower half columnwise (if symmetric or lower
00075 *>               triangular)
00076 *>         store the lower triangle in banded format (if symmetric
00077 *>               or lower triangular)
00078 *>         store the upper triangle in banded format (if symmetric
00079 *>               or upper triangular)
00080 *>         store the entire matrix in banded format
00081 *>      If Method B is chosen, and band format is specified, then the
00082 *>         matrix will be generated in the band format, so no repacking
00083 *>         will be necessary.
00084 *> \endverbatim
00085 *
00086 *  Arguments:
00087 *  ==========
00088 *
00089 *> \param[in] M
00090 *> \verbatim
00091 *>          M is INTEGER
00092 *>           The number of rows of A. Not modified.
00093 *> \endverbatim
00094 *>
00095 *> \param[in] N
00096 *> \verbatim
00097 *>          N is INTEGER
00098 *>           The number of columns of A. Not modified.
00099 *> \endverbatim
00100 *>
00101 *> \param[in] DIST
00102 *> \verbatim
00103 *>          DIST is CHARACTER*1
00104 *>           On entry, DIST specifies the type of distribution to be used
00105 *>           to generate the random eigen-/singular values.
00106 *>           'U' => UNIFORM( 0, 1 )  ( 'U' for uniform )
00107 *>           'S' => UNIFORM( -1, 1 ) ( 'S' for symmetric )
00108 *>           'N' => NORMAL( 0, 1 )   ( 'N' for normal )
00109 *>           Not modified.
00110 *> \endverbatim
00111 *>
00112 *> \param[in,out] ISEED
00113 *> \verbatim
00114 *>          ISEED is INTEGER array, dimension ( 4 )
00115 *>           On entry ISEED specifies the seed of the random number
00116 *>           generator. They should lie between 0 and 4095 inclusive,
00117 *>           and ISEED(4) should be odd. The random number generator
00118 *>           uses a linear congruential sequence limited to small
00119 *>           integers, and so should produce machine independent
00120 *>           random numbers. The values of ISEED are changed on
00121 *>           exit, and can be used in the next call to DLATMT
00122 *>           to continue the same random number sequence.
00123 *>           Changed on exit.
00124 *> \endverbatim
00125 *>
00126 *> \param[in] SYM
00127 *> \verbatim
00128 *>          SYM is CHARACTER*1
00129 *>           If SYM='S' or 'H', the generated matrix is symmetric, with
00130 *>             eigenvalues specified by D, COND, MODE, and DMAX; they
00131 *>             may be positive, negative, or zero.
00132 *>           If SYM='P', the generated matrix is symmetric, with
00133 *>             eigenvalues (= singular values) specified by D, COND,
00134 *>             MODE, and DMAX; they will not be negative.
00135 *>           If SYM='N', the generated matrix is nonsymmetric, with
00136 *>             singular values specified by D, COND, MODE, and DMAX;
00137 *>             they will not be negative.
00138 *>           Not modified.
00139 *> \endverbatim
00140 *>
00141 *> \param[in,out] D
00142 *> \verbatim
00143 *>          D is DOUBLE PRECISION array, dimension ( MIN( M , N ) )
00144 *>           This array is used to specify the singular values or
00145 *>           eigenvalues of A (see SYM, above.)  If MODE=0, then D is
00146 *>           assumed to contain the singular/eigenvalues, otherwise
00147 *>           they will be computed according to MODE, COND, and DMAX,
00148 *>           and placed in D.
00149 *>           Modified if MODE is nonzero.
00150 *> \endverbatim
00151 *>
00152 *> \param[in] MODE
00153 *> \verbatim
00154 *>          MODE is INTEGER
00155 *>           On entry this describes how the singular/eigenvalues are to
00156 *>           be specified:
00157 *>           MODE = 0 means use D as input
00158 *>
00159 *>           MODE = 1 sets D(1)=1 and D(2:RANK)=1.0/COND
00160 *>           MODE = 2 sets D(1:RANK-1)=1 and D(RANK)=1.0/COND
00161 *>           MODE = 3 sets D(I)=COND**(-(I-1)/(RANK-1))
00162 *>
00163 *>           MODE = 4 sets D(i)=1 - (i-1)/(N-1)*(1 - 1/COND)
00164 *>           MODE = 5 sets D to random numbers in the range
00165 *>                    ( 1/COND , 1 ) such that their logarithms
00166 *>                    are uniformly distributed.
00167 *>           MODE = 6 set D to random numbers from same distribution
00168 *>                    as the rest of the matrix.
00169 *>           MODE < 0 has the same meaning as ABS(MODE), except that
00170 *>              the order of the elements of D is reversed.
00171 *>           Thus if MODE is positive, D has entries ranging from
00172 *>              1 to 1/COND, if negative, from 1/COND to 1,
00173 *>           If SYM='S' or 'H', and MODE is neither 0, 6, nor -6, then
00174 *>              the elements of D will also be multiplied by a random
00175 *>              sign (i.e., +1 or -1.)
00176 *>           Not modified.
00177 *> \endverbatim
00178 *>
00179 *> \param[in] COND
00180 *> \verbatim
00181 *>          COND is DOUBLE PRECISION
00182 *>           On entry, this is used as described under MODE above.
00183 *>           If used, it must be >= 1. Not modified.
00184 *> \endverbatim
00185 *>
00186 *> \param[in] DMAX
00187 *> \verbatim
00188 *>          DMAX is DOUBLE PRECISION
00189 *>           If MODE is neither -6, 0 nor 6, the contents of D, as
00190 *>           computed according to MODE and COND, will be scaled by
00191 *>           DMAX / max(abs(D(i))); thus, the maximum absolute eigen- or
00192 *>           singular value (which is to say the norm) will be abs(DMAX).
00193 *>           Note that DMAX need not be positive: if DMAX is negative
00194 *>           (or zero), D will be scaled by a negative number (or zero).
00195 *>           Not modified.
00196 *> \endverbatim
00197 *>
00198 *> \param[in] RANK
00199 *> \verbatim
00200 *>          RANK is INTEGER
00201 *>           The rank of matrix to be generated for modes 1,2,3 only.
00202 *>           D( RANK+1:N ) = 0.
00203 *>           Not modified.
00204 *> \endverbatim
00205 *>
00206 *> \param[in] KL
00207 *> \verbatim
00208 *>          KL is INTEGER
00209 *>           This specifies the lower bandwidth of the  matrix. For
00210 *>           example, KL=0 implies upper triangular, KL=1 implies upper
00211 *>           Hessenberg, and KL being at least M-1 means that the matrix
00212 *>           has full lower bandwidth.  KL must equal KU if the matrix
00213 *>           is symmetric.
00214 *>           Not modified.
00215 *> \endverbatim
00216 *>
00217 *> \param[in] KU
00218 *> \verbatim
00219 *>          KU is INTEGER
00220 *>           This specifies the upper bandwidth of the  matrix. For
00221 *>           example, KU=0 implies lower triangular, KU=1 implies lower
00222 *>           Hessenberg, and KU being at least N-1 means that the matrix
00223 *>           has full upper bandwidth.  KL must equal KU if the matrix
00224 *>           is symmetric.
00225 *>           Not modified.
00226 *> \endverbatim
00227 *>
00228 *> \param[in] PACK
00229 *> \verbatim
00230 *>          PACK is CHARACTER*1
00231 *>           This specifies packing of matrix as follows:
00232 *>           'N' => no packing
00233 *>           'U' => zero out all subdiagonal entries (if symmetric)
00234 *>           'L' => zero out all superdiagonal entries (if symmetric)
00235 *>           'C' => store the upper triangle columnwise
00236 *>                  (only if the matrix is symmetric or upper triangular)
00237 *>           'R' => store the lower triangle columnwise
00238 *>                  (only if the matrix is symmetric or lower triangular)
00239 *>           'B' => store the lower triangle in band storage scheme
00240 *>                  (only if matrix symmetric or lower triangular)
00241 *>           'Q' => store the upper triangle in band storage scheme
00242 *>                  (only if matrix symmetric or upper triangular)
00243 *>           'Z' => store the entire matrix in band storage scheme
00244 *>                      (pivoting can be provided for by using this
00245 *>                      option to store A in the trailing rows of
00246 *>                      the allocated storage)
00247 *>
00248 *>           Using these options, the various LAPACK packed and banded
00249 *>           storage schemes can be obtained:
00250 *>           GB               - use 'Z'
00251 *>           PB, SB or TB     - use 'B' or 'Q'
00252 *>           PP, SP or TP     - use 'C' or 'R'
00253 *>
00254 *>           If two calls to DLATMT differ only in the PACK parameter,
00255 *>           they will generate mathematically equivalent matrices.
00256 *>           Not modified.
00257 *> \endverbatim
00258 *>
00259 *> \param[in,out] A
00260 *> \verbatim
00261 *>          A is DOUBLE PRECISION array, dimension ( LDA, N )
00262 *>           On exit A is the desired test matrix.  A is first generated
00263 *>           in full (unpacked) form, and then packed, if so specified
00264 *>           by PACK.  Thus, the first M elements of the first N
00265 *>           columns will always be modified.  If PACK specifies a
00266 *>           packed or banded storage scheme, all LDA elements of the
00267 *>           first N columns will be modified; the elements of the
00268 *>           array which do not correspond to elements of the generated
00269 *>           matrix are set to zero.
00270 *>           Modified.
00271 *> \endverbatim
00272 *>
00273 *> \param[in] LDA
00274 *> \verbatim
00275 *>          LDA is INTEGER
00276 *>           LDA specifies the first dimension of A as declared in the
00277 *>           calling program.  If PACK='N', 'U', 'L', 'C', or 'R', then
00278 *>           LDA must be at least M.  If PACK='B' or 'Q', then LDA must
00279 *>           be at least MIN( KL, M-1) (which is equal to MIN(KU,N-1)).
00280 *>           If PACK='Z', LDA must be large enough to hold the packed
00281 *>           array: MIN( KU, N-1) + MIN( KL, M-1) + 1.
00282 *>           Not modified.
00283 *> \endverbatim
00284 *>
00285 *> \param[out] WORK
00286 *> \verbatim
00287 *>          WORK is DOUBLE PRECISION array, dimension ( 3*MAX( N , M ) )
00288 *>           Workspace.
00289 *>           Modified.
00290 *> \endverbatim
00291 *>
00292 *> \param[out] INFO
00293 *> \verbatim
00294 *>          INFO is INTEGER
00295 *>           Error code.  On exit, INFO will be set to one of the
00296 *>           following values:
00297 *>             0 => normal return
00298 *>            -1 => M negative or unequal to N and SYM='S', 'H', or 'P'
00299 *>            -2 => N negative
00300 *>            -3 => DIST illegal string
00301 *>            -5 => SYM illegal string
00302 *>            -7 => MODE not in range -6 to 6
00303 *>            -8 => COND less than 1.0, and MODE neither -6, 0 nor 6
00304 *>           -10 => KL negative
00305 *>           -11 => KU negative, or SYM='S' or 'H' and KU not equal to KL
00306 *>           -12 => PACK illegal string, or PACK='U' or 'L', and SYM='N';
00307 *>                  or PACK='C' or 'Q' and SYM='N' and KL is not zero;
00308 *>                  or PACK='R' or 'B' and SYM='N' and KU is not zero;
00309 *>                  or PACK='U', 'L', 'C', 'R', 'B', or 'Q', and M is not
00310 *>                  N.
00311 *>           -14 => LDA is less than M, or PACK='Z' and LDA is less than
00312 *>                  MIN(KU,N-1) + MIN(KL,M-1) + 1.
00313 *>            1  => Error return from DLATM7
00314 *>            2  => Cannot scale to DMAX (max. sing. value is 0)
00315 *>            3  => Error return from DLAGGE or DLAGSY
00316 *> \endverbatim
00317 *
00318 *  Authors:
00319 *  ========
00320 *
00321 *> \author Univ. of Tennessee 
00322 *> \author Univ. of California Berkeley 
00323 *> \author Univ. of Colorado Denver 
00324 *> \author NAG Ltd. 
00325 *
00326 *> \date November 2011
00327 *
00328 *> \ingroup double_matgen
00329 *
00330 *  =====================================================================
00331       SUBROUTINE DLATMT( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX,
00332      $                   RANK, KL, KU, PACK, A, LDA, WORK, INFO )
00333 *
00334 *  -- LAPACK computational routine (version 3.4.0) --
00335 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00336 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00337 *     November 2011
00338 *
00339 *     .. Scalar Arguments ..
00340       DOUBLE PRECISION   COND, DMAX
00341       INTEGER            INFO, KL, KU, LDA, M, MODE, N, RANK
00342       CHARACTER          DIST, PACK, SYM
00343 *     ..
00344 *     .. Array Arguments ..
00345       DOUBLE PRECISION   A( LDA, * ), D( * ), WORK( * )
00346       INTEGER            ISEED( 4 )
00347 *     ..
00348 *
00349 *  =====================================================================
00350 *
00351 *     .. Parameters ..
00352       DOUBLE PRECISION   ZERO
00353       PARAMETER          ( ZERO = 0.0D0 )
00354       DOUBLE PRECISION   ONE
00355       PARAMETER          ( ONE = 1.0D0 )
00356       DOUBLE PRECISION   TWOPI
00357       PARAMETER          ( TWOPI = 6.2831853071795864769252867663D+0 )
00358 *     ..
00359 *     .. Local Scalars ..
00360       DOUBLE PRECISION   ALPHA, ANGLE, C, DUMMY, EXTRA, S, TEMP
00361       INTEGER            I, IC, ICOL, IDIST, IENDCH, IINFO, IL, ILDA,
00362      $                   IOFFG, IOFFST, IPACK, IPACKG, IR, IR1, IR2,
00363      $                   IROW, IRSIGN, ISKEW, ISYM, ISYMPK, J, JC, JCH,
00364      $                   JKL, JKU, JR, K, LLB, MINLDA, MNMIN, MR, NC,
00365      $                   UUB
00366       LOGICAL            GIVENS, ILEXTR, ILTEMP, TOPDWN
00367 *     ..
00368 *     .. External Functions ..
00369       DOUBLE PRECISION   DLARND
00370       LOGICAL            LSAME
00371       EXTERNAL           DLARND, LSAME
00372 *     ..
00373 *     .. External Subroutines ..
00374       EXTERNAL           DLATM7, DCOPY, DLAGGE, DLAGSY, DLAROT,
00375      $                   DLARTG, DLASET, DSCAL, XERBLA
00376 *     ..
00377 *     .. Intrinsic Functions ..
00378       INTRINSIC          ABS, COS, DBLE, MAX, MIN, MOD, SIN
00379 *     ..
00380 *     .. Executable Statements ..
00381 *
00382 *     1)      Decode and Test the input parameters.
00383 *             Initialize flags & seed.
00384 *
00385       INFO = 0
00386 *
00387 *     Quick return if possible
00388 *
00389       IF( M.EQ.0 .OR. N.EQ.0 )
00390      $   RETURN
00391 *
00392 *     Decode DIST
00393 *
00394       IF( LSAME( DIST, 'U' ) ) THEN
00395          IDIST = 1
00396       ELSE IF( LSAME( DIST, 'S' ) ) THEN
00397          IDIST = 2
00398       ELSE IF( LSAME( DIST, 'N' ) ) THEN
00399          IDIST = 3
00400       ELSE
00401          IDIST = -1
00402       END IF
00403 *
00404 *     Decode SYM
00405 *
00406       IF( LSAME( SYM, 'N' ) ) THEN
00407          ISYM = 1
00408          IRSIGN = 0
00409       ELSE IF( LSAME( SYM, 'P' ) ) THEN
00410          ISYM = 2
00411          IRSIGN = 0
00412       ELSE IF( LSAME( SYM, 'S' ) ) THEN
00413          ISYM = 2
00414          IRSIGN = 1
00415       ELSE IF( LSAME( SYM, 'H' ) ) THEN
00416          ISYM = 2
00417          IRSIGN = 1
00418       ELSE
00419          ISYM = -1
00420       END IF
00421 *
00422 *     Decode PACK
00423 *
00424       ISYMPK = 0
00425       IF( LSAME( PACK, 'N' ) ) THEN
00426          IPACK = 0
00427       ELSE IF( LSAME( PACK, 'U' ) ) THEN
00428          IPACK = 1
00429          ISYMPK = 1
00430       ELSE IF( LSAME( PACK, 'L' ) ) THEN
00431          IPACK = 2
00432          ISYMPK = 1
00433       ELSE IF( LSAME( PACK, 'C' ) ) THEN
00434          IPACK = 3
00435          ISYMPK = 2
00436       ELSE IF( LSAME( PACK, 'R' ) ) THEN
00437          IPACK = 4
00438          ISYMPK = 3
00439       ELSE IF( LSAME( PACK, 'B' ) ) THEN
00440          IPACK = 5
00441          ISYMPK = 3
00442       ELSE IF( LSAME( PACK, 'Q' ) ) THEN
00443          IPACK = 6
00444          ISYMPK = 2
00445       ELSE IF( LSAME( PACK, 'Z' ) ) THEN
00446          IPACK = 7
00447       ELSE
00448          IPACK = -1
00449       END IF
00450 *
00451 *     Set certain internal parameters
00452 *
00453       MNMIN = MIN( M, N )
00454       LLB = MIN( KL, M-1 )
00455       UUB = MIN( KU, N-1 )
00456       MR = MIN( M, N+LLB )
00457       NC = MIN( N, M+UUB )
00458 *
00459       IF( IPACK.EQ.5 .OR. IPACK.EQ.6 ) THEN
00460          MINLDA = UUB + 1
00461       ELSE IF( IPACK.EQ.7 ) THEN
00462          MINLDA = LLB + UUB + 1
00463       ELSE
00464          MINLDA = M
00465       END IF
00466 *
00467 *     Use Givens rotation method if bandwidth small enough,
00468 *     or if LDA is too small to store the matrix unpacked.
00469 *
00470       GIVENS = .FALSE.
00471       IF( ISYM.EQ.1 ) THEN
00472          IF( DBLE( LLB+UUB ).LT.0.3D0*DBLE( MAX( 1, MR+NC ) ) )
00473      $      GIVENS = .TRUE.
00474       ELSE
00475          IF( 2*LLB.LT.M )
00476      $      GIVENS = .TRUE.
00477       END IF
00478       IF( LDA.LT.M .AND. LDA.GE.MINLDA )
00479      $   GIVENS = .TRUE.
00480 *
00481 *     Set INFO if an error
00482 *
00483       IF( M.LT.0 ) THEN
00484          INFO = -1
00485       ELSE IF( M.NE.N .AND. ISYM.NE.1 ) THEN
00486          INFO = -1
00487       ELSE IF( N.LT.0 ) THEN
00488          INFO = -2
00489       ELSE IF( IDIST.EQ.-1 ) THEN
00490          INFO = -3
00491       ELSE IF( ISYM.EQ.-1 ) THEN
00492          INFO = -5
00493       ELSE IF( ABS( MODE ).GT.6 ) THEN
00494          INFO = -7
00495       ELSE IF( ( MODE.NE.0 .AND. ABS( MODE ).NE.6 ) .AND. COND.LT.ONE )
00496      $         THEN
00497          INFO = -8
00498       ELSE IF( KL.LT.0 ) THEN
00499          INFO = -10
00500       ELSE IF( KU.LT.0 .OR. ( ISYM.NE.1 .AND. KL.NE.KU ) ) THEN
00501          INFO = -11
00502       ELSE IF( IPACK.EQ.-1 .OR. ( ISYMPK.EQ.1 .AND. ISYM.EQ.1 ) .OR.
00503      $         ( ISYMPK.EQ.2 .AND. ISYM.EQ.1 .AND. KL.GT.0 ) .OR.
00504      $         ( ISYMPK.EQ.3 .AND. ISYM.EQ.1 .AND. KU.GT.0 ) .OR.
00505      $         ( ISYMPK.NE.0 .AND. M.NE.N ) ) THEN
00506          INFO = -12
00507       ELSE IF( LDA.LT.MAX( 1, MINLDA ) ) THEN
00508          INFO = -14
00509       END IF
00510 *
00511       IF( INFO.NE.0 ) THEN
00512          CALL XERBLA( 'DLATMT', -INFO )
00513          RETURN
00514       END IF
00515 *
00516 *     Initialize random number generator
00517 *
00518       DO 100 I = 1, 4
00519          ISEED( I ) = MOD( ABS( ISEED( I ) ), 4096 )
00520   100 CONTINUE
00521 *
00522       IF( MOD( ISEED( 4 ), 2 ).NE.1 )
00523      $   ISEED( 4 ) = ISEED( 4 ) + 1
00524 *
00525 *     2)      Set up D  if indicated.
00526 *
00527 *             Compute D according to COND and MODE
00528 *
00529       CALL DLATM7( MODE, COND, IRSIGN, IDIST, ISEED, D, MNMIN, RANK,
00530      $             IINFO )
00531       IF( IINFO.NE.0 ) THEN
00532          INFO = 1
00533          RETURN
00534       END IF
00535 *
00536 *     Choose Top-Down if D is (apparently) increasing,
00537 *     Bottom-Up if D is (apparently) decreasing.
00538 *
00539       IF( ABS( D( 1 ) ).LE.ABS( D( RANK ) ) ) THEN
00540          TOPDWN = .TRUE.
00541       ELSE
00542          TOPDWN = .FALSE.
00543       END IF
00544 *
00545       IF( MODE.NE.0 .AND. ABS( MODE ).NE.6 ) THEN
00546 *
00547 *        Scale by DMAX
00548 *
00549          TEMP = ABS( D( 1 ) )
00550          DO 110 I = 2, RANK
00551             TEMP = MAX( TEMP, ABS( D( I ) ) )
00552   110    CONTINUE
00553 *
00554          IF( TEMP.GT.ZERO ) THEN
00555             ALPHA = DMAX / TEMP
00556          ELSE
00557             INFO = 2
00558             RETURN
00559          END IF
00560 *
00561          CALL DSCAL( RANK, ALPHA, D, 1 )
00562 *
00563       END IF
00564 *
00565 *     3)      Generate Banded Matrix using Givens rotations.
00566 *             Also the special case of UUB=LLB=0
00567 *
00568 *               Compute Addressing constants to cover all
00569 *               storage formats.  Whether GE, SY, GB, or SB,
00570 *               upper or lower triangle or both,
00571 *               the (i,j)-th element is in
00572 *               A( i - ISKEW*j + IOFFST, j )
00573 *
00574       IF( IPACK.GT.4 ) THEN
00575          ILDA = LDA - 1
00576          ISKEW = 1
00577          IF( IPACK.GT.5 ) THEN
00578             IOFFST = UUB + 1
00579          ELSE
00580             IOFFST = 1
00581          END IF
00582       ELSE
00583          ILDA = LDA
00584          ISKEW = 0
00585          IOFFST = 0
00586       END IF
00587 *
00588 *     IPACKG is the format that the matrix is generated in. If this is
00589 *     different from IPACK, then the matrix must be repacked at the
00590 *     end.  It also signals how to compute the norm, for scaling.
00591 *
00592       IPACKG = 0
00593       CALL DLASET( 'Full', LDA, N, ZERO, ZERO, A, LDA )
00594 *
00595 *     Diagonal Matrix -- We are done, unless it
00596 *     is to be stored SP/PP/TP (PACK='R' or 'C')
00597 *
00598       IF( LLB.EQ.0 .AND. UUB.EQ.0 ) THEN
00599          CALL DCOPY( MNMIN, D, 1, A( 1-ISKEW+IOFFST, 1 ), ILDA+1 )
00600          IF( IPACK.LE.2 .OR. IPACK.GE.5 )
00601      $      IPACKG = IPACK
00602 *
00603       ELSE IF( GIVENS ) THEN
00604 *
00605 *        Check whether to use Givens rotations,
00606 *        Householder transformations, or nothing.
00607 *
00608          IF( ISYM.EQ.1 ) THEN
00609 *
00610 *           Non-symmetric -- A = U D V
00611 *
00612             IF( IPACK.GT.4 ) THEN
00613                IPACKG = IPACK
00614             ELSE
00615                IPACKG = 0
00616             END IF
00617 *
00618             CALL DCOPY( MNMIN, D, 1, A( 1-ISKEW+IOFFST, 1 ), ILDA+1 )
00619 *
00620             IF( TOPDWN ) THEN
00621                JKL = 0
00622                DO 140 JKU = 1, UUB
00623 *
00624 *                 Transform from bandwidth JKL, JKU-1 to JKL, JKU
00625 *
00626 *                 Last row actually rotated is M
00627 *                 Last column actually rotated is MIN( M+JKU, N )
00628 *
00629                   DO 130 JR = 1, MIN( M+JKU, N ) + JKL - 1
00630                      EXTRA = ZERO
00631                      ANGLE = TWOPI*DLARND( 1, ISEED )
00632                      C = COS( ANGLE )
00633                      S = SIN( ANGLE )
00634                      ICOL = MAX( 1, JR-JKL )
00635                      IF( JR.LT.M ) THEN
00636                         IL = MIN( N, JR+JKU ) + 1 - ICOL
00637                         CALL DLAROT( .TRUE., JR.GT.JKL, .FALSE., IL, C,
00638      $                               S, A( JR-ISKEW*ICOL+IOFFST, ICOL ),
00639      $                               ILDA, EXTRA, DUMMY )
00640                      END IF
00641 *
00642 *                    Chase "EXTRA" back up
00643 *
00644                      IR = JR
00645                      IC = ICOL
00646                      DO 120 JCH = JR - JKL, 1, -JKL - JKU
00647                         IF( IR.LT.M ) THEN
00648                            CALL DLARTG( A( IR+1-ISKEW*( IC+1 )+IOFFST,
00649      $                                  IC+1 ), EXTRA, C, S, DUMMY )
00650                         END IF
00651                         IROW = MAX( 1, JCH-JKU )
00652                         IL = IR + 2 - IROW
00653                         TEMP = ZERO
00654                         ILTEMP = JCH.GT.JKU
00655                         CALL DLAROT( .FALSE., ILTEMP, .TRUE., IL, C, -S,
00656      $                               A( IROW-ISKEW*IC+IOFFST, IC ),
00657      $                               ILDA, TEMP, EXTRA )
00658                         IF( ILTEMP ) THEN
00659                            CALL DLARTG( A( IROW+1-ISKEW*( IC+1 )+IOFFST,
00660      $                                  IC+1 ), TEMP, C, S, DUMMY )
00661                            ICOL = MAX( 1, JCH-JKU-JKL )
00662                            IL = IC + 2 - ICOL
00663                            EXTRA = ZERO
00664                            CALL DLAROT( .TRUE., JCH.GT.JKU+JKL, .TRUE.,
00665      $                                  IL, C, -S, A( IROW-ISKEW*ICOL+
00666      $                                  IOFFST, ICOL ), ILDA, EXTRA,
00667      $                                  TEMP )
00668                            IC = ICOL
00669                            IR = IROW
00670                         END IF
00671   120                CONTINUE
00672   130             CONTINUE
00673   140          CONTINUE
00674 *
00675                JKU = UUB
00676                DO 170 JKL = 1, LLB
00677 *
00678 *                 Transform from bandwidth JKL-1, JKU to JKL, JKU
00679 *
00680                   DO 160 JC = 1, MIN( N+JKL, M ) + JKU - 1
00681                      EXTRA = ZERO
00682                      ANGLE = TWOPI*DLARND( 1, ISEED )
00683                      C = COS( ANGLE )
00684                      S = SIN( ANGLE )
00685                      IROW = MAX( 1, JC-JKU )
00686                      IF( JC.LT.N ) THEN
00687                         IL = MIN( M, JC+JKL ) + 1 - IROW
00688                         CALL DLAROT( .FALSE., JC.GT.JKU, .FALSE., IL, C,
00689      $                               S, A( IROW-ISKEW*JC+IOFFST, JC ),
00690      $                               ILDA, EXTRA, DUMMY )
00691                      END IF
00692 *
00693 *                    Chase "EXTRA" back up
00694 *
00695                      IC = JC
00696                      IR = IROW
00697                      DO 150 JCH = JC - JKU, 1, -JKL - JKU
00698                         IF( IC.LT.N ) THEN
00699                            CALL DLARTG( A( IR+1-ISKEW*( IC+1 )+IOFFST,
00700      $                                  IC+1 ), EXTRA, C, S, DUMMY )
00701                         END IF
00702                         ICOL = MAX( 1, JCH-JKL )
00703                         IL = IC + 2 - ICOL
00704                         TEMP = ZERO
00705                         ILTEMP = JCH.GT.JKL
00706                         CALL DLAROT( .TRUE., ILTEMP, .TRUE., IL, C, -S,
00707      $                               A( IR-ISKEW*ICOL+IOFFST, ICOL ),
00708      $                               ILDA, TEMP, EXTRA )
00709                         IF( ILTEMP ) THEN
00710                            CALL DLARTG( A( IR+1-ISKEW*( ICOL+1 )+IOFFST,
00711      $                                  ICOL+1 ), TEMP, C, S, DUMMY )
00712                            IROW = MAX( 1, JCH-JKL-JKU )
00713                            IL = IR + 2 - IROW
00714                            EXTRA = ZERO
00715                            CALL DLAROT( .FALSE., JCH.GT.JKL+JKU, .TRUE.,
00716      $                                  IL, C, -S, A( IROW-ISKEW*ICOL+
00717      $                                  IOFFST, ICOL ), ILDA, EXTRA,
00718      $                                  TEMP )
00719                            IC = ICOL
00720                            IR = IROW
00721                         END IF
00722   150                CONTINUE
00723   160             CONTINUE
00724   170          CONTINUE
00725 *
00726             ELSE
00727 *
00728 *              Bottom-Up -- Start at the bottom right.
00729 *
00730                JKL = 0
00731                DO 200 JKU = 1, UUB
00732 *
00733 *                 Transform from bandwidth JKL, JKU-1 to JKL, JKU
00734 *
00735 *                 First row actually rotated is M
00736 *                 First column actually rotated is MIN( M+JKU, N )
00737 *
00738                   IENDCH = MIN( M, N+JKL ) - 1
00739                   DO 190 JC = MIN( M+JKU, N ) - 1, 1 - JKL, -1
00740                      EXTRA = ZERO
00741                      ANGLE = TWOPI*DLARND( 1, ISEED )
00742                      C = COS( ANGLE )
00743                      S = SIN( ANGLE )
00744                      IROW = MAX( 1, JC-JKU+1 )
00745                      IF( JC.GT.0 ) THEN
00746                         IL = MIN( M, JC+JKL+1 ) + 1 - IROW
00747                         CALL DLAROT( .FALSE., .FALSE., JC+JKL.LT.M, IL,
00748      $                               C, S, A( IROW-ISKEW*JC+IOFFST,
00749      $                               JC ), ILDA, DUMMY, EXTRA )
00750                      END IF
00751 *
00752 *                    Chase "EXTRA" back down
00753 *
00754                      IC = JC
00755                      DO 180 JCH = JC + JKL, IENDCH, JKL + JKU
00756                         ILEXTR = IC.GT.0
00757                         IF( ILEXTR ) THEN
00758                            CALL DLARTG( A( JCH-ISKEW*IC+IOFFST, IC ),
00759      $                                  EXTRA, C, S, DUMMY )
00760                         END IF
00761                         IC = MAX( 1, IC )
00762                         ICOL = MIN( N-1, JCH+JKU )
00763                         ILTEMP = JCH + JKU.LT.N
00764                         TEMP = ZERO
00765                         CALL DLAROT( .TRUE., ILEXTR, ILTEMP, ICOL+2-IC,
00766      $                               C, S, A( JCH-ISKEW*IC+IOFFST, IC ),
00767      $                               ILDA, EXTRA, TEMP )
00768                         IF( ILTEMP ) THEN
00769                            CALL DLARTG( A( JCH-ISKEW*ICOL+IOFFST,
00770      $                                  ICOL ), TEMP, C, S, DUMMY )
00771                            IL = MIN( IENDCH, JCH+JKL+JKU ) + 2 - JCH
00772                            EXTRA = ZERO
00773                            CALL DLAROT( .FALSE., .TRUE.,
00774      $                                  JCH+JKL+JKU.LE.IENDCH, IL, C, S,
00775      $                                  A( JCH-ISKEW*ICOL+IOFFST,
00776      $                                  ICOL ), ILDA, TEMP, EXTRA )
00777                            IC = ICOL
00778                         END IF
00779   180                CONTINUE
00780   190             CONTINUE
00781   200          CONTINUE
00782 *
00783                JKU = UUB
00784                DO 230 JKL = 1, LLB
00785 *
00786 *                 Transform from bandwidth JKL-1, JKU to JKL, JKU
00787 *
00788 *                 First row actually rotated is MIN( N+JKL, M )
00789 *                 First column actually rotated is N
00790 *
00791                   IENDCH = MIN( N, M+JKU ) - 1
00792                   DO 220 JR = MIN( N+JKL, M ) - 1, 1 - JKU, -1
00793                      EXTRA = ZERO
00794                      ANGLE = TWOPI*DLARND( 1, ISEED )
00795                      C = COS( ANGLE )
00796                      S = SIN( ANGLE )
00797                      ICOL = MAX( 1, JR-JKL+1 )
00798                      IF( JR.GT.0 ) THEN
00799                         IL = MIN( N, JR+JKU+1 ) + 1 - ICOL
00800                         CALL DLAROT( .TRUE., .FALSE., JR+JKU.LT.N, IL,
00801      $                               C, S, A( JR-ISKEW*ICOL+IOFFST,
00802      $                               ICOL ), ILDA, DUMMY, EXTRA )
00803                      END IF
00804 *
00805 *                    Chase "EXTRA" back down
00806 *
00807                      IR = JR
00808                      DO 210 JCH = JR + JKU, IENDCH, JKL + JKU
00809                         ILEXTR = IR.GT.0
00810                         IF( ILEXTR ) THEN
00811                            CALL DLARTG( A( IR-ISKEW*JCH+IOFFST, JCH ),
00812      $                                  EXTRA, C, S, DUMMY )
00813                         END IF
00814                         IR = MAX( 1, IR )
00815                         IROW = MIN( M-1, JCH+JKL )
00816                         ILTEMP = JCH + JKL.LT.M
00817                         TEMP = ZERO
00818                         CALL DLAROT( .FALSE., ILEXTR, ILTEMP, IROW+2-IR,
00819      $                               C, S, A( IR-ISKEW*JCH+IOFFST,
00820      $                               JCH ), ILDA, EXTRA, TEMP )
00821                         IF( ILTEMP ) THEN
00822                            CALL DLARTG( A( IROW-ISKEW*JCH+IOFFST, JCH ),
00823      $                                  TEMP, C, S, DUMMY )
00824                            IL = MIN( IENDCH, JCH+JKL+JKU ) + 2 - JCH
00825                            EXTRA = ZERO
00826                            CALL DLAROT( .TRUE., .TRUE.,
00827      $                                  JCH+JKL+JKU.LE.IENDCH, IL, C, S,
00828      $                                  A( IROW-ISKEW*JCH+IOFFST, JCH ),
00829      $                                  ILDA, TEMP, EXTRA )
00830                            IR = IROW
00831                         END IF
00832   210                CONTINUE
00833   220             CONTINUE
00834   230          CONTINUE
00835             END IF
00836 *
00837          ELSE
00838 *
00839 *           Symmetric -- A = U D U'
00840 *
00841             IPACKG = IPACK
00842             IOFFG = IOFFST
00843 *
00844             IF( TOPDWN ) THEN
00845 *
00846 *              Top-Down -- Generate Upper triangle only
00847 *
00848                IF( IPACK.GE.5 ) THEN
00849                   IPACKG = 6
00850                   IOFFG = UUB + 1
00851                ELSE
00852                   IPACKG = 1
00853                END IF
00854                CALL DCOPY( MNMIN, D, 1, A( 1-ISKEW+IOFFG, 1 ), ILDA+1 )
00855 *
00856                DO 260 K = 1, UUB
00857                   DO 250 JC = 1, N - 1
00858                      IROW = MAX( 1, JC-K )
00859                      IL = MIN( JC+1, K+2 )
00860                      EXTRA = ZERO
00861                      TEMP = A( JC-ISKEW*( JC+1 )+IOFFG, JC+1 )
00862                      ANGLE = TWOPI*DLARND( 1, ISEED )
00863                      C = COS( ANGLE )
00864                      S = SIN( ANGLE )
00865                      CALL DLAROT( .FALSE., JC.GT.K, .TRUE., IL, C, S,
00866      $                            A( IROW-ISKEW*JC+IOFFG, JC ), ILDA,
00867      $                            EXTRA, TEMP )
00868                      CALL DLAROT( .TRUE., .TRUE., .FALSE.,
00869      $                            MIN( K, N-JC )+1, C, S,
00870      $                            A( ( 1-ISKEW )*JC+IOFFG, JC ), ILDA,
00871      $                            TEMP, DUMMY )
00872 *
00873 *                    Chase EXTRA back up the matrix
00874 *
00875                      ICOL = JC
00876                      DO 240 JCH = JC - K, 1, -K
00877                         CALL DLARTG( A( JCH+1-ISKEW*( ICOL+1 )+IOFFG,
00878      $                               ICOL+1 ), EXTRA, C, S, DUMMY )
00879                         TEMP = A( JCH-ISKEW*( JCH+1 )+IOFFG, JCH+1 )
00880                         CALL DLAROT( .TRUE., .TRUE., .TRUE., K+2, C, -S,
00881      $                               A( ( 1-ISKEW )*JCH+IOFFG, JCH ),
00882      $                               ILDA, TEMP, EXTRA )
00883                         IROW = MAX( 1, JCH-K )
00884                         IL = MIN( JCH+1, K+2 )
00885                         EXTRA = ZERO
00886                         CALL DLAROT( .FALSE., JCH.GT.K, .TRUE., IL, C,
00887      $                               -S, A( IROW-ISKEW*JCH+IOFFG, JCH ),
00888      $                               ILDA, EXTRA, TEMP )
00889                         ICOL = JCH
00890   240                CONTINUE
00891   250             CONTINUE
00892   260          CONTINUE
00893 *
00894 *              If we need lower triangle, copy from upper. Note that
00895 *              the order of copying is chosen to work for 'q' -> 'b'
00896 *
00897                IF( IPACK.NE.IPACKG .AND. IPACK.NE.3 ) THEN
00898                   DO 280 JC = 1, N
00899                      IROW = IOFFST - ISKEW*JC
00900                      DO 270 JR = JC, MIN( N, JC+UUB )
00901                         A( JR+IROW, JC ) = A( JC-ISKEW*JR+IOFFG, JR )
00902   270                CONTINUE
00903   280             CONTINUE
00904                   IF( IPACK.EQ.5 ) THEN
00905                      DO 300 JC = N - UUB + 1, N
00906                         DO 290 JR = N + 2 - JC, UUB + 1
00907                            A( JR, JC ) = ZERO
00908   290                   CONTINUE
00909   300                CONTINUE
00910                   END IF
00911                   IF( IPACKG.EQ.6 ) THEN
00912                      IPACKG = IPACK
00913                   ELSE
00914                      IPACKG = 0
00915                   END IF
00916                END IF
00917             ELSE
00918 *
00919 *              Bottom-Up -- Generate Lower triangle only
00920 *
00921                IF( IPACK.GE.5 ) THEN
00922                   IPACKG = 5
00923                   IF( IPACK.EQ.6 )
00924      $               IOFFG = 1
00925                ELSE
00926                   IPACKG = 2
00927                END IF
00928                CALL DCOPY( MNMIN, D, 1, A( 1-ISKEW+IOFFG, 1 ), ILDA+1 )
00929 *
00930                DO 330 K = 1, UUB
00931                   DO 320 JC = N - 1, 1, -1
00932                      IL = MIN( N+1-JC, K+2 )
00933                      EXTRA = ZERO
00934                      TEMP = A( 1+( 1-ISKEW )*JC+IOFFG, JC )
00935                      ANGLE = TWOPI*DLARND( 1, ISEED )
00936                      C = COS( ANGLE )
00937                      S = -SIN( ANGLE )
00938                      CALL DLAROT( .FALSE., .TRUE., N-JC.GT.K, IL, C, S,
00939      $                            A( ( 1-ISKEW )*JC+IOFFG, JC ), ILDA,
00940      $                            TEMP, EXTRA )
00941                      ICOL = MAX( 1, JC-K+1 )
00942                      CALL DLAROT( .TRUE., .FALSE., .TRUE., JC+2-ICOL, C,
00943      $                            S, A( JC-ISKEW*ICOL+IOFFG, ICOL ),
00944      $                            ILDA, DUMMY, TEMP )
00945 *
00946 *                    Chase EXTRA back down the matrix
00947 *
00948                      ICOL = JC
00949                      DO 310 JCH = JC + K, N - 1, K
00950                         CALL DLARTG( A( JCH-ISKEW*ICOL+IOFFG, ICOL ),
00951      $                               EXTRA, C, S, DUMMY )
00952                         TEMP = A( 1+( 1-ISKEW )*JCH+IOFFG, JCH )
00953                         CALL DLAROT( .TRUE., .TRUE., .TRUE., K+2, C, S,
00954      $                               A( JCH-ISKEW*ICOL+IOFFG, ICOL ),
00955      $                               ILDA, EXTRA, TEMP )
00956                         IL = MIN( N+1-JCH, K+2 )
00957                         EXTRA = ZERO
00958                         CALL DLAROT( .FALSE., .TRUE., N-JCH.GT.K, IL, C,
00959      $                               S, A( ( 1-ISKEW )*JCH+IOFFG, JCH ),
00960      $                               ILDA, TEMP, EXTRA )
00961                         ICOL = JCH
00962   310                CONTINUE
00963   320             CONTINUE
00964   330          CONTINUE
00965 *
00966 *              If we need upper triangle, copy from lower. Note that
00967 *              the order of copying is chosen to work for 'b' -> 'q'
00968 *
00969                IF( IPACK.NE.IPACKG .AND. IPACK.NE.4 ) THEN
00970                   DO 350 JC = N, 1, -1
00971                      IROW = IOFFST - ISKEW*JC
00972                      DO 340 JR = JC, MAX( 1, JC-UUB ), -1
00973                         A( JR+IROW, JC ) = A( JC-ISKEW*JR+IOFFG, JR )
00974   340                CONTINUE
00975   350             CONTINUE
00976                   IF( IPACK.EQ.6 ) THEN
00977                      DO 370 JC = 1, UUB
00978                         DO 360 JR = 1, UUB + 1 - JC
00979                            A( JR, JC ) = ZERO
00980   360                   CONTINUE
00981   370                CONTINUE
00982                   END IF
00983                   IF( IPACKG.EQ.5 ) THEN
00984                      IPACKG = IPACK
00985                   ELSE
00986                      IPACKG = 0
00987                   END IF
00988                END IF
00989             END IF
00990          END IF
00991 *
00992       ELSE
00993 *
00994 *        4)      Generate Banded Matrix by first
00995 *                Rotating by random Unitary matrices,
00996 *                then reducing the bandwidth using Householder
00997 *                transformations.
00998 *
00999 *                Note: we should get here only if LDA .ge. N
01000 *
01001          IF( ISYM.EQ.1 ) THEN
01002 *
01003 *           Non-symmetric -- A = U D V
01004 *
01005             CALL DLAGGE( MR, NC, LLB, UUB, D, A, LDA, ISEED, WORK,
01006      $                   IINFO )
01007          ELSE
01008 *
01009 *           Symmetric -- A = U D U'
01010 *
01011             CALL DLAGSY( M, LLB, D, A, LDA, ISEED, WORK, IINFO )
01012 *
01013          END IF
01014          IF( IINFO.NE.0 ) THEN
01015             INFO = 3
01016             RETURN
01017          END IF
01018       END IF
01019 *
01020 *     5)      Pack the matrix
01021 *
01022       IF( IPACK.NE.IPACKG ) THEN
01023          IF( IPACK.EQ.1 ) THEN
01024 *
01025 *           'U' -- Upper triangular, not packed
01026 *
01027             DO 390 J = 1, M
01028                DO 380 I = J + 1, M
01029                   A( I, J ) = ZERO
01030   380          CONTINUE
01031   390       CONTINUE
01032 *
01033          ELSE IF( IPACK.EQ.2 ) THEN
01034 *
01035 *           'L' -- Lower triangular, not packed
01036 *
01037             DO 410 J = 2, M
01038                DO 400 I = 1, J - 1
01039                   A( I, J ) = ZERO
01040   400          CONTINUE
01041   410       CONTINUE
01042 *
01043          ELSE IF( IPACK.EQ.3 ) THEN
01044 *
01045 *           'C' -- Upper triangle packed Columnwise.
01046 *
01047             ICOL = 1
01048             IROW = 0
01049             DO 430 J = 1, M
01050                DO 420 I = 1, J
01051                   IROW = IROW + 1
01052                   IF( IROW.GT.LDA ) THEN
01053                      IROW = 1
01054                      ICOL = ICOL + 1
01055                   END IF
01056                   A( IROW, ICOL ) = A( I, J )
01057   420          CONTINUE
01058   430       CONTINUE
01059 *
01060          ELSE IF( IPACK.EQ.4 ) THEN
01061 *
01062 *           'R' -- Lower triangle packed Columnwise.
01063 *
01064             ICOL = 1
01065             IROW = 0
01066             DO 450 J = 1, M
01067                DO 440 I = J, M
01068                   IROW = IROW + 1
01069                   IF( IROW.GT.LDA ) THEN
01070                      IROW = 1
01071                      ICOL = ICOL + 1
01072                   END IF
01073                   A( IROW, ICOL ) = A( I, J )
01074   440          CONTINUE
01075   450       CONTINUE
01076 *
01077          ELSE IF( IPACK.GE.5 ) THEN
01078 *
01079 *           'B' -- The lower triangle is packed as a band matrix.
01080 *           'Q' -- The upper triangle is packed as a band matrix.
01081 *           'Z' -- The whole matrix is packed as a band matrix.
01082 *
01083             IF( IPACK.EQ.5 )
01084      $         UUB = 0
01085             IF( IPACK.EQ.6 )
01086      $         LLB = 0
01087 *
01088             DO 470 J = 1, UUB
01089                DO 460 I = MIN( J+LLB, M ), 1, -1
01090                   A( I-J+UUB+1, J ) = A( I, J )
01091   460          CONTINUE
01092   470       CONTINUE
01093 *
01094             DO 490 J = UUB + 2, N
01095                DO 480 I = J - UUB, MIN( J+LLB, M )
01096                   A( I-J+UUB+1, J ) = A( I, J )
01097   480          CONTINUE
01098   490       CONTINUE
01099          END IF
01100 *
01101 *        If packed, zero out extraneous elements.
01102 *
01103 *        Symmetric/Triangular Packed --
01104 *        zero out everything after A(IROW,ICOL)
01105 *
01106          IF( IPACK.EQ.3 .OR. IPACK.EQ.4 ) THEN
01107             DO 510 JC = ICOL, M
01108                DO 500 JR = IROW + 1, LDA
01109                   A( JR, JC ) = ZERO
01110   500          CONTINUE
01111                IROW = 0
01112   510       CONTINUE
01113 *
01114          ELSE IF( IPACK.GE.5 ) THEN
01115 *
01116 *           Packed Band --
01117 *              1st row is now in A( UUB+2-j, j), zero above it
01118 *              m-th row is now in A( M+UUB-j,j), zero below it
01119 *              last non-zero diagonal is now in A( UUB+LLB+1,j ),
01120 *                 zero below it, too.
01121 *
01122             IR1 = UUB + LLB + 2
01123             IR2 = UUB + M + 2
01124             DO 540 JC = 1, N
01125                DO 520 JR = 1, UUB + 1 - JC
01126                   A( JR, JC ) = ZERO
01127   520          CONTINUE
01128                DO 530 JR = MAX( 1, MIN( IR1, IR2-JC ) ), LDA
01129                   A( JR, JC ) = ZERO
01130   530          CONTINUE
01131   540       CONTINUE
01132          END IF
01133       END IF
01134 *
01135       RETURN
01136 *
01137 *     End of DLATMT
01138 *
01139       END
 All Files Functions