Annotation of rpl/lapack/lapack/zhesv.f, revision 1.9

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

CVSweb interface <joel.bertrand@systella.fr>