SRC/zlagtm.f

   1 *> \brief \b ZLAGTM performs a matrix-matrix product of the form C = αAB+βC, where A is a tridiagonal matrix, B and C are rectangular matrices, and α and β are scalars, which may be 0, 1, or -1.
   2 *
   3 *  =========== DOCUMENTATION ===========
   4 *
   5 * Online html documentation available at
   6 *            http://www.netlib.org/lapack/explore-html/
   7 *
   8 *> \htmlonly
   9 *> Download ZLAGTM + dependencies
  10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zlagtm.f">
  11 *> [TGZ]</a>
  12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zlagtm.f">
  13 *> [ZIP]</a>
  14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zlagtm.f">
  15 *> [TXT]</a>
  16 *> \endhtmlonly
  17 *
  18 *  Definition:
  19 *  ===========
  20 *
  21 *       SUBROUTINE ZLAGTM( TRANS, N, NRHS, ALPHA, DL, D, DU, X, LDX, BETA,
  22 *                          B, LDB )
  23 *
  24 *       .. Scalar Arguments ..
  25 *       CHARACTER          TRANS
  26 *       INTEGER            LDB, LDX, N, NRHS
  27 *       DOUBLE PRECISION   ALPHA, BETA
  28 *       ..
  29 *       .. Array Arguments ..
  30 *       COMPLEX*16         B( LDB, * ), D( * ), DL( * ), DU( * ),
  31 *      $                   X( LDX, * )
  32 *       ..
  33 *
  34 *
  35 *> \par Purpose:
  36 *  =============
  37 *>
  38 *> \verbatim
  39 *>
  40 *> ZLAGTM performs a matrix-vector product of the form
  41 *>
  42 *>    B := alpha * A * X + beta * B
  43 *>
  44 *> where A is a tridiagonal matrix of order N, B and X are N by NRHS
  45 *> matrices, and alpha and beta are real scalars, each of which may be
  46 *> 0., 1., or -1.
  47 *> \endverbatim
  48 *
  49 *  Arguments:
  50 *  ==========
  51 *
  52 *> \param[in] TRANS
  53 *> \verbatim
  54 *>          TRANS is CHARACTER*1
  55 *>          Specifies the operation applied to A.
  56 *>          = 'N':  No transpose, B := alpha * A * X + beta * B
  57 *>          = 'T':  Transpose,    B := alpha * A**T * X + beta * B
  58 *>          = 'C':  Conjugate transpose, B := alpha * A**H * X + beta * B
  59 *> \endverbatim
  60 *>
  61 *> \param[in] N
  62 *> \verbatim
  63 *>          N is INTEGER
  64 *>          The order of the matrix A.  N >= 0.
  65 *> \endverbatim
  66 *>
  67 *> \param[in] NRHS
  68 *> \verbatim
  69 *>          NRHS is INTEGER
  70 *>          The number of right hand sides, i.e., the number of columns
  71 *>          of the matrices X and B.
  72 *> \endverbatim
  73 *>
  74 *> \param[in] ALPHA
  75 *> \verbatim
  76 *>          ALPHA is DOUBLE PRECISION
  77 *>          The scalar alpha.  ALPHA must be 0., 1., or -1.; otherwise,
  78 *>          it is assumed to be 0.
  79 *> \endverbatim
  80 *>
  81 *> \param[in] DL
  82 *> \verbatim
  83 *>          DL is COMPLEX*16 array, dimension (N-1)
  84 *>          The (n-1) sub-diagonal elements of T.
  85 *> \endverbatim
  86 *>
  87 *> \param[in] D
  88 *> \verbatim
  89 *>          D is COMPLEX*16 array, dimension (N)
  90 *>          The diagonal elements of T.
  91 *> \endverbatim
  92 *>
  93 *> \param[in] DU
  94 *> \verbatim
  95 *>          DU is COMPLEX*16 array, dimension (N-1)
  96 *>          The (n-1) super-diagonal elements of T.
  97 *> \endverbatim
  98 *>
  99 *> \param[in] X
 100 *> \verbatim
 101 *>          X is COMPLEX*16 array, dimension (LDX,NRHS)
 102 *>          The N by NRHS matrix X.
 103 *> \endverbatim
 104 *>
 105 *> \param[in] LDX
 106 *> \verbatim
 107 *>          LDX is INTEGER
 108 *>          The leading dimension of the array X.  LDX >= max(N,1).
 109 *> \endverbatim
 110 *>
 111 *> \param[in] BETA
 112 *> \verbatim
 113 *>          BETA is DOUBLE PRECISION
 114 *>          The scalar beta.  BETA must be 0., 1., or -1.; otherwise,
 115 *>          it is assumed to be 1.
 116 *> \endverbatim
 117 *>
 118 *> \param[in,out] B
 119 *> \verbatim
 120 *>          B is COMPLEX*16 array, dimension (LDB,NRHS)
 121 *>          On entry, the N by NRHS matrix B.
 122 *>          On exit, B is overwritten by the matrix expression
 123 *>          B := alpha * A * X + beta * B.
 124 *> \endverbatim
 125 *>
 126 *> \param[in] LDB
 127 *> \verbatim
 128 *>          LDB is INTEGER
 129 *>          The leading dimension of the array B.  LDB >= max(N,1).
 130 *> \endverbatim
 131 *
 132 *  Authors:
 133 *  ========
 134 *
 135 *> \author Univ. of Tennessee
 136 *> \author Univ. of California Berkeley
 137 *> \author Univ. of Colorado Denver
 138 *> \author NAG Ltd.
 139 *
 140 *> \date September 2012
 141 *
 142 *> \ingroup complex16OTHERauxiliary
 143 *
 144 *  =====================================================================
 145       SUBROUTINE ZLAGTM( TRANS, N, NRHS, ALPHA, DL, D, DU, X, LDX, BETA,
 146      $                   B, LDB )
 147 *
 148 *  -- LAPACK auxiliary routine (version 3.4.2) --
 149 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 150 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
 151 *     September 2012
 152 *
 153 *     .. Scalar Arguments ..
 154       CHARACTER          TRANS
 155       INTEGER            LDB, LDX, N, NRHS
 156       DOUBLE PRECISION   ALPHA, BETA
 157 *     ..
 158 *     .. Array Arguments ..
 159       COMPLEX*16         B( LDB, * ), D( * ), DL( * ), DU( * ),
 160      $                   X( LDX, * )
 161 *     ..
 162 *
 163 *  =====================================================================
 164 *
 165 *     .. Parameters ..
 166       DOUBLE PRECISION   ONE, ZERO
 167       PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
 168 *     ..
 169 *     .. Local Scalars ..
 170       INTEGER            I, J
 171 *     ..
 172 *     .. External Functions ..
 173       LOGICAL            LSAME
 174       EXTERNAL           LSAME
 175 *     ..
 176 *     .. Intrinsic Functions ..
 177       INTRINSIC          DCONJG
 178 *     ..
 179 *     .. Executable Statements ..
 180 *
 181       IF( N.EQ.0 )
 182      $   RETURN
 183 *
 184 *     Multiply B by BETA if BETA.NE.1.
 185 *
 186       IF( BETA.EQ.ZERO ) THEN
 187          DO 20 J = 1, NRHS
 188             DO 10 I = 1, N
 189                B( I, J ) = ZERO
 190    10       CONTINUE
 191    20    CONTINUE
 192       ELSE IF( BETA.EQ.-ONE ) THEN
 193          DO 40 J = 1, NRHS
 194             DO 30 I = 1, N
 195                B( I, J ) = -B( I, J )
 196    30       CONTINUE
 197    40    CONTINUE
 198       END IF
 199 *
 200       IF( ALPHA.EQ.ONE ) THEN
 201          IF( LSAME( TRANS, 'N' ) ) THEN
 202 *
 203 *           Compute B := B + A*X
 204 *
 205             DO 60 J = 1, NRHS
 206                IF( N.EQ.1 ) THEN
 207                   B( 1, J ) = B( 1, J ) + D( 1 )*X( 1, J )
 208                ELSE
 209                   B( 1, J ) = B( 1, J ) + D( 1 )*X( 1, J ) +
 210      $                        DU( 1 )*X( 2, J )
 211                   B( N, J ) = B( N, J ) + DL( N-1 )*X( N-1, J ) +
 212      $                        D( N )*X( N, J )
 213                   DO 50 I = 2, N - 1
 214                      B( I, J ) = B( I, J ) + DL( I-1 )*X( I-1, J ) +
 215      $                           D( I )*X( I, J ) + DU( I )*X( I+1, J )
 216    50             CONTINUE
 217                END IF
 218    60       CONTINUE
 219          ELSE IF( LSAME( TRANS, 'T' ) ) THEN
 220 *
 221 *           Compute B := B + A**T * X
 222 *
 223             DO 80 J = 1, NRHS
 224                IF( N.EQ.1 ) THEN
 225                   B( 1, J ) = B( 1, J ) + D( 1 )*X( 1, J )
 226                ELSE
 227                   B( 1, J ) = B( 1, J ) + D( 1 )*X( 1, J ) +
 228      $                        DL( 1 )*X( 2, J )
 229                   B( N, J ) = B( N, J ) + DU( N-1 )*X( N-1, J ) +
 230      $                        D( N )*X( N, J )
 231                   DO 70 I = 2, N - 1
 232                      B( I, J ) = B( I, J ) + DU( I-1 )*X( I-1, J ) +
 233      $                           D( I )*X( I, J ) + DL( I )*X( I+1, J )
 234    70             CONTINUE
 235                END IF
 236    80       CONTINUE
 237          ELSE IF( LSAME( TRANS, 'C' ) ) THEN
 238 *
 239 *           Compute B := B + A**H * X
 240 *
 241             DO 100 J = 1, NRHS
 242                IF( N.EQ.1 ) THEN
 243                   B( 1, J ) = B( 1, J ) + DCONJG( D( 1 ) )*X( 1, J )
 244                ELSE
 245                   B( 1, J ) = B( 1, J ) + DCONJG( D( 1 ) )*X( 1, J ) +
 246      $                        DCONJG( DL( 1 ) )*X( 2, J )
 247                   B( N, J ) = B( N, J ) + DCONJG( DU( N-1 ) )*
 248      $                        X( N-1, J ) + DCONJG( D( N ) )*X( N, J )
 249                   DO 90 I = 2, N - 1
 250                      B( I, J ) = B( I, J ) + DCONJG( DU( I-1 ) )*
 251      $                           X( I-1, J ) + DCONJG( D( I ) )*
 252      $                           X( I, J ) + DCONJG( DL( I ) )*
 253      $                           X( I+1, J )
 254    90             CONTINUE
 255                END IF
 256   100       CONTINUE
 257          END IF
 258       ELSE IF( ALPHA.EQ.-ONE ) THEN
 259          IF( LSAME( TRANS, 'N' ) ) THEN
 260 *
 261 *           Compute B := B - A*X
 262 *
 263             DO 120 J = 1, NRHS
 264                IF( N.EQ.1 ) THEN
 265                   B( 1, J ) = B( 1, J ) - D( 1 )*X( 1, J )
 266                ELSE
 267                   B( 1, J ) = B( 1, J ) - D( 1 )*X( 1, J ) -
 268      $                        DU( 1 )*X( 2, J )
 269                   B( N, J ) = B( N, J ) - DL( N-1 )*X( N-1, J ) -
 270      $                        D( N )*X( N, J )
 271                   DO 110 I = 2, N - 1
 272                      B( I, J ) = B( I, J ) - DL( I-1 )*X( I-1, J ) -
 273      $                           D( I )*X( I, J ) - DU( I )*X( I+1, J )
 274   110             CONTINUE
 275                END IF
 276   120       CONTINUE
 277          ELSE IF( LSAME( TRANS, 'T' ) ) THEN
 278 *
 279 *           Compute B := B - A**T *X
 280 *
 281             DO 140 J = 1, NRHS
 282                IF( N.EQ.1 ) THEN
 283                   B( 1, J ) = B( 1, J ) - D( 1 )*X( 1, J )
 284                ELSE
 285                   B( 1, J ) = B( 1, J ) - D( 1 )*X( 1, J ) -
 286      $                        DL( 1 )*X( 2, J )
 287                   B( N, J ) = B( N, J ) - DU( N-1 )*X( N-1, J ) -
 288      $                        D( N )*X( N, J )
 289                   DO 130 I = 2, N - 1
 290                      B( I, J ) = B( I, J ) - DU( I-1 )*X( I-1, J ) -
 291      $                           D( I )*X( I, J ) - DL( I )*X( I+1, J )
 292   130             CONTINUE
 293                END IF
 294   140       CONTINUE
 295          ELSE IF( LSAME( TRANS, 'C' ) ) THEN
 296 *
 297 *           Compute B := B - A**H *X
 298 *
 299             DO 160 J = 1, NRHS
 300                IF( N.EQ.1 ) THEN
 301                   B( 1, J ) = B( 1, J ) - DCONJG( D( 1 ) )*X( 1, J )
 302                ELSE
 303                   B( 1, J ) = B( 1, J ) - DCONJG( D( 1 ) )*X( 1, J ) -
 304      $                        DCONJG( DL( 1 ) )*X( 2, J )
 305                   B( N, J ) = B( N, J ) - DCONJG( DU( N-1 ) )*
 306      $                        X( N-1, J ) - DCONJG( D( N ) )*X( N, J )
 307                   DO 150 I = 2, N - 1
 308                      B( I, J ) = B( I, J ) - DCONJG( DU( I-1 ) )*
 309      $                           X( I-1, J ) - DCONJG( D( I ) )*
 310      $                           X( I, J ) - DCONJG( DL( I ) )*
 311      $                           X( I+1, J )
 312   150             CONTINUE
 313                END IF
 314   160       CONTINUE
 315          END IF
 316       END IF
 317       RETURN
 318 *
 319 *     End of ZLAGTM
 320 *
 321       END