You can not select more than 25 topics Topics must start with a chinese character,a letter or number, can include dashes ('-') and can be up to 35 characters long.

cgecon.f 8.1 kB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292
  1. *> \brief \b CGECON
  2. *
  3. * =========== DOCUMENTATION ===========
  4. *
  5. * Online html documentation available at
  6. * http://www.netlib.org/lapack/explore-html/
  7. *
  8. *> \htmlonly
  9. *> Download CGECON + dependencies
  10. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cgecon.f">
  11. *> [TGZ]</a>
  12. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/cgecon.f">
  13. *> [ZIP]</a>
  14. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cgecon.f">
  15. *> [TXT]</a>
  16. *> \endhtmlonly
  17. *
  18. * Definition:
  19. * ===========
  20. *
  21. * SUBROUTINE CGECON( NORM, N, A, LDA, ANORM, RCOND, WORK, RWORK,
  22. * INFO )
  23. *
  24. * .. Scalar Arguments ..
  25. * CHARACTER NORM
  26. * INTEGER INFO, LDA, N
  27. * REAL ANORM, RCOND
  28. * ..
  29. * .. Array Arguments ..
  30. * REAL RWORK( * )
  31. * COMPLEX A( LDA, * ), WORK( * )
  32. * ..
  33. *
  34. *
  35. *> \par Purpose:
  36. * =============
  37. *>
  38. *> \verbatim
  39. *>
  40. *> CGECON estimates the reciprocal of the condition number of a general
  41. *> complex matrix A, in either the 1-norm or the infinity-norm, using
  42. *> the LU factorization computed by CGETRF.
  43. *>
  44. *> An estimate is obtained for norm(inv(A)), and the reciprocal of the
  45. *> condition number is computed as
  46. *> RCOND = 1 / ( norm(A) * norm(inv(A)) ).
  47. *> \endverbatim
  48. *
  49. * Arguments:
  50. * ==========
  51. *
  52. *> \param[in] NORM
  53. *> \verbatim
  54. *> NORM is CHARACTER*1
  55. *> Specifies whether the 1-norm condition number or the
  56. *> infinity-norm condition number is required:
  57. *> = '1' or 'O': 1-norm;
  58. *> = 'I': Infinity-norm.
  59. *> \endverbatim
  60. *>
  61. *> \param[in] N
  62. *> \verbatim
  63. *> N is INTEGER
  64. *> The order of the matrix A. N >= 0.
  65. *> \endverbatim
  66. *>
  67. *> \param[in] A
  68. *> \verbatim
  69. *> A is COMPLEX array, dimension (LDA,N)
  70. *> The factors L and U from the factorization A = P*L*U
  71. *> as computed by CGETRF.
  72. *> \endverbatim
  73. *>
  74. *> \param[in] LDA
  75. *> \verbatim
  76. *> LDA is INTEGER
  77. *> The leading dimension of the array A. LDA >= max(1,N).
  78. *> \endverbatim
  79. *>
  80. *> \param[in] ANORM
  81. *> \verbatim
  82. *> ANORM is REAL
  83. *> If NORM = '1' or 'O', the 1-norm of the original matrix A.
  84. *> If NORM = 'I', the infinity-norm of the original matrix A.
  85. *> \endverbatim
  86. *>
  87. *> \param[out] RCOND
  88. *> \verbatim
  89. *> RCOND is REAL
  90. *> The reciprocal of the condition number of the matrix A,
  91. *> computed as RCOND = 1/(norm(A) * norm(inv(A))).
  92. *> \endverbatim
  93. *>
  94. *> \param[out] WORK
  95. *> \verbatim
  96. *> WORK is COMPLEX array, dimension (2*N)
  97. *> \endverbatim
  98. *>
  99. *> \param[out] RWORK
  100. *> \verbatim
  101. *> RWORK is REAL array, dimension (2*N)
  102. *> \endverbatim
  103. *>
  104. *> \param[out] INFO
  105. *> \verbatim
  106. *> INFO is INTEGER
  107. *> = 0: successful exit
  108. *> < 0: if INFO = -i, the i-th argument had an illegal value.
  109. *> NaNs are illegal values for ANORM, and they propagate to
  110. *> the output parameter RCOND.
  111. *> Infinity is illegal for ANORM, and it propagates to the output
  112. *> parameter RCOND as 0.
  113. *> = 1: if RCOND = NaN, or
  114. *> RCOND = Inf, or
  115. *> the computed norm of the inverse of A is 0.
  116. *> In the latter, RCOND = 0 is returned.
  117. *> \endverbatim
  118. *
  119. * Authors:
  120. * ========
  121. *
  122. *> \author Univ. of Tennessee
  123. *> \author Univ. of California Berkeley
  124. *> \author Univ. of Colorado Denver
  125. *> \author NAG Ltd.
  126. *
  127. *> \ingroup gecon
  128. *
  129. * =====================================================================
  130. SUBROUTINE CGECON( NORM, N, A, LDA, ANORM, RCOND, WORK, RWORK,
  131. $ INFO )
  132. *
  133. * -- LAPACK computational routine --
  134. * -- LAPACK is a software package provided by Univ. of Tennessee, --
  135. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  136. *
  137. * .. Scalar Arguments ..
  138. CHARACTER NORM
  139. INTEGER INFO, LDA, N
  140. REAL ANORM, RCOND
  141. * ..
  142. * .. Array Arguments ..
  143. REAL RWORK( * )
  144. COMPLEX A( LDA, * ), WORK( * )
  145. * ..
  146. *
  147. * =====================================================================
  148. *
  149. * .. Parameters ..
  150. REAL ONE, ZERO
  151. PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
  152. * ..
  153. * .. Local Scalars ..
  154. LOGICAL ONENRM
  155. CHARACTER NORMIN
  156. INTEGER IX, KASE, KASE1
  157. REAL AINVNM, SCALE, SL, SMLNUM, SU, HUGEVAL
  158. COMPLEX ZDUM
  159. * ..
  160. * .. Local Arrays ..
  161. INTEGER ISAVE( 3 )
  162. * ..
  163. * .. External Functions ..
  164. LOGICAL LSAME, SISNAN
  165. INTEGER ICAMAX
  166. REAL SLAMCH
  167. EXTERNAL LSAME, ICAMAX, SLAMCH, SISNAN
  168. * ..
  169. * .. External Subroutines ..
  170. EXTERNAL CLACN2, CLATRS, CSRSCL, XERBLA
  171. * ..
  172. * .. Intrinsic Functions ..
  173. INTRINSIC ABS, AIMAG, MAX, REAL
  174. * ..
  175. * .. Statement Functions ..
  176. REAL CABS1
  177. * ..
  178. * .. Statement Function definitions ..
  179. CABS1( ZDUM ) = ABS( REAL( ZDUM ) ) + ABS( AIMAG( ZDUM ) )
  180. * ..
  181. * .. Executable Statements ..
  182. *
  183. HUGEVAL = SLAMCH( 'Overflow' )
  184. *
  185. * Test the input parameters.
  186. *
  187. INFO = 0
  188. ONENRM = NORM.EQ.'1' .OR. LSAME( NORM, 'O' )
  189. IF( .NOT.ONENRM .AND. .NOT.LSAME( NORM, 'I' ) ) THEN
  190. INFO = -1
  191. ELSE IF( N.LT.0 ) THEN
  192. INFO = -2
  193. ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
  194. INFO = -4
  195. ELSE IF( ANORM.LT.ZERO ) THEN
  196. INFO = -5
  197. END IF
  198. IF( INFO.NE.0 ) THEN
  199. CALL XERBLA( 'CGECON', -INFO )
  200. RETURN
  201. END IF
  202. *
  203. * Quick return if possible
  204. *
  205. RCOND = ZERO
  206. IF( N.EQ.0 ) THEN
  207. RCOND = ONE
  208. RETURN
  209. ELSE IF( ANORM.EQ.ZERO ) THEN
  210. RETURN
  211. ELSE IF( SISNAN( ANORM ) ) THEN
  212. RCOND = ANORM
  213. INFO = -5
  214. RETURN
  215. ELSE IF( ANORM.GT.HUGEVAL ) THEN
  216. INFO = -5
  217. RETURN
  218. END IF
  219. *
  220. SMLNUM = SLAMCH( 'Safe minimum' )
  221. *
  222. * Estimate the norm of inv(A).
  223. *
  224. AINVNM = ZERO
  225. NORMIN = 'N'
  226. IF( ONENRM ) THEN
  227. KASE1 = 1
  228. ELSE
  229. KASE1 = 2
  230. END IF
  231. KASE = 0
  232. 10 CONTINUE
  233. CALL CLACN2( N, WORK( N+1 ), WORK, AINVNM, KASE, ISAVE )
  234. IF( KASE.NE.0 ) THEN
  235. IF( KASE.EQ.KASE1 ) THEN
  236. *
  237. * Multiply by inv(L).
  238. *
  239. CALL CLATRS( 'Lower', 'No transpose', 'Unit', NORMIN, N, A,
  240. $ LDA, WORK, SL, RWORK, INFO )
  241. *
  242. * Multiply by inv(U).
  243. *
  244. CALL CLATRS( 'Upper', 'No transpose', 'Non-unit', NORMIN, N,
  245. $ A, LDA, WORK, SU, RWORK( N+1 ), INFO )
  246. ELSE
  247. *
  248. * Multiply by inv(U**H).
  249. *
  250. CALL CLATRS( 'Upper', 'Conjugate transpose', 'Non-unit',
  251. $ NORMIN, N, A, LDA, WORK, SU, RWORK( N+1 ),
  252. $ INFO )
  253. *
  254. * Multiply by inv(L**H).
  255. *
  256. CALL CLATRS( 'Lower', 'Conjugate transpose', 'Unit', NORMIN,
  257. $ N, A, LDA, WORK, SL, RWORK, INFO )
  258. END IF
  259. *
  260. * Divide X by 1/(SL*SU) if doing so will not cause overflow.
  261. *
  262. SCALE = SL*SU
  263. NORMIN = 'Y'
  264. IF( SCALE.NE.ONE ) THEN
  265. IX = ICAMAX( N, WORK, 1 )
  266. IF( SCALE.LT.CABS1( WORK( IX ) )*SMLNUM .OR. SCALE.EQ.ZERO )
  267. $ GO TO 20
  268. CALL CSRSCL( N, SCALE, WORK, 1 )
  269. END IF
  270. GO TO 10
  271. END IF
  272. *
  273. * Compute the estimate of the reciprocal condition number.
  274. *
  275. IF( AINVNM.NE.ZERO ) THEN
  276. RCOND = ( ONE / AINVNM ) / ANORM
  277. ELSE
  278. INFO = 1
  279. RETURN
  280. END IF
  281. *
  282. * Check for NaNs and Infs
  283. *
  284. IF( SISNAN( RCOND ) .OR. RCOND.GT.HUGEVAL )
  285. $ INFO = 1
  286. *
  287. 20 CONTINUE
  288. RETURN
  289. *
  290. * End of CGECON
  291. *
  292. END