LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
zlaptm.f
Go to the documentation of this file.
00001 *> \brief \b ZLAPTM
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 ZLAPTM( UPLO, N, NRHS, ALPHA, D, E, X, LDX, BETA, B,
00012 *                          LDB )
00013 * 
00014 *       .. Scalar Arguments ..
00015 *       CHARACTER          UPLO
00016 *       INTEGER            LDB, LDX, N, NRHS
00017 *       DOUBLE PRECISION   ALPHA, BETA
00018 *       ..
00019 *       .. Array Arguments ..
00020 *       DOUBLE PRECISION   D( * )
00021 *       COMPLEX*16         B( LDB, * ), E( * ), X( LDX, * )
00022 *       ..
00023 *  
00024 *
00025 *> \par Purpose:
00026 *  =============
00027 *>
00028 *> \verbatim
00029 *>
00030 *> ZLAPTM multiplies an N by NRHS matrix X by a Hermitian tridiagonal
00031 *> matrix A and stores the result in a matrix B.  The operation has the
00032 *> form
00033 *>
00034 *>    B := alpha * A * X + beta * B
00035 *>
00036 *> where alpha may be either 1. or -1. and beta may be 0., 1., or -1.
00037 *> \endverbatim
00038 *
00039 *  Arguments:
00040 *  ==========
00041 *
00042 *> \param[in] UPLO
00043 *> \verbatim
00044 *>          UPLO is CHARACTER
00045 *>          Specifies whether the superdiagonal or the subdiagonal of the
00046 *>          tridiagonal matrix A is stored.
00047 *>          = 'U':  Upper, E is the superdiagonal of A.
00048 *>          = 'L':  Lower, E is the subdiagonal of A.
00049 *> \endverbatim
00050 *>
00051 *> \param[in] N
00052 *> \verbatim
00053 *>          N is INTEGER
00054 *>          The order of the matrix A.  N >= 0.
00055 *> \endverbatim
00056 *>
00057 *> \param[in] NRHS
00058 *> \verbatim
00059 *>          NRHS is INTEGER
00060 *>          The number of right hand sides, i.e., the number of columns
00061 *>          of the matrices X and B.
00062 *> \endverbatim
00063 *>
00064 *> \param[in] ALPHA
00065 *> \verbatim
00066 *>          ALPHA is DOUBLE PRECISION
00067 *>          The scalar alpha.  ALPHA must be 1. or -1.; otherwise,
00068 *>          it is assumed to be 0.
00069 *> \endverbatim
00070 *>
00071 *> \param[in] D
00072 *> \verbatim
00073 *>          D is DOUBLE PRECISION array, dimension (N)
00074 *>          The n diagonal elements of the tridiagonal matrix A.
00075 *> \endverbatim
00076 *>
00077 *> \param[in] E
00078 *> \verbatim
00079 *>          E is COMPLEX*16 array, dimension (N-1)
00080 *>          The (n-1) subdiagonal or superdiagonal elements of A.
00081 *> \endverbatim
00082 *>
00083 *> \param[in] X
00084 *> \verbatim
00085 *>          X is COMPLEX*16 array, dimension (LDX,NRHS)
00086 *>          The N by NRHS matrix X.
00087 *> \endverbatim
00088 *>
00089 *> \param[in] LDX
00090 *> \verbatim
00091 *>          LDX is INTEGER
00092 *>          The leading dimension of the array X.  LDX >= max(N,1).
00093 *> \endverbatim
00094 *>
00095 *> \param[in] BETA
00096 *> \verbatim
00097 *>          BETA is DOUBLE PRECISION
00098 *>          The scalar beta.  BETA must be 0., 1., or -1.; otherwise,
00099 *>          it is assumed to be 1.
00100 *> \endverbatim
00101 *>
00102 *> \param[in,out] B
00103 *> \verbatim
00104 *>          B is COMPLEX*16 array, dimension (LDB,NRHS)
00105 *>          On entry, the N by NRHS matrix B.
00106 *>          On exit, B is overwritten by the matrix expression
00107 *>          B := alpha * A * X + beta * B.
00108 *> \endverbatim
00109 *>
00110 *> \param[in] LDB
00111 *> \verbatim
00112 *>          LDB is INTEGER
00113 *>          The leading dimension of the array B.  LDB >= max(N,1).
00114 *> \endverbatim
00115 *
00116 *  Authors:
00117 *  ========
00118 *
00119 *> \author Univ. of Tennessee 
00120 *> \author Univ. of California Berkeley 
00121 *> \author Univ. of Colorado Denver 
00122 *> \author NAG Ltd. 
00123 *
00124 *> \date November 2011
00125 *
00126 *> \ingroup complex16_lin
00127 *
00128 *  =====================================================================
00129       SUBROUTINE ZLAPTM( UPLO, N, NRHS, ALPHA, D, E, X, LDX, BETA, B,
00130      $                   LDB )
00131 *
00132 *  -- LAPACK test routine (version 3.4.0) --
00133 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00134 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00135 *     November 2011
00136 *
00137 *     .. Scalar Arguments ..
00138       CHARACTER          UPLO
00139       INTEGER            LDB, LDX, N, NRHS
00140       DOUBLE PRECISION   ALPHA, BETA
00141 *     ..
00142 *     .. Array Arguments ..
00143       DOUBLE PRECISION   D( * )
00144       COMPLEX*16         B( LDB, * ), E( * ), X( LDX, * )
00145 *     ..
00146 *
00147 *  =====================================================================
00148 *
00149 *     .. Parameters ..
00150       DOUBLE PRECISION   ONE, ZERO
00151       PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
00152 *     ..
00153 *     .. Local Scalars ..
00154       INTEGER            I, J
00155 *     ..
00156 *     .. External Functions ..
00157       LOGICAL            LSAME
00158       EXTERNAL           LSAME
00159 *     ..
00160 *     .. Intrinsic Functions ..
00161       INTRINSIC          DCONJG
00162 *     ..
00163 *     .. Executable Statements ..
00164 *
00165       IF( N.EQ.0 )
00166      $   RETURN
00167 *
00168       IF( BETA.EQ.ZERO ) THEN
00169          DO 20 J = 1, NRHS
00170             DO 10 I = 1, N
00171                B( I, J ) = ZERO
00172    10       CONTINUE
00173    20    CONTINUE
00174       ELSE IF( BETA.EQ.-ONE ) THEN
00175          DO 40 J = 1, NRHS
00176             DO 30 I = 1, N
00177                B( I, J ) = -B( I, J )
00178    30       CONTINUE
00179    40    CONTINUE
00180       END IF
00181 *
00182       IF( ALPHA.EQ.ONE ) THEN
00183          IF( LSAME( UPLO, 'U' ) ) THEN
00184 *
00185 *           Compute B := B + A*X, where E is the superdiagonal of A.
00186 *
00187             DO 60 J = 1, NRHS
00188                IF( N.EQ.1 ) THEN
00189                   B( 1, J ) = B( 1, J ) + D( 1 )*X( 1, J )
00190                ELSE
00191                   B( 1, J ) = B( 1, J ) + D( 1 )*X( 1, J ) +
00192      $                        E( 1 )*X( 2, J )
00193                   B( N, J ) = B( N, J ) + DCONJG( E( N-1 ) )*
00194      $                        X( N-1, J ) + D( N )*X( N, J )
00195                   DO 50 I = 2, N - 1
00196                      B( I, J ) = B( I, J ) + DCONJG( E( I-1 ) )*
00197      $                           X( I-1, J ) + D( I )*X( I, J ) +
00198      $                           E( I )*X( I+1, J )
00199    50             CONTINUE
00200                END IF
00201    60       CONTINUE
00202          ELSE
00203 *
00204 *           Compute B := B + A*X, where E is the subdiagonal of A.
00205 *
00206             DO 80 J = 1, NRHS
00207                IF( N.EQ.1 ) THEN
00208                   B( 1, J ) = B( 1, J ) + D( 1 )*X( 1, J )
00209                ELSE
00210                   B( 1, J ) = B( 1, J ) + D( 1 )*X( 1, J ) +
00211      $                        DCONJG( E( 1 ) )*X( 2, J )
00212                   B( N, J ) = B( N, J ) + E( N-1 )*X( N-1, J ) +
00213      $                        D( N )*X( N, J )
00214                   DO 70 I = 2, N - 1
00215                      B( I, J ) = B( I, J ) + E( I-1 )*X( I-1, J ) +
00216      $                           D( I )*X( I, J ) +
00217      $                           DCONJG( E( I ) )*X( I+1, J )
00218    70             CONTINUE
00219                END IF
00220    80       CONTINUE
00221          END IF
00222       ELSE IF( ALPHA.EQ.-ONE ) THEN
00223          IF( LSAME( UPLO, 'U' ) ) THEN
00224 *
00225 *           Compute B := B - A*X, where E is the superdiagonal of A.
00226 *
00227             DO 100 J = 1, NRHS
00228                IF( N.EQ.1 ) THEN
00229                   B( 1, J ) = B( 1, J ) - D( 1 )*X( 1, J )
00230                ELSE
00231                   B( 1, J ) = B( 1, J ) - D( 1 )*X( 1, J ) -
00232      $                        E( 1 )*X( 2, J )
00233                   B( N, J ) = B( N, J ) - DCONJG( E( N-1 ) )*
00234      $                        X( N-1, J ) - D( N )*X( N, J )
00235                   DO 90 I = 2, N - 1
00236                      B( I, J ) = B( I, J ) - DCONJG( E( I-1 ) )*
00237      $                           X( I-1, J ) - D( I )*X( I, J ) -
00238      $                           E( I )*X( I+1, J )
00239    90             CONTINUE
00240                END IF
00241   100       CONTINUE
00242          ELSE
00243 *
00244 *           Compute B := B - A*X, where E is the subdiagonal of A.
00245 *
00246             DO 120 J = 1, NRHS
00247                IF( N.EQ.1 ) THEN
00248                   B( 1, J ) = B( 1, J ) - D( 1 )*X( 1, J )
00249                ELSE
00250                   B( 1, J ) = B( 1, J ) - D( 1 )*X( 1, J ) -
00251      $                        DCONJG( E( 1 ) )*X( 2, J )
00252                   B( N, J ) = B( N, J ) - E( N-1 )*X( N-1, J ) -
00253      $                        D( N )*X( N, J )
00254                   DO 110 I = 2, N - 1
00255                      B( I, J ) = B( I, J ) - E( I-1 )*X( I-1, J ) -
00256      $                           D( I )*X( I, J ) -
00257      $                           DCONJG( E( I ) )*X( I+1, J )
00258   110             CONTINUE
00259                END IF
00260   120       CONTINUE
00261          END IF
00262       END IF
00263       RETURN
00264 *
00265 *     End of ZLAPTM
00266 *
00267       END
 All Files Functions