SRC/cpotrs.f

   1 *> \brief \b CPOTRS
   2 *
   3 *  =========== DOCUMENTATION ===========
   4 *
   5 * Online html documentation available at
   6 *            http://www.netlib.org/lapack/explore-html/
   7 *
   8 *> \htmlonly
   9 *> Download CPOTRS + dependencies
  10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cpotrs.f">
  11 *> [TGZ]</a>
  12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/cpotrs.f">
  13 *> [ZIP]</a>
  14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cpotrs.f">
  15 *> [TXT]</a>
  16 *> \endhtmlonly
  17 *
  18 *  Definition:
  19 *  ===========
  20 *
  21 *       SUBROUTINE CPOTRS( UPLO, N, NRHS, A, LDA, B, LDB, INFO )
  22 *
  23 *       .. Scalar Arguments ..
  24 *       CHARACTER          UPLO
  25 *       INTEGER            INFO, LDA, LDB, N, NRHS
  26 *       ..
  27 *       .. Array Arguments ..
  28 *       COMPLEX            A( LDA, * ), B( LDB, * )
  29 *       ..
  30 *
  31 *
  32 *> \par Purpose:
  33 *  =============
  34 *>
  35 *> \verbatim
  36 *>
  37 *> CPOTRS solves a system of linear equations A*X = B with a Hermitian
  38 *> positive definite matrix A using the Cholesky factorization
  39 *> A = U**H*U or A = L*L**H computed by CPOTRF.
  40 *> \endverbatim
  41 *
  42 *  Arguments:
  43 *  ==========
  44 *
  45 *> \param[in] UPLO
  46 *> \verbatim
  47 *>          UPLO is CHARACTER*1
  48 *>          = 'U':  Upper triangle of A is stored;
  49 *>          = 'L':  Lower triangle of A is stored.
  50 *> \endverbatim
  51 *>
  52 *> \param[in] N
  53 *> \verbatim
  54 *>          N is INTEGER
  55 *>          The order of the matrix A.  N >= 0.
  56 *> \endverbatim
  57 *>
  58 *> \param[in] NRHS
  59 *> \verbatim
  60 *>          NRHS is INTEGER
  61 *>          The number of right hand sides, i.e., the number of columns
  62 *>          of the matrix B.  NRHS >= 0.
  63 *> \endverbatim
  64 *>
  65 *> \param[in] A
  66 *> \verbatim
  67 *>          A is COMPLEX array, dimension (LDA,N)
  68 *>          The triangular factor U or L from the Cholesky factorization
  69 *>          A = U**H*U or A = L*L**H, as computed by CPOTRF.
  70 *> \endverbatim
  71 *>
  72 *> \param[in] LDA
  73 *> \verbatim
  74 *>          LDA is INTEGER
  75 *>          The leading dimension of the array A.  LDA >= max(1,N).
  76 *> \endverbatim
  77 *>
  78 *> \param[in,out] B
  79 *> \verbatim
  80 *>          B is COMPLEX array, dimension (LDB,NRHS)
  81 *>          On entry, the right hand side matrix B.
  82 *>          On exit, the solution matrix X.
  83 *> \endverbatim
  84 *>
  85 *> \param[in] LDB
  86 *> \verbatim
  87 *>          LDB is INTEGER
  88 *>          The leading dimension of the array B.  LDB >= max(1,N).
  89 *> \endverbatim
  90 *>
  91 *> \param[out] INFO
  92 *> \verbatim
  93 *>          INFO is INTEGER
  94 *>          = 0:  successful exit
  95 *>          < 0:  if INFO = -i, the i-th argument had an illegal value
  96 *> \endverbatim
  97 *
  98 *  Authors:
  99 *  ========
 100 *
 101 *> \author Univ. of Tennessee
 102 *> \author Univ. of California Berkeley
 103 *> \author Univ. of Colorado Denver
 104 *> \author NAG Ltd.
 105 *
 106 *> \date November 2011
 107 *
 108 *> \ingroup complexPOcomputational
 109 *
 110 *  =====================================================================
 111       SUBROUTINE CPOTRS( UPLO, N, NRHS, A, LDA, B, LDB, INFO )
 112 *
 113 *  -- LAPACK computational routine (version 3.4.0) --
 114 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 115 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
 116 *     November 2011
 117 *
 118 *     .. Scalar Arguments ..
 119       CHARACTER          UPLO
 120       INTEGER            INFO, LDA, LDB, N, NRHS
 121 *     ..
 122 *     .. Array Arguments ..
 123       COMPLEX            A( LDA, * ), B( LDB, * )
 124 *     ..
 125 *
 126 *  =====================================================================
 127 *
 128 *     .. Parameters ..
 129       COMPLEX            ONE
 130       PARAMETER          ( ONE = ( 1.0E+0, 0.0E+0 ) )
 131 *     ..
 132 *     .. Local Scalars ..
 133       LOGICAL            UPPER
 134 *     ..
 135 *     .. External Functions ..
 136       LOGICAL            LSAME
 137       EXTERNAL           LSAME
 138 *     ..
 139 *     .. External Subroutines ..
 140       EXTERNAL           CTRSM, XERBLA
 141 *     ..
 142 *     .. Intrinsic Functions ..
 143       INTRINSIC          MAX
 144 *     ..
 145 *     .. Executable Statements ..
 146 *
 147 *     Test the input parameters.
 148 *
 149       INFO = 0
 150       UPPER = LSAME( UPLO, 'U' )
 151       IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
 152          INFO = -1
 153       ELSE IF( N.LT.0 ) THEN
 154          INFO = -2
 155       ELSE IF( NRHS.LT.0 ) THEN
 156          INFO = -3
 157       ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
 158          INFO = -5
 159       ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
 160          INFO = -7
 161       END IF
 162       IF( INFO.NE.0 ) THEN
 163          CALL XERBLA( 'CPOTRS', -INFO )
 164          RETURN
 165       END IF
 166 *
 167 *     Quick return if possible
 168 *
 169       IF( N.EQ.0 .OR. NRHS.EQ.0 )
 170      $   RETURN
 171 *
 172       IF( UPPER ) THEN
 173 *
 174 *        Solve A*X = B where A = U**H *U.
 175 *
 176 *        Solve U**H *X = B, overwriting B with X.
 177 *
 178          CALL CTRSM( 'Left', 'Upper', 'Conjugate transpose', 'Non-unit',
 179      $               N, NRHS, ONE, A, LDA, B, LDB )
 180 *
 181 *        Solve U*X = B, overwriting B with X.
 182 *
 183          CALL CTRSM( 'Left', 'Upper', 'No transpose', 'Non-unit', N,
 184      $               NRHS, ONE, A, LDA, B, LDB )
 185       ELSE
 186 *
 187 *        Solve A*X = B where A = L*L**H.
 188 *
 189 *        Solve L*X = B, overwriting B with X.
 190 *
 191          CALL CTRSM( 'Left', 'Lower', 'No transpose', 'Non-unit', N,
 192      $               NRHS, ONE, A, LDA, B, LDB )
 193 *
 194 *        Solve L**H *X = B, overwriting B with X.
 195 *
 196          CALL CTRSM( 'Left', 'Lower', 'Conjugate transpose', 'Non-unit',
 197      $               N, NRHS, ONE, A, LDA, B, LDB )
 198       END IF
 199 *
 200       RETURN
 201 *
 202 *     End of CPOTRS
 203 *
 204       END