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