![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 C> \brief \b CPOTRF VARIANT: right looking block version of the algorithm, calling Level 3 BLAS. 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 CPOTRF ( UPLO, N, A, LDA, INFO ) 00012 * 00013 * .. Scalar Arguments .. 00014 * CHARACTER UPLO 00015 * INTEGER INFO, LDA, N 00016 * .. 00017 * .. Array Arguments .. 00018 * COMPLEX A( LDA, * ) 00019 * .. 00020 * 00021 * Purpose 00022 * ======= 00023 * 00024 C>\details \b Purpose: 00025 C>\verbatim 00026 C> 00027 C> CPOTRF computes the Cholesky factorization of a real Hermitian 00028 C> positive definite matrix A. 00029 C> 00030 C> The factorization has the form 00031 C> A = U**H * U, if UPLO = 'U', or 00032 C> A = L * L**H, if UPLO = 'L', 00033 C> where U is an upper triangular matrix and L is lower triangular. 00034 C> 00035 C> This is the right looking block version of the algorithm, calling Level 3 BLAS. 00036 C> 00037 C>\endverbatim 00038 * 00039 * Arguments: 00040 * ========== 00041 * 00042 C> \param[in] UPLO 00043 C> \verbatim 00044 C> UPLO is CHARACTER*1 00045 C> = 'U': Upper triangle of A is stored; 00046 C> = 'L': Lower triangle of A is stored. 00047 C> \endverbatim 00048 C> 00049 C> \param[in] N 00050 C> \verbatim 00051 C> N is INTEGER 00052 C> The order of the matrix A. N >= 0. 00053 C> \endverbatim 00054 C> 00055 C> \param[in,out] A 00056 C> \verbatim 00057 C> A is COMPLEX array, dimension (LDA,N) 00058 C> On entry, the Hermitian matrix A. If UPLO = 'U', the leading 00059 C> N-by-N upper triangular part of A contains the upper 00060 C> triangular part of the matrix A, and the strictly lower 00061 C> triangular part of A is not referenced. If UPLO = 'L', the 00062 C> leading N-by-N lower triangular part of A contains the lower 00063 C> triangular part of the matrix A, and the strictly upper 00064 C> triangular part of A is not referenced. 00065 C> \endverbatim 00066 C> \verbatim 00067 C> On exit, if INFO = 0, the factor U or L from the Cholesky 00068 C> factorization A = U**H*U or A = L*L**H. 00069 C> \endverbatim 00070 C> 00071 C> \param[in] LDA 00072 C> \verbatim 00073 C> LDA is INTEGER 00074 C> The leading dimension of the array A. LDA >= max(1,N). 00075 C> \endverbatim 00076 C> 00077 C> \param[out] INFO 00078 C> \verbatim 00079 C> INFO is INTEGER 00080 C> = 0: successful exit 00081 C> < 0: if INFO = -i, the i-th argument had an illegal value 00082 C> > 0: if INFO = i, the leading minor of order i is not 00083 C> positive definite, and the factorization could not be 00084 C> completed. 00085 C> \endverbatim 00086 C> 00087 * 00088 * Authors: 00089 * ======== 00090 * 00091 C> \author Univ. of Tennessee 00092 C> \author Univ. of California Berkeley 00093 C> \author Univ. of Colorado Denver 00094 C> \author NAG Ltd. 00095 * 00096 C> \date November 2011 00097 * 00098 C> \ingroup variantsPOcomputational 00099 * 00100 * ===================================================================== 00101 SUBROUTINE CPOTRF ( UPLO, N, A, LDA, INFO ) 00102 * 00103 * -- LAPACK computational routine (version 3.1) -- 00104 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00105 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00106 * November 2011 00107 * 00108 * .. Scalar Arguments .. 00109 CHARACTER UPLO 00110 INTEGER INFO, LDA, N 00111 * .. 00112 * .. Array Arguments .. 00113 COMPLEX A( LDA, * ) 00114 * .. 00115 * 00116 * ===================================================================== 00117 * 00118 * .. Parameters .. 00119 REAL ONE 00120 COMPLEX CONE 00121 PARAMETER ( ONE = 1.0E+0, CONE = ( 1.0E+0, 0.0E+0 ) ) 00122 * .. 00123 * .. Local Scalars .. 00124 LOGICAL UPPER 00125 INTEGER J, JB, NB 00126 * .. 00127 * .. External Functions .. 00128 LOGICAL LSAME 00129 INTEGER ILAENV 00130 EXTERNAL LSAME, ILAENV 00131 * .. 00132 * .. External Subroutines .. 00133 EXTERNAL CGEMM, CPOTF2, CHERK, CTRSM, XERBLA 00134 * .. 00135 * .. Intrinsic Functions .. 00136 INTRINSIC MAX, MIN 00137 * .. 00138 * .. Executable Statements .. 00139 * 00140 * Test the input parameters. 00141 * 00142 INFO = 0 00143 UPPER = LSAME( UPLO, 'U' ) 00144 IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN 00145 INFO = -1 00146 ELSE IF( N.LT.0 ) THEN 00147 INFO = -2 00148 ELSE IF( LDA.LT.MAX( 1, N ) ) THEN 00149 INFO = -4 00150 END IF 00151 IF( INFO.NE.0 ) THEN 00152 CALL XERBLA( 'CPOTRF', -INFO ) 00153 RETURN 00154 END IF 00155 * 00156 * Quick return if possible 00157 * 00158 IF( N.EQ.0 ) 00159 $ RETURN 00160 * 00161 * Determine the block size for this environment. 00162 * 00163 NB = ILAENV( 1, 'CPOTRF', UPLO, N, -1, -1, -1 ) 00164 IF( NB.LE.1 .OR. NB.GE.N ) THEN 00165 * 00166 * Use unblocked code. 00167 * 00168 CALL CPOTF2( UPLO, N, A, LDA, INFO ) 00169 ELSE 00170 * 00171 * Use blocked code. 00172 * 00173 IF( UPPER ) THEN 00174 * 00175 * Compute the Cholesky factorization A = U'*U. 00176 * 00177 DO 10 J = 1, N, NB 00178 * 00179 * Update and factorize the current diagonal block and test 00180 * for non-positive-definiteness. 00181 * 00182 JB = MIN( NB, N-J+1 ) 00183 00184 CALL CPOTF2( 'Upper', JB, A( J, J ), LDA, INFO ) 00185 00186 IF( INFO.NE.0 ) 00187 $ GO TO 30 00188 00189 IF( J+JB.LE.N ) THEN 00190 * 00191 * Updating the trailing submatrix. 00192 * 00193 CALL CTRSM( 'Left', 'Upper', 'Conjugate Transpose', 00194 $ 'Non-unit', JB, N-J-JB+1, CONE, A( J, J ), 00195 $ LDA, A( J, J+JB ), LDA ) 00196 CALL CHERK( 'Upper', 'Conjugate transpose', N-J-JB+1, 00197 $ JB, -ONE, A( J, J+JB ), LDA, 00198 $ ONE, A( J+JB, J+JB ), LDA ) 00199 END IF 00200 10 CONTINUE 00201 * 00202 ELSE 00203 * 00204 * Compute the Cholesky factorization A = L*L'. 00205 * 00206 DO 20 J = 1, N, NB 00207 * 00208 * Update and factorize the current diagonal block and test 00209 * for non-positive-definiteness. 00210 * 00211 JB = MIN( NB, N-J+1 ) 00212 00213 CALL CPOTF2( 'Lower', JB, A( J, J ), LDA, INFO ) 00214 00215 IF( INFO.NE.0 ) 00216 $ GO TO 30 00217 00218 IF( J+JB.LE.N ) THEN 00219 * 00220 * Updating the trailing submatrix. 00221 * 00222 CALL CTRSM( 'Right', 'Lower', 'Conjugate Transpose', 00223 $ 'Non-unit', N-J-JB+1, JB, CONE, A( J, J ), 00224 $ LDA, A( J+JB, J ), LDA ) 00225 00226 CALL CHERK( 'Lower', 'No Transpose', N-J-JB+1, JB, 00227 $ -ONE, A( J+JB, J ), LDA, 00228 $ ONE, A( J+JB, J+JB ), LDA ) 00229 END IF 00230 20 CONTINUE 00231 END IF 00232 END IF 00233 GO TO 40 00234 * 00235 30 CONTINUE 00236 INFO = INFO + J - 1 00237 * 00238 40 CONTINUE 00239 RETURN 00240 * 00241 * End of CPOTRF 00242 * 00243 END