LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
zlarhs.f
Go to the documentation of this file.
00001 *> \brief \b ZLARHS
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 ZLARHS( PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS,
00012 *                          A, LDA, X, LDX, B, LDB, ISEED, INFO )
00013 * 
00014 *       .. Scalar Arguments ..
00015 *       CHARACTER          TRANS, UPLO, XTYPE
00016 *       CHARACTER*3        PATH
00017 *       INTEGER            INFO, KL, KU, LDA, LDB, LDX, M, N, NRHS
00018 *       ..
00019 *       .. Array Arguments ..
00020 *       INTEGER            ISEED( 4 )
00021 *       COMPLEX*16         A( LDA, * ), B( LDB, * ), X( LDX, * )
00022 *       ..
00023 *  
00024 *
00025 *> \par Purpose:
00026 *  =============
00027 *>
00028 *> \verbatim
00029 *>
00030 *> ZLARHS chooses a set of NRHS random solution vectors and sets
00031 *> up the right hand sides for the linear system
00032 *>    op( A ) * X = B,
00033 *> where op( A ) may be A, A**T (transpose of A), or A**H (conjugate
00034 *> transpose of A).
00035 *> \endverbatim
00036 *
00037 *  Arguments:
00038 *  ==========
00039 *
00040 *> \param[in] PATH
00041 *> \verbatim
00042 *>          PATH is CHARACTER*3
00043 *>          The type of the complex matrix A.  PATH may be given in any
00044 *>          combination of upper and lower case.  Valid paths include
00045 *>             xGE:  General m x n matrix
00046 *>             xGB:  General banded matrix
00047 *>             xPO:  Hermitian positive definite, 2-D storage
00048 *>             xPP:  Hermitian positive definite packed
00049 *>             xPB:  Hermitian positive definite banded
00050 *>             xHE:  Hermitian indefinite, 2-D storage
00051 *>             xHP:  Hermitian indefinite packed
00052 *>             xHB:  Hermitian indefinite banded
00053 *>             xSY:  Symmetric indefinite, 2-D storage
00054 *>             xSP:  Symmetric indefinite packed
00055 *>             xSB:  Symmetric indefinite banded
00056 *>             xTR:  Triangular
00057 *>             xTP:  Triangular packed
00058 *>             xTB:  Triangular banded
00059 *>             xQR:  General m x n matrix
00060 *>             xLQ:  General m x n matrix
00061 *>             xQL:  General m x n matrix
00062 *>             xRQ:  General m x n matrix
00063 *>          where the leading character indicates the precision.
00064 *> \endverbatim
00065 *>
00066 *> \param[in] XTYPE
00067 *> \verbatim
00068 *>          XTYPE is CHARACTER*1
00069 *>          Specifies how the exact solution X will be determined:
00070 *>          = 'N':  New solution; generate a random X.
00071 *>          = 'C':  Computed; use value of X on entry.
00072 *> \endverbatim
00073 *>
00074 *> \param[in] UPLO
00075 *> \verbatim
00076 *>          UPLO is CHARACTER*1
00077 *>          Used only if A is symmetric or triangular; specifies whether
00078 *>          the upper or lower triangular part of the matrix A is stored.
00079 *>          = 'U':  Upper triangular
00080 *>          = 'L':  Lower triangular
00081 *> \endverbatim
00082 *>
00083 *> \param[in] TRANS
00084 *> \verbatim
00085 *>          TRANS is CHARACTER*1
00086 *>          Used only if A is nonsymmetric; specifies the operation
00087 *>          applied to the matrix A.
00088 *>          = 'N':  B := A    * X
00089 *>          = 'T':  B := A**T * X
00090 *>          = 'C':  B := A**H * X
00091 *> \endverbatim
00092 *>
00093 *> \param[in] M
00094 *> \verbatim
00095 *>          M is INTEGER
00096 *>          The number of rows of the matrix A.  M >= 0.
00097 *> \endverbatim
00098 *>
00099 *> \param[in] N
00100 *> \verbatim
00101 *>          N is INTEGER
00102 *>          The number of columns of the matrix A.  N >= 0.
00103 *> \endverbatim
00104 *>
00105 *> \param[in] KL
00106 *> \verbatim
00107 *>          KL is INTEGER
00108 *>          Used only if A is a band matrix; specifies the number of
00109 *>          subdiagonals of A if A is a general band matrix or if A is
00110 *>          symmetric or triangular and UPLO = 'L'; specifies the number
00111 *>          of superdiagonals of A if A is symmetric or triangular and
00112 *>          UPLO = 'U'.  0 <= KL <= M-1.
00113 *> \endverbatim
00114 *>
00115 *> \param[in] KU
00116 *> \verbatim
00117 *>          KU is INTEGER
00118 *>          Used only if A is a general band matrix or if A is
00119 *>          triangular.
00120 *>
00121 *>          If PATH = xGB, specifies the number of superdiagonals of A,
00122 *>          and 0 <= KU <= N-1.
00123 *>
00124 *>          If PATH = xTR, xTP, or xTB, specifies whether or not the
00125 *>          matrix has unit diagonal:
00126 *>          = 1:  matrix has non-unit diagonal (default)
00127 *>          = 2:  matrix has unit diagonal
00128 *> \endverbatim
00129 *>
00130 *> \param[in] NRHS
00131 *> \verbatim
00132 *>          NRHS is INTEGER
00133 *>          The number of right hand side vectors in the system A*X = B.
00134 *> \endverbatim
00135 *>
00136 *> \param[in] A
00137 *> \verbatim
00138 *>          A is COMPLEX*16 array, dimension (LDA,N)
00139 *>          The test matrix whose type is given by PATH.
00140 *> \endverbatim
00141 *>
00142 *> \param[in] LDA
00143 *> \verbatim
00144 *>          LDA is INTEGER
00145 *>          The leading dimension of the array A.
00146 *>          If PATH = xGB, LDA >= KL+KU+1.
00147 *>          If PATH = xPB, xSB, xHB, or xTB, LDA >= KL+1.
00148 *>          Otherwise, LDA >= max(1,M).
00149 *> \endverbatim
00150 *>
00151 *> \param[in,out] X
00152 *> \verbatim
00153 *>          X is or output) COMPLEX*16 array, dimension (LDX,NRHS)
00154 *>          On entry, if XTYPE = 'C' (for 'Computed'), then X contains
00155 *>          the exact solution to the system of linear equations.
00156 *>          On exit, if XTYPE = 'N' (for 'New'), then X is initialized
00157 *>          with random values.
00158 *> \endverbatim
00159 *>
00160 *> \param[in] LDX
00161 *> \verbatim
00162 *>          LDX is INTEGER
00163 *>          The leading dimension of the array X.  If TRANS = 'N',
00164 *>          LDX >= max(1,N); if TRANS = 'T', LDX >= max(1,M).
00165 *> \endverbatim
00166 *>
00167 *> \param[out] B
00168 *> \verbatim
00169 *>          B is COMPLEX*16 array, dimension (LDB,NRHS)
00170 *>          The right hand side vector(s) for the system of equations,
00171 *>          computed from B = op(A) * X, where op(A) is determined by
00172 *>          TRANS.
00173 *> \endverbatim
00174 *>
00175 *> \param[in] LDB
00176 *> \verbatim
00177 *>          LDB is INTEGER
00178 *>          The leading dimension of the array B.  If TRANS = 'N',
00179 *>          LDB >= max(1,M); if TRANS = 'T', LDB >= max(1,N).
00180 *> \endverbatim
00181 *>
00182 *> \param[in,out] ISEED
00183 *> \verbatim
00184 *>          ISEED is INTEGER array, dimension (4)
00185 *>          The seed vector for the random number generator (used in
00186 *>          ZLATMS).  Modified on exit.
00187 *> \endverbatim
00188 *>
00189 *> \param[out] INFO
00190 *> \verbatim
00191 *>          INFO is INTEGER
00192 *>          = 0: successful exit
00193 *>          < 0: if INFO = -k, the k-th argument had an illegal value
00194 *> \endverbatim
00195 *
00196 *  Authors:
00197 *  ========
00198 *
00199 *> \author Univ. of Tennessee 
00200 *> \author Univ. of California Berkeley 
00201 *> \author Univ. of Colorado Denver 
00202 *> \author NAG Ltd. 
00203 *
00204 *> \date November 2011
00205 *
00206 *> \ingroup complex16_lin
00207 *
00208 *  =====================================================================
00209       SUBROUTINE ZLARHS( PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS,
00210      $                   A, LDA, X, LDX, B, LDB, ISEED, INFO )
00211 *
00212 *  -- LAPACK test routine (version 3.4.0) --
00213 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00214 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00215 *     November 2011
00216 *
00217 *     .. Scalar Arguments ..
00218       CHARACTER          TRANS, UPLO, XTYPE
00219       CHARACTER*3        PATH
00220       INTEGER            INFO, KL, KU, LDA, LDB, LDX, M, N, NRHS
00221 *     ..
00222 *     .. Array Arguments ..
00223       INTEGER            ISEED( 4 )
00224       COMPLEX*16         A( LDA, * ), B( LDB, * ), X( LDX, * )
00225 *     ..
00226 *
00227 *  =====================================================================
00228 *
00229 *     .. Parameters ..
00230       COMPLEX*16         ONE, ZERO
00231       PARAMETER          ( ONE = ( 1.0D+0, 0.0D+0 ),
00232      $                   ZERO = ( 0.0D+0, 0.0D+0 ) )
00233 *     ..
00234 *     .. Local Scalars ..
00235       LOGICAL            BAND, GEN, NOTRAN, QRS, SYM, TRAN, TRI
00236       CHARACTER          C1, DIAG
00237       CHARACTER*2        C2
00238       INTEGER            J, MB, NX
00239 *     ..
00240 *     .. External Functions ..
00241       LOGICAL            LSAME, LSAMEN
00242       EXTERNAL           LSAME, LSAMEN
00243 *     ..
00244 *     .. External Subroutines ..
00245       EXTERNAL           XERBLA, ZGBMV, ZGEMM, ZHBMV, ZHEMM, ZHPMV,
00246      $                   ZLACPY, ZLARNV, ZSBMV, ZSPMV, ZSYMM, ZTBMV,
00247      $                   ZTPMV, ZTRMM
00248 *     ..
00249 *     .. Intrinsic Functions ..
00250       INTRINSIC          MAX
00251 *     ..
00252 *     .. Executable Statements ..
00253 *
00254 *     Test the input parameters.
00255 *
00256       INFO = 0
00257       C1 = PATH( 1: 1 )
00258       C2 = PATH( 2: 3 )
00259       TRAN = LSAME( TRANS, 'T' ) .OR. LSAME( TRANS, 'C' )
00260       NOTRAN = .NOT.TRAN
00261       GEN = LSAME( PATH( 2: 2 ), 'G' )
00262       QRS = LSAME( PATH( 2: 2 ), 'Q' ) .OR. LSAME( PATH( 3: 3 ), 'Q' )
00263       SYM = LSAME( PATH( 2: 2 ), 'P' ) .OR.
00264      $      LSAME( PATH( 2: 2 ), 'S' ) .OR. LSAME( PATH( 2: 2 ), 'H' )
00265       TRI = LSAME( PATH( 2: 2 ), 'T' )
00266       BAND = LSAME( PATH( 3: 3 ), 'B' )
00267       IF( .NOT.LSAME( C1, 'Zomplex precision' ) ) THEN
00268          INFO = -1
00269       ELSE IF( .NOT.( LSAME( XTYPE, 'N' ) .OR. LSAME( XTYPE, 'C' ) ) )
00270      $          THEN
00271          INFO = -2
00272       ELSE IF( ( SYM .OR. TRI ) .AND. .NOT.
00273      $         ( LSAME( UPLO, 'U' ) .OR. LSAME( UPLO, 'L' ) ) ) THEN
00274          INFO = -3
00275       ELSE IF( ( GEN .OR. QRS ) .AND. .NOT.
00276      $         ( TRAN .OR. LSAME( TRANS, 'N' ) ) ) THEN
00277          INFO = -4
00278       ELSE IF( M.LT.0 ) THEN
00279          INFO = -5
00280       ELSE IF( N.LT.0 ) THEN
00281          INFO = -6
00282       ELSE IF( BAND .AND. KL.LT.0 ) THEN
00283          INFO = -7
00284       ELSE IF( BAND .AND. KU.LT.0 ) THEN
00285          INFO = -8
00286       ELSE IF( NRHS.LT.0 ) THEN
00287          INFO = -9
00288       ELSE IF( ( .NOT.BAND .AND. LDA.LT.MAX( 1, M ) ) .OR.
00289      $         ( BAND .AND. ( SYM .OR. TRI ) .AND. LDA.LT.KL+1 ) .OR.
00290      $         ( BAND .AND. GEN .AND. LDA.LT.KL+KU+1 ) ) THEN
00291          INFO = -11
00292       ELSE IF( ( NOTRAN .AND. LDX.LT.MAX( 1, N ) ) .OR.
00293      $         ( TRAN .AND. LDX.LT.MAX( 1, M ) ) ) THEN
00294          INFO = -13
00295       ELSE IF( ( NOTRAN .AND. LDB.LT.MAX( 1, M ) ) .OR.
00296      $         ( TRAN .AND. LDB.LT.MAX( 1, N ) ) ) THEN
00297          INFO = -15
00298       END IF
00299       IF( INFO.NE.0 ) THEN
00300          CALL XERBLA( 'ZLARHS', -INFO )
00301          RETURN
00302       END IF
00303 *
00304 *     Initialize X to NRHS random vectors unless XTYPE = 'C'.
00305 *
00306       IF( TRAN ) THEN
00307          NX = M
00308          MB = N
00309       ELSE
00310          NX = N
00311          MB = M
00312       END IF
00313       IF( .NOT.LSAME( XTYPE, 'C' ) ) THEN
00314          DO 10 J = 1, NRHS
00315             CALL ZLARNV( 2, ISEED, N, X( 1, J ) )
00316    10    CONTINUE
00317       END IF
00318 *
00319 *     Multiply X by op( A ) using an appropriate
00320 *     matrix multiply routine.
00321 *
00322       IF( LSAMEN( 2, C2, 'GE' ) .OR. LSAMEN( 2, C2, 'QR' ) .OR.
00323      $    LSAMEN( 2, C2, 'LQ' ) .OR. LSAMEN( 2, C2, 'QL' ) .OR.
00324      $    LSAMEN( 2, C2, 'RQ' ) ) THEN
00325 *
00326 *        General matrix
00327 *
00328          CALL ZGEMM( TRANS, 'N', MB, NRHS, NX, ONE, A, LDA, X, LDX,
00329      $               ZERO, B, LDB )
00330 *
00331       ELSE IF( LSAMEN( 2, C2, 'PO' ) .OR. LSAMEN( 2, C2, 'HE' ) ) THEN
00332 *
00333 *        Hermitian matrix, 2-D storage
00334 *
00335          CALL ZHEMM( 'Left', UPLO, N, NRHS, ONE, A, LDA, X, LDX, ZERO,
00336      $               B, LDB )
00337 *
00338       ELSE IF( LSAMEN( 2, C2, 'SY' ) ) THEN
00339 *
00340 *        Symmetric matrix, 2-D storage
00341 *
00342          CALL ZSYMM( 'Left', UPLO, N, NRHS, ONE, A, LDA, X, LDX, ZERO,
00343      $               B, LDB )
00344 *
00345       ELSE IF( LSAMEN( 2, C2, 'GB' ) ) THEN
00346 *
00347 *        General matrix, band storage
00348 *
00349          DO 20 J = 1, NRHS
00350             CALL ZGBMV( TRANS, M, N, KL, KU, ONE, A, LDA, X( 1, J ), 1,
00351      $                  ZERO, B( 1, J ), 1 )
00352    20    CONTINUE
00353 *
00354       ELSE IF( LSAMEN( 2, C2, 'PB' ) .OR. LSAMEN( 2, C2, 'HB' ) ) THEN
00355 *
00356 *        Hermitian matrix, band storage
00357 *
00358          DO 30 J = 1, NRHS
00359             CALL ZHBMV( UPLO, N, KL, ONE, A, LDA, X( 1, J ), 1, ZERO,
00360      $                  B( 1, J ), 1 )
00361    30    CONTINUE
00362 *
00363       ELSE IF( LSAMEN( 2, C2, 'SB' ) ) THEN
00364 *
00365 *        Symmetric matrix, band storage
00366 *
00367          DO 40 J = 1, NRHS
00368             CALL ZSBMV( UPLO, N, KL, ONE, A, LDA, X( 1, J ), 1, ZERO,
00369      $                  B( 1, J ), 1 )
00370    40    CONTINUE
00371 *
00372       ELSE IF( LSAMEN( 2, C2, 'PP' ) .OR. LSAMEN( 2, C2, 'HP' ) ) THEN
00373 *
00374 *        Hermitian matrix, packed storage
00375 *
00376          DO 50 J = 1, NRHS
00377             CALL ZHPMV( UPLO, N, ONE, A, X( 1, J ), 1, ZERO, B( 1, J ),
00378      $                  1 )
00379    50    CONTINUE
00380 *
00381       ELSE IF( LSAMEN( 2, C2, 'SP' ) ) THEN
00382 *
00383 *        Symmetric matrix, packed storage
00384 *
00385          DO 60 J = 1, NRHS
00386             CALL ZSPMV( UPLO, N, ONE, A, X( 1, J ), 1, ZERO, B( 1, J ),
00387      $                  1 )
00388    60    CONTINUE
00389 *
00390       ELSE IF( LSAMEN( 2, C2, 'TR' ) ) THEN
00391 *
00392 *        Triangular matrix.  Note that for triangular matrices,
00393 *           KU = 1 => non-unit triangular
00394 *           KU = 2 => unit triangular
00395 *
00396          CALL ZLACPY( 'Full', N, NRHS, X, LDX, B, LDB )
00397          IF( KU.EQ.2 ) THEN
00398             DIAG = 'U'
00399          ELSE
00400             DIAG = 'N'
00401          END IF
00402          CALL ZTRMM( 'Left', UPLO, TRANS, DIAG, N, NRHS, ONE, A, LDA, B,
00403      $               LDB )
00404 *
00405       ELSE IF( LSAMEN( 2, C2, 'TP' ) ) THEN
00406 *
00407 *        Triangular matrix, packed storage
00408 *
00409          CALL ZLACPY( 'Full', N, NRHS, X, LDX, B, LDB )
00410          IF( KU.EQ.2 ) THEN
00411             DIAG = 'U'
00412          ELSE
00413             DIAG = 'N'
00414          END IF
00415          DO 70 J = 1, NRHS
00416             CALL ZTPMV( UPLO, TRANS, DIAG, N, A, B( 1, J ), 1 )
00417    70    CONTINUE
00418 *
00419       ELSE IF( LSAMEN( 2, C2, 'TB' ) ) THEN
00420 *
00421 *        Triangular matrix, banded storage
00422 *
00423          CALL ZLACPY( 'Full', N, NRHS, X, LDX, B, LDB )
00424          IF( KU.EQ.2 ) THEN
00425             DIAG = 'U'
00426          ELSE
00427             DIAG = 'N'
00428          END IF
00429          DO 80 J = 1, NRHS
00430             CALL ZTBMV( UPLO, TRANS, DIAG, N, KL, A, LDA, B( 1, J ), 1 )
00431    80    CONTINUE
00432 *
00433       ELSE
00434 *
00435 *        If none of the above, set INFO = -1 and return
00436 *
00437          INFO = -1
00438          CALL XERBLA( 'ZLARHS', -INFO )
00439       END IF
00440 *
00441       RETURN
00442 *
00443 *     End of ZLARHS
00444 *
00445       END
 All Files Functions