LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
zlatme.f
Go to the documentation of this file.
00001 *> \brief \b ZLATME
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 ZLATME( N, DIST, ISEED, D, MODE, COND, DMAX,
00012 *         RSIGN, 
00013 *                          UPPER, SIM, DS, MODES, CONDS, KL, KU, ANORM, 
00014 *         A, 
00015 *                          LDA, WORK, INFO )
00016 * 
00017 *       .. Scalar Arguments ..
00018 *       CHARACTER          DIST, RSIGN, SIM, UPPER
00019 *       INTEGER            INFO, KL, KU, LDA, MODE, MODES, N
00020 *       DOUBLE PRECISION   ANORM, COND, CONDS
00021 *       COMPLEX*16         DMAX
00022 *       ..
00023 *       .. Array Arguments ..
00024 *       INTEGER            ISEED( 4 )
00025 *       DOUBLE PRECISION   DS( * )
00026 *       COMPLEX*16         A( LDA, * ), D( * ), WORK( * )
00027 *       ..
00028 *  
00029 *
00030 *> \par Purpose:
00031 *  =============
00032 *>
00033 *> \verbatim
00034 *>
00035 *>    ZLATME generates random non-symmetric square matrices with
00036 *>    specified eigenvalues for testing LAPACK programs.
00037 *>
00038 *>    ZLATME operates by applying the following sequence of
00039 *>    operations:
00040 *>
00041 *>    1. Set the diagonal to D, where D may be input or
00042 *>         computed according to MODE, COND, DMAX, and RSIGN
00043 *>         as described below.
00044 *>
00045 *>    2. If UPPER='T', the upper triangle of A is set to random values
00046 *>         out of distribution DIST.
00047 *>
00048 *>    3. If SIM='T', A is multiplied on the left by a random matrix
00049 *>         X, whose singular values are specified by DS, MODES, and
00050 *>         CONDS, and on the right by X inverse.
00051 *>
00052 *>    4. If KL < N-1, the lower bandwidth is reduced to KL using
00053 *>         Householder transformations.  If KU < N-1, the upper
00054 *>         bandwidth is reduced to KU.
00055 *>
00056 *>    5. If ANORM is not negative, the matrix is scaled to have
00057 *>         maximum-element-norm ANORM.
00058 *>
00059 *>    (Note: since the matrix cannot be reduced beyond Hessenberg form,
00060 *>     no packing options are available.)
00061 *> \endverbatim
00062 *
00063 *  Arguments:
00064 *  ==========
00065 *
00066 *> \param[in] N
00067 *> \verbatim
00068 *>          N is INTEGER
00069 *>           The number of columns (or rows) of A. Not modified.
00070 *> \endverbatim
00071 *>
00072 *> \param[in] DIST
00073 *> \verbatim
00074 *>          DIST is CHARACTER*1
00075 *>           On entry, DIST specifies the type of distribution to be used
00076 *>           to generate the random eigen-/singular values, and on the
00077 *>           upper triangle (see UPPER).
00078 *>           'U' => UNIFORM( 0, 1 )  ( 'U' for uniform )
00079 *>           'S' => UNIFORM( -1, 1 ) ( 'S' for symmetric )
00080 *>           'N' => NORMAL( 0, 1 )   ( 'N' for normal )
00081 *>           'D' => uniform on the complex disc |z| < 1.
00082 *>           Not modified.
00083 *> \endverbatim
00084 *>
00085 *> \param[in,out] ISEED
00086 *> \verbatim
00087 *>          ISEED is INTEGER array, dimension ( 4 )
00088 *>           On entry ISEED specifies the seed of the random number
00089 *>           generator. They should lie between 0 and 4095 inclusive,
00090 *>           and ISEED(4) should be odd. The random number generator
00091 *>           uses a linear congruential sequence limited to small
00092 *>           integers, and so should produce machine independent
00093 *>           random numbers. The values of ISEED are changed on
00094 *>           exit, and can be used in the next call to ZLATME
00095 *>           to continue the same random number sequence.
00096 *>           Changed on exit.
00097 *> \endverbatim
00098 *>
00099 *> \param[in,out] D
00100 *> \verbatim
00101 *>          D is COMPLEX*16 array, dimension ( N )
00102 *>           This array is used to specify the eigenvalues of A.  If
00103 *>           MODE=0, then D is assumed to contain the eigenvalues
00104 *>           otherwise they will be computed according to MODE, COND,
00105 *>           DMAX, and RSIGN and placed in D.
00106 *>           Modified if MODE is nonzero.
00107 *> \endverbatim
00108 *>
00109 *> \param[in] MODE
00110 *> \verbatim
00111 *>          MODE is INTEGER
00112 *>           On entry this describes how the eigenvalues are to
00113 *>           be specified:
00114 *>           MODE = 0 means use D as input
00115 *>           MODE = 1 sets D(1)=1 and D(2:N)=1.0/COND
00116 *>           MODE = 2 sets D(1:N-1)=1 and D(N)=1.0/COND
00117 *>           MODE = 3 sets D(I)=COND**(-(I-1)/(N-1))
00118 *>           MODE = 4 sets D(i)=1 - (i-1)/(N-1)*(1 - 1/COND)
00119 *>           MODE = 5 sets D to random numbers in the range
00120 *>                    ( 1/COND , 1 ) such that their logarithms
00121 *>                    are uniformly distributed.
00122 *>           MODE = 6 set D to random numbers from same distribution
00123 *>                    as the rest of the matrix.
00124 *>           MODE < 0 has the same meaning as ABS(MODE), except that
00125 *>              the order of the elements of D is reversed.
00126 *>           Thus if MODE is between 1 and 4, D has entries ranging
00127 *>              from 1 to 1/COND, if between -1 and -4, D has entries
00128 *>              ranging from 1/COND to 1,
00129 *>           Not modified.
00130 *> \endverbatim
00131 *>
00132 *> \param[in] COND
00133 *> \verbatim
00134 *>          COND is DOUBLE PRECISION
00135 *>           On entry, this is used as described under MODE above.
00136 *>           If used, it must be >= 1. Not modified.
00137 *> \endverbatim
00138 *>
00139 *> \param[in] DMAX
00140 *> \verbatim
00141 *>          DMAX is COMPLEX*16
00142 *>           If MODE is neither -6, 0 nor 6, the contents of D, as
00143 *>           computed according to MODE and COND, will be scaled by
00144 *>           DMAX / max(abs(D(i))).  Note that DMAX need not be
00145 *>           positive or real: if DMAX is negative or complex (or zero),
00146 *>           D will be scaled by a negative or complex number (or zero).
00147 *>           If RSIGN='F' then the largest (absolute) eigenvalue will be
00148 *>           equal to DMAX.
00149 *>           Not modified.
00150 *> \endverbatim
00151 *>
00152 *> \param[in] RSIGN
00153 *> \verbatim
00154 *>          RSIGN is CHARACTER*1
00155 *>           If MODE is not 0, 6, or -6, and RSIGN='T', then the
00156 *>           elements of D, as computed according to MODE and COND, will
00157 *>           be multiplied by a random complex number from the unit
00158 *>           circle |z| = 1.  If RSIGN='F', they will not be.  RSIGN may
00159 *>           only have the values 'T' or 'F'.
00160 *>           Not modified.
00161 *> \endverbatim
00162 *>
00163 *> \param[in] UPPER
00164 *> \verbatim
00165 *>          UPPER is CHARACTER*1
00166 *>           If UPPER='T', then the elements of A above the diagonal
00167 *>           will be set to random numbers out of DIST.  If UPPER='F',
00168 *>           they will not.  UPPER may only have the values 'T' or 'F'.
00169 *>           Not modified.
00170 *> \endverbatim
00171 *>
00172 *> \param[in] SIM
00173 *> \verbatim
00174 *>          SIM is CHARACTER*1
00175 *>           If SIM='T', then A will be operated on by a "similarity
00176 *>           transform", i.e., multiplied on the left by a matrix X and
00177 *>           on the right by X inverse.  X = U S V, where U and V are
00178 *>           random unitary matrices and S is a (diagonal) matrix of
00179 *>           singular values specified by DS, MODES, and CONDS.  If
00180 *>           SIM='F', then A will not be transformed.
00181 *>           Not modified.
00182 *> \endverbatim
00183 *>
00184 *> \param[in,out] DS
00185 *> \verbatim
00186 *>          DS is DOUBLE PRECISION array, dimension ( N )
00187 *>           This array is used to specify the singular values of X,
00188 *>           in the same way that D specifies the eigenvalues of A.
00189 *>           If MODE=0, the DS contains the singular values, which
00190 *>           may not be zero.
00191 *>           Modified if MODE is nonzero.
00192 *> \endverbatim
00193 *>
00194 *> \param[in] MODES
00195 *> \verbatim
00196 *>          MODES is INTEGER
00197 *> \endverbatim
00198 *>
00199 *> \param[in] CONDS
00200 *> \verbatim
00201 *>          CONDS is DOUBLE PRECISION
00202 *>           Similar to MODE and COND, but for specifying the diagonal
00203 *>           of S.  MODES=-6 and +6 are not allowed (since they would
00204 *>           result in randomly ill-conditioned eigenvalues.)
00205 *> \endverbatim
00206 *>
00207 *> \param[in] KL
00208 *> \verbatim
00209 *>          KL is INTEGER
00210 *>           This specifies the lower bandwidth of the  matrix.  KL=1
00211 *>           specifies upper Hessenberg form.  If KL is at least N-1,
00212 *>           then A will have full lower bandwidth.
00213 *>           Not modified.
00214 *> \endverbatim
00215 *>
00216 *> \param[in] KU
00217 *> \verbatim
00218 *>          KU is INTEGER
00219 *>           This specifies the upper bandwidth of the  matrix.  KU=1
00220 *>           specifies lower Hessenberg form.  If KU is at least N-1,
00221 *>           then A will have full upper bandwidth; if KU and KL
00222 *>           are both at least N-1, then A will be dense.  Only one of
00223 *>           KU and KL may be less than N-1.
00224 *>           Not modified.
00225 *> \endverbatim
00226 *>
00227 *> \param[in] ANORM
00228 *> \verbatim
00229 *>          ANORM is DOUBLE PRECISION
00230 *>           If ANORM is not negative, then A will be scaled by a non-
00231 *>           negative real number to make the maximum-element-norm of A
00232 *>           to be ANORM.
00233 *>           Not modified.
00234 *> \endverbatim
00235 *>
00236 *> \param[out] A
00237 *> \verbatim
00238 *>          A is COMPLEX*16 array, dimension ( LDA, N )
00239 *>           On exit A is the desired test matrix.
00240 *>           Modified.
00241 *> \endverbatim
00242 *>
00243 *> \param[in] LDA
00244 *> \verbatim
00245 *>          LDA is INTEGER
00246 *>           LDA specifies the first dimension of A as declared in the
00247 *>           calling program.  LDA must be at least M.
00248 *>           Not modified.
00249 *> \endverbatim
00250 *>
00251 *> \param[out] WORK
00252 *> \verbatim
00253 *>          WORK is COMPLEX*16 array, dimension ( 3*N )
00254 *>           Workspace.
00255 *>           Modified.
00256 *> \endverbatim
00257 *>
00258 *> \param[out] INFO
00259 *> \verbatim
00260 *>          INFO is INTEGER
00261 *>           Error code.  On exit, INFO will be set to one of the
00262 *>           following values:
00263 *>             0 => normal return
00264 *>            -1 => N negative
00265 *>            -2 => DIST illegal string
00266 *>            -5 => MODE not in range -6 to 6
00267 *>            -6 => COND less than 1.0, and MODE neither -6, 0 nor 6
00268 *>            -9 => RSIGN is not 'T' or 'F'
00269 *>           -10 => UPPER is not 'T' or 'F'
00270 *>           -11 => SIM   is not 'T' or 'F'
00271 *>           -12 => MODES=0 and DS has a zero singular value.
00272 *>           -13 => MODES is not in the range -5 to 5.
00273 *>           -14 => MODES is nonzero and CONDS is less than 1.
00274 *>           -15 => KL is less than 1.
00275 *>           -16 => KU is less than 1, or KL and KU are both less than
00276 *>                  N-1.
00277 *>           -19 => LDA is less than M.
00278 *>            1  => Error return from ZLATM1 (computing D)
00279 *>            2  => Cannot scale to DMAX (max. eigenvalue is 0)
00280 *>            3  => Error return from DLATM1 (computing DS)
00281 *>            4  => Error return from ZLARGE
00282 *>            5  => Zero singular value from DLATM1.
00283 *> \endverbatim
00284 *
00285 *  Authors:
00286 *  ========
00287 *
00288 *> \author Univ. of Tennessee 
00289 *> \author Univ. of California Berkeley 
00290 *> \author Univ. of Colorado Denver 
00291 *> \author NAG Ltd. 
00292 *
00293 *> \date November 2011
00294 *
00295 *> \ingroup complex16_matgen
00296 *
00297 *  =====================================================================
00298       SUBROUTINE ZLATME( N, DIST, ISEED, D, MODE, COND, DMAX,
00299      $  RSIGN, 
00300      $                   UPPER, SIM, DS, MODES, CONDS, KL, KU, ANORM, 
00301      $  A, 
00302      $                   LDA, WORK, INFO )
00303 *
00304 *  -- LAPACK computational routine (version 3.4.0) --
00305 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00306 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00307 *     November 2011
00308 *
00309 *     .. Scalar Arguments ..
00310       CHARACTER          DIST, RSIGN, SIM, UPPER
00311       INTEGER            INFO, KL, KU, LDA, MODE, MODES, N
00312       DOUBLE PRECISION   ANORM, COND, CONDS
00313       COMPLEX*16         DMAX
00314 *     ..
00315 *     .. Array Arguments ..
00316       INTEGER            ISEED( 4 )
00317       DOUBLE PRECISION   DS( * )
00318       COMPLEX*16         A( LDA, * ), D( * ), WORK( * )
00319 *     ..
00320 *
00321 *  =====================================================================
00322 *
00323 *     .. Parameters ..
00324       DOUBLE PRECISION   ZERO
00325       PARAMETER          ( ZERO = 0.0D+0 )
00326       DOUBLE PRECISION   ONE
00327       PARAMETER          ( ONE = 1.0D+0 )
00328       COMPLEX*16         CZERO
00329       PARAMETER          ( CZERO = ( 0.0D+0, 0.0D+0 ) )
00330       COMPLEX*16         CONE
00331       PARAMETER          ( CONE = ( 1.0D+0, 0.0D+0 ) )
00332 *     ..
00333 *     .. Local Scalars ..
00334       LOGICAL            BADS
00335       INTEGER            I, IC, ICOLS, IDIST, IINFO, IR, IROWS, IRSIGN,
00336      $                   ISIM, IUPPER, J, JC, JCR
00337       DOUBLE PRECISION   RALPHA, TEMP
00338       COMPLEX*16         ALPHA, TAU, XNORMS
00339 *     ..
00340 *     .. Local Arrays ..
00341       DOUBLE PRECISION   TEMPA( 1 )
00342 *     ..
00343 *     .. External Functions ..
00344       LOGICAL            LSAME
00345       DOUBLE PRECISION   ZLANGE
00346       COMPLEX*16         ZLARND
00347       EXTERNAL           LSAME, ZLANGE, ZLARND
00348 *     ..
00349 *     .. External Subroutines ..
00350       EXTERNAL           DLATM1, XERBLA, ZCOPY, ZDSCAL, ZGEMV, ZGERC,
00351      $                   ZLACGV, ZLARFG, ZLARGE, ZLARNV, ZLASET, ZLATM1,
00352      $                   ZSCAL
00353 *     ..
00354 *     .. Intrinsic Functions ..
00355       INTRINSIC          ABS, DCONJG, MAX, MOD
00356 *     ..
00357 *     .. Executable Statements ..
00358 *
00359 *     1)      Decode and Test the input parameters.
00360 *             Initialize flags & seed.
00361 *
00362       INFO = 0
00363 *
00364 *     Quick return if possible
00365 *
00366       IF( N.EQ.0 )
00367      $   RETURN
00368 *
00369 *     Decode DIST
00370 *
00371       IF( LSAME( DIST, 'U' ) ) THEN
00372          IDIST = 1
00373       ELSE IF( LSAME( DIST, 'S' ) ) THEN
00374          IDIST = 2
00375       ELSE IF( LSAME( DIST, 'N' ) ) THEN
00376          IDIST = 3
00377       ELSE IF( LSAME( DIST, 'D' ) ) THEN
00378          IDIST = 4
00379       ELSE
00380          IDIST = -1
00381       END IF
00382 *
00383 *     Decode RSIGN
00384 *
00385       IF( LSAME( RSIGN, 'T' ) ) THEN
00386          IRSIGN = 1
00387       ELSE IF( LSAME( RSIGN, 'F' ) ) THEN
00388          IRSIGN = 0
00389       ELSE
00390          IRSIGN = -1
00391       END IF
00392 *
00393 *     Decode UPPER
00394 *
00395       IF( LSAME( UPPER, 'T' ) ) THEN
00396          IUPPER = 1
00397       ELSE IF( LSAME( UPPER, 'F' ) ) THEN
00398          IUPPER = 0
00399       ELSE
00400          IUPPER = -1
00401       END IF
00402 *
00403 *     Decode SIM
00404 *
00405       IF( LSAME( SIM, 'T' ) ) THEN
00406          ISIM = 1
00407       ELSE IF( LSAME( SIM, 'F' ) ) THEN
00408          ISIM = 0
00409       ELSE
00410          ISIM = -1
00411       END IF
00412 *
00413 *     Check DS, if MODES=0 and ISIM=1
00414 *
00415       BADS = .FALSE.
00416       IF( MODES.EQ.0 .AND. ISIM.EQ.1 ) THEN
00417          DO 10 J = 1, N
00418             IF( DS( J ).EQ.ZERO )
00419      $         BADS = .TRUE.
00420    10    CONTINUE
00421       END IF
00422 *
00423 *     Set INFO if an error
00424 *
00425       IF( N.LT.0 ) THEN
00426          INFO = -1
00427       ELSE IF( IDIST.EQ.-1 ) THEN
00428          INFO = -2
00429       ELSE IF( ABS( MODE ).GT.6 ) THEN
00430          INFO = -5
00431       ELSE IF( ( MODE.NE.0 .AND. ABS( MODE ).NE.6 ) .AND. COND.LT.ONE )
00432      $          THEN
00433          INFO = -6
00434       ELSE IF( IRSIGN.EQ.-1 ) THEN
00435          INFO = -9
00436       ELSE IF( IUPPER.EQ.-1 ) THEN
00437          INFO = -10
00438       ELSE IF( ISIM.EQ.-1 ) THEN
00439          INFO = -11
00440       ELSE IF( BADS ) THEN
00441          INFO = -12
00442       ELSE IF( ISIM.EQ.1 .AND. ABS( MODES ).GT.5 ) THEN
00443          INFO = -13
00444       ELSE IF( ISIM.EQ.1 .AND. MODES.NE.0 .AND. CONDS.LT.ONE ) THEN
00445          INFO = -14
00446       ELSE IF( KL.LT.1 ) THEN
00447          INFO = -15
00448       ELSE IF( KU.LT.1 .OR. ( KU.LT.N-1 .AND. KL.LT.N-1 ) ) THEN
00449          INFO = -16
00450       ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
00451          INFO = -19
00452       END IF
00453 *
00454       IF( INFO.NE.0 ) THEN
00455          CALL XERBLA( 'ZLATME', -INFO )
00456          RETURN
00457       END IF
00458 *
00459 *     Initialize random number generator
00460 *
00461       DO 20 I = 1, 4
00462          ISEED( I ) = MOD( ABS( ISEED( I ) ), 4096 )
00463    20 CONTINUE
00464 *
00465       IF( MOD( ISEED( 4 ), 2 ).NE.1 )
00466      $   ISEED( 4 ) = ISEED( 4 ) + 1
00467 *
00468 *     2)      Set up diagonal of A
00469 *
00470 *             Compute D according to COND and MODE
00471 *
00472       CALL ZLATM1( MODE, COND, IRSIGN, IDIST, ISEED, D, N, IINFO )
00473       IF( IINFO.NE.0 ) THEN
00474          INFO = 1
00475          RETURN
00476       END IF
00477       IF( MODE.NE.0 .AND. ABS( MODE ).NE.6 ) THEN
00478 *
00479 *        Scale by DMAX
00480 *
00481          TEMP = ABS( D( 1 ) )
00482          DO 30 I = 2, N
00483             TEMP = MAX( TEMP, ABS( D( I ) ) )
00484    30    CONTINUE
00485 *
00486          IF( TEMP.GT.ZERO ) THEN
00487             ALPHA = DMAX / TEMP
00488          ELSE
00489             INFO = 2
00490             RETURN
00491          END IF
00492 *
00493          CALL ZSCAL( N, ALPHA, D, 1 )
00494 *
00495       END IF
00496 *
00497       CALL ZLASET( 'Full', N, N, CZERO, CZERO, A, LDA )
00498       CALL ZCOPY( N, D, 1, A, LDA+1 )
00499 *
00500 *     3)      If UPPER='T', set upper triangle of A to random numbers.
00501 *
00502       IF( IUPPER.NE.0 ) THEN
00503          DO 40 JC = 2, N
00504             CALL ZLARNV( IDIST, ISEED, JC-1, A( 1, JC ) )
00505    40    CONTINUE
00506       END IF
00507 *
00508 *     4)      If SIM='T', apply similarity transformation.
00509 *
00510 *                                -1
00511 *             Transform is  X A X  , where X = U S V, thus
00512 *
00513 *             it is  U S V A V' (1/S) U'
00514 *
00515       IF( ISIM.NE.0 ) THEN
00516 *
00517 *        Compute S (singular values of the eigenvector matrix)
00518 *        according to CONDS and MODES
00519 *
00520          CALL DLATM1( MODES, CONDS, 0, 0, ISEED, DS, N, IINFO )
00521          IF( IINFO.NE.0 ) THEN
00522             INFO = 3
00523             RETURN
00524          END IF
00525 *
00526 *        Multiply by V and V'
00527 *
00528          CALL ZLARGE( N, A, LDA, ISEED, WORK, IINFO )
00529          IF( IINFO.NE.0 ) THEN
00530             INFO = 4
00531             RETURN
00532          END IF
00533 *
00534 *        Multiply by S and (1/S)
00535 *
00536          DO 50 J = 1, N
00537             CALL ZDSCAL( N, DS( J ), A( J, 1 ), LDA )
00538             IF( DS( J ).NE.ZERO ) THEN
00539                CALL ZDSCAL( N, ONE / DS( J ), A( 1, J ), 1 )
00540             ELSE
00541                INFO = 5
00542                RETURN
00543             END IF
00544    50    CONTINUE
00545 *
00546 *        Multiply by U and U'
00547 *
00548          CALL ZLARGE( N, A, LDA, ISEED, WORK, IINFO )
00549          IF( IINFO.NE.0 ) THEN
00550             INFO = 4
00551             RETURN
00552          END IF
00553       END IF
00554 *
00555 *     5)      Reduce the bandwidth.
00556 *
00557       IF( KL.LT.N-1 ) THEN
00558 *
00559 *        Reduce bandwidth -- kill column
00560 *
00561          DO 60 JCR = KL + 1, N - 1
00562             IC = JCR - KL
00563             IROWS = N + 1 - JCR
00564             ICOLS = N + KL - JCR
00565 *
00566             CALL ZCOPY( IROWS, A( JCR, IC ), 1, WORK, 1 )
00567             XNORMS = WORK( 1 )
00568             CALL ZLARFG( IROWS, XNORMS, WORK( 2 ), 1, TAU )
00569             TAU = DCONJG( TAU )
00570             WORK( 1 ) = CONE
00571             ALPHA = ZLARND( 5, ISEED )
00572 *
00573             CALL ZGEMV( 'C', IROWS, ICOLS, CONE, A( JCR, IC+1 ), LDA,
00574      $                  WORK, 1, CZERO, WORK( IROWS+1 ), 1 )
00575             CALL ZGERC( IROWS, ICOLS, -TAU, WORK, 1, WORK( IROWS+1 ), 1,
00576      $                  A( JCR, IC+1 ), LDA )
00577 *
00578             CALL ZGEMV( 'N', N, IROWS, CONE, A( 1, JCR ), LDA, WORK, 1,
00579      $                  CZERO, WORK( IROWS+1 ), 1 )
00580             CALL ZGERC( N, IROWS, -DCONJG( TAU ), WORK( IROWS+1 ), 1,
00581      $                  WORK, 1, A( 1, JCR ), LDA )
00582 *
00583             A( JCR, IC ) = XNORMS
00584             CALL ZLASET( 'Full', IROWS-1, 1, CZERO, CZERO,
00585      $                   A( JCR+1, IC ), LDA )
00586 *
00587             CALL ZSCAL( ICOLS+1, ALPHA, A( JCR, IC ), LDA )
00588             CALL ZSCAL( N, DCONJG( ALPHA ), A( 1, JCR ), 1 )
00589    60    CONTINUE
00590       ELSE IF( KU.LT.N-1 ) THEN
00591 *
00592 *        Reduce upper bandwidth -- kill a row at a time.
00593 *
00594          DO 70 JCR = KU + 1, N - 1
00595             IR = JCR - KU
00596             IROWS = N + KU - JCR
00597             ICOLS = N + 1 - JCR
00598 *
00599             CALL ZCOPY( ICOLS, A( IR, JCR ), LDA, WORK, 1 )
00600             XNORMS = WORK( 1 )
00601             CALL ZLARFG( ICOLS, XNORMS, WORK( 2 ), 1, TAU )
00602             TAU = DCONJG( TAU )
00603             WORK( 1 ) = CONE
00604             CALL ZLACGV( ICOLS-1, WORK( 2 ), 1 )
00605             ALPHA = ZLARND( 5, ISEED )
00606 *
00607             CALL ZGEMV( 'N', IROWS, ICOLS, CONE, A( IR+1, JCR ), LDA,
00608      $                  WORK, 1, CZERO, WORK( ICOLS+1 ), 1 )
00609             CALL ZGERC( IROWS, ICOLS, -TAU, WORK( ICOLS+1 ), 1, WORK, 1,
00610      $                  A( IR+1, JCR ), LDA )
00611 *
00612             CALL ZGEMV( 'C', ICOLS, N, CONE, A( JCR, 1 ), LDA, WORK, 1,
00613      $                  CZERO, WORK( ICOLS+1 ), 1 )
00614             CALL ZGERC( ICOLS, N, -DCONJG( TAU ), WORK, 1,
00615      $                  WORK( ICOLS+1 ), 1, A( JCR, 1 ), LDA )
00616 *
00617             A( IR, JCR ) = XNORMS
00618             CALL ZLASET( 'Full', 1, ICOLS-1, CZERO, CZERO,
00619      $                   A( IR, JCR+1 ), LDA )
00620 *
00621             CALL ZSCAL( IROWS+1, ALPHA, A( IR, JCR ), 1 )
00622             CALL ZSCAL( N, DCONJG( ALPHA ), A( JCR, 1 ), LDA )
00623    70    CONTINUE
00624       END IF
00625 *
00626 *     Scale the matrix to have norm ANORM
00627 *
00628       IF( ANORM.GE.ZERO ) THEN
00629          TEMP = ZLANGE( 'M', N, N, A, LDA, TEMPA )
00630          IF( TEMP.GT.ZERO ) THEN
00631             RALPHA = ANORM / TEMP
00632             DO 80 J = 1, N
00633                CALL ZDSCAL( N, RALPHA, A( 1, J ), 1 )
00634    80       CONTINUE
00635          END IF
00636       END IF
00637 *
00638       RETURN
00639 *
00640 *     End of ZLATME
00641 *
00642       END
 All Files Functions