src/LAPACK/dsysv.f

   1       SUBROUTINE DSYSV( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK,
   2      $                  LWORK, INFO )
   3 *
   4 *  -- LAPACK driver routine (version 3.1) --
   5 *     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
   6 *     November 2006
   7 *
   8 *     .. Scalar Arguments ..
   9       CHARACTER          UPLO
  10       INTEGER            INFO, LDA, LDB, LWORK, N, NRHS
  11 *     ..
  12 *     .. Array Arguments ..
  13       INTEGER            IPIV( * )
  14       DOUBLE PRECISION   A( LDA, * ), B( LDB, * ), WORK( * )
  15 *     ..
  16 *
  17 *  Purpose
  18 *  =======
  19 *
  20 *  DSYSV computes the solution to a real system of linear equations
  21 *     A * X = B,
  22 *  where A is an N-by-N symmetric matrix and X and B are N-by-NRHS
  23 *  matrices.
  24 *
  25 *  The diagonal pivoting method is used to factor A as
  26 *     A = U * D * U**T,  if UPLO = 'U', or
  27 *     A = L * D * L**T,  if UPLO = 'L',
  28 *  where U (or L) is a product of permutation and unit upper (lower)
  29 *  triangular matrices, and D is symmetric and block diagonal with
  30 *  1-by-1 and 2-by-2 diagonal blocks.  The factored form of A is then
  31 *  used to solve the system of equations A * X = B.
  32 *
  33 *  Arguments
  34 *  =========
  35 *
  36 *  UPLO    (input) CHARACTER*1
  37 *          = 'U':  Upper triangle of A is stored;
  38 *          = 'L':  Lower triangle of A is stored.
  39 *
  40 *  N       (input) INTEGER
  41 *          The number of linear equations, i.e., the order of the
  42 *          matrix A.  N >= 0.
  43 *
  44 *  NRHS    (input) INTEGER
  45 *          The number of right hand sides, i.e., the number of columns
  46 *          of the matrix B.  NRHS >= 0.
  47 *
  48 *  A       (input/output) DOUBLE PRECISION array, dimension (LDA,N)
  49 *          On entry, the symmetric matrix A.  If UPLO = 'U', the leading
  50 *          N-by-N upper triangular part of A contains the upper
  51 *          triangular part of the matrix A, and the strictly lower
  52 *          triangular part of A is not referenced.  If UPLO = 'L', the
  53 *          leading N-by-N lower triangular part of A contains the lower
  54 *          triangular part of the matrix A, and the strictly upper
  55 *          triangular part of A is not referenced.
  56 *
  57 *          On exit, if INFO = 0, the block diagonal matrix D and the
  58 *          multipliers used to obtain the factor U or L from the
  59 *          factorization A = U*D*U**T or A = L*D*L**T as computed by
  60 *          DSYTRF.
  61 *
  62 *  LDA     (input) INTEGER
  63 *          The leading dimension of the array A.  LDA >= max(1,N).
  64 *
  65 *  IPIV    (output) INTEGER array, dimension (N)
  66 *          Details of the interchanges and the block structure of D, as
  67 *          determined by DSYTRF.  If IPIV(k) > 0, then rows and columns
  68 *          k and IPIV(k) were interchanged, and D(k,k) is a 1-by-1
  69 *          diagonal block.  If UPLO = 'U' and IPIV(k) = IPIV(k-1) < 0,
  70 *          then rows and columns k-1 and -IPIV(k) were interchanged and
  71 *          D(k-1:k,k-1:k) is a 2-by-2 diagonal block.  If UPLO = 'L' and
  72 *          IPIV(k) = IPIV(k+1) < 0, then rows and columns k+1 and
  73 *          -IPIV(k) were interchanged and D(k:k+1,k:k+1) is a 2-by-2
  74 *          diagonal block.
  75 *
  76 *  B       (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
  77 *          On entry, the N-by-NRHS right hand side matrix B.
  78 *          On exit, if INFO = 0, the N-by-NRHS solution matrix X.
  79 *
  80 *  LDB     (input) INTEGER
  81 *          The leading dimension of the array B.  LDB >= max(1,N).
  82 *
  83 *  WORK    (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,LWORK))
  84 *          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
  85 *
  86 *  LWORK   (input) INTEGER
  87 *          The length of WORK.  LWORK >= 1, and for best performance
  88 *          LWORK >= max(1,N*NB), where NB is the optimal blocksize for
  89 *          DSYTRF.
  90 *
  91 *          If LWORK = -1, then a workspace query is assumed; the routine
  92 *          only calculates the optimal size of the WORK array, returns
  93 *          this value as the first entry of the WORK array, and no error
  94 *          message related to LWORK is issued by XERBLA.
  95 *
  96 *  INFO    (output) INTEGER
  97 *          = 0: successful exit
  98 *          < 0: if INFO = -i, the i-th argument had an illegal value
  99 *          > 0: if INFO = i, D(i,i) is exactly zero.  The factorization
 100 *               has been completed, but the block diagonal matrix D is
 101 *               exactly singular, so the solution could not be computed.
 102 *
 103 *  =====================================================================
 104 *
 105 *     .. Local Scalars ..
 106       LOGICAL            LQUERY
 107       INTEGER            LWKOPT, NB
 108 *     ..
 109 *     .. External Functions ..
 110       LOGICAL            LSAME
 111       INTEGER            ILAENV
 112       EXTERNAL           LSAME, ILAENV
 113 *     ..
 114 *     .. External Subroutines ..
 115       EXTERNAL           DSYTRF, DSYTRS, XERBLA
 116 *     ..
 117 *     .. Intrinsic Functions ..
 118       INTRINSIC          MAX
 119 *     ..
 120 *     .. Executable Statements ..
 121 *
 122 *     Test the input parameters.
 123 *
 124       INFO = 0
 125       LQUERY = ( LWORK.EQ.-1 )
 126       IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
 127          INFO = -1
 128       ELSE IF( N.LT.0 ) THEN
 129          INFO = -2
 130       ELSE IF( NRHS.LT.0 ) THEN
 131          INFO = -3
 132       ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
 133          INFO = -5
 134       ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
 135          INFO = -8
 136       ELSE IF( LWORK.LT.1 .AND. .NOT.LQUERY ) THEN
 137          INFO = -10
 138       END IF
 139 *
 140       IF( INFO.EQ.0 ) THEN
 141          IF( N.EQ.0 ) THEN
 142             LWKOPT = 1
 143          ELSE
 144             NB = ILAENV( 1, 'DSYTRF', UPLO, N, -1, -1, -1 )
 145             LWKOPT = N*NB
 146          END IF
 147          WORK( 1 ) = LWKOPT
 148       END IF
 149 *
 150       IF( INFO.NE.0 ) THEN
 151          CALL XERBLA( 'DSYSV ', -INFO )
 152          RETURN
 153       ELSE IF( LQUERY ) THEN
 154          RETURN
 155       END IF
 156 *
 157 *     Compute the factorization A = U*D*U' or A = L*D*L'.
 158 *
 159       CALL DSYTRF( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO )
 160       IF( INFO.EQ.0 ) THEN
 161 *
 162 *        Solve the system A*X = B, overwriting B with X.
 163 *
 164          CALL DSYTRS( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO )
 165 *
 166       END IF
 167 *
 168       WORK( 1 ) = LWKOPT
 169 *
 170       RETURN
 171 *
 172 *     End of DSYSV
 173 *
 174       END