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.

zgeequ.f 8.3 kB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313
  1. *> \brief \b ZGEEQU
  2. *
  3. * =========== DOCUMENTATION ===========
  4. *
  5. * Online html documentation available at
  6. * http://www.netlib.org/lapack/explore-html/
  7. *
  8. *> \htmlonly
  9. *> Download ZGEEQU + dependencies
  10. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zgeequ.f">
  11. *> [TGZ]</a>
  12. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zgeequ.f">
  13. *> [ZIP]</a>
  14. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zgeequ.f">
  15. *> [TXT]</a>
  16. *> \endhtmlonly
  17. *
  18. * Definition:
  19. * ===========
  20. *
  21. * SUBROUTINE ZGEEQU( M, N, A, LDA, R, C, ROWCND, COLCND, AMAX,
  22. * INFO )
  23. *
  24. * .. Scalar Arguments ..
  25. * INTEGER INFO, LDA, M, N
  26. * DOUBLE PRECISION AMAX, COLCND, ROWCND
  27. * ..
  28. * .. Array Arguments ..
  29. * DOUBLE PRECISION C( * ), R( * )
  30. * COMPLEX*16 A( LDA, * )
  31. * ..
  32. *
  33. *
  34. *> \par Purpose:
  35. * =============
  36. *>
  37. *> \verbatim
  38. *>
  39. *> ZGEEQU computes row and column scalings intended to equilibrate an
  40. *> M-by-N matrix A and reduce its condition number. R returns the row
  41. *> scale factors and C the column scale factors, chosen to try to make
  42. *> the largest element in each row and column of the matrix B with
  43. *> elements B(i,j)=R(i)*A(i,j)*C(j) have absolute value 1.
  44. *>
  45. *> R(i) and C(j) are restricted to be between SMLNUM = smallest safe
  46. *> number and BIGNUM = largest safe number. Use of these scaling
  47. *> factors is not guaranteed to reduce the condition number of A but
  48. *> works well in practice.
  49. *> \endverbatim
  50. *
  51. * Arguments:
  52. * ==========
  53. *
  54. *> \param[in] M
  55. *> \verbatim
  56. *> M is INTEGER
  57. *> The number of rows of the matrix A. M >= 0.
  58. *> \endverbatim
  59. *>
  60. *> \param[in] N
  61. *> \verbatim
  62. *> N is INTEGER
  63. *> The number of columns of the matrix A. N >= 0.
  64. *> \endverbatim
  65. *>
  66. *> \param[in] A
  67. *> \verbatim
  68. *> A is COMPLEX*16 array, dimension (LDA,N)
  69. *> The M-by-N matrix whose equilibration factors are
  70. *> to be computed.
  71. *> \endverbatim
  72. *>
  73. *> \param[in] LDA
  74. *> \verbatim
  75. *> LDA is INTEGER
  76. *> The leading dimension of the array A. LDA >= max(1,M).
  77. *> \endverbatim
  78. *>
  79. *> \param[out] R
  80. *> \verbatim
  81. *> R is DOUBLE PRECISION array, dimension (M)
  82. *> If INFO = 0 or INFO > M, R contains the row scale factors
  83. *> for A.
  84. *> \endverbatim
  85. *>
  86. *> \param[out] C
  87. *> \verbatim
  88. *> C is DOUBLE PRECISION array, dimension (N)
  89. *> If INFO = 0, C contains the column scale factors for A.
  90. *> \endverbatim
  91. *>
  92. *> \param[out] ROWCND
  93. *> \verbatim
  94. *> ROWCND is DOUBLE PRECISION
  95. *> If INFO = 0 or INFO > M, ROWCND contains the ratio of the
  96. *> smallest R(i) to the largest R(i). If ROWCND >= 0.1 and
  97. *> AMAX is neither too large nor too small, it is not worth
  98. *> scaling by R.
  99. *> \endverbatim
  100. *>
  101. *> \param[out] COLCND
  102. *> \verbatim
  103. *> COLCND is DOUBLE PRECISION
  104. *> If INFO = 0, COLCND contains the ratio of the smallest
  105. *> C(i) to the largest C(i). If COLCND >= 0.1, it is not
  106. *> worth scaling by C.
  107. *> \endverbatim
  108. *>
  109. *> \param[out] AMAX
  110. *> \verbatim
  111. *> AMAX is DOUBLE PRECISION
  112. *> Absolute value of largest matrix element. If AMAX is very
  113. *> close to overflow or very close to underflow, the matrix
  114. *> should be scaled.
  115. *> \endverbatim
  116. *>
  117. *> \param[out] INFO
  118. *> \verbatim
  119. *> INFO is INTEGER
  120. *> = 0: successful exit
  121. *> < 0: if INFO = -i, the i-th argument had an illegal value
  122. *> > 0: if INFO = i, and i is
  123. *> <= M: the i-th row of A is exactly zero
  124. *> > M: the (i-M)-th column of A is exactly zero
  125. *> \endverbatim
  126. *
  127. * Authors:
  128. * ========
  129. *
  130. *> \author Univ. of Tennessee
  131. *> \author Univ. of California Berkeley
  132. *> \author Univ. of Colorado Denver
  133. *> \author NAG Ltd.
  134. *
  135. *> \date December 2016
  136. *
  137. *> \ingroup complex16GEcomputational
  138. *
  139. * =====================================================================
  140. SUBROUTINE ZGEEQU( M, N, A, LDA, R, C, ROWCND, COLCND, AMAX,
  141. $ INFO )
  142. *
  143. * -- LAPACK computational routine (version 3.7.0) --
  144. * -- LAPACK is a software package provided by Univ. of Tennessee, --
  145. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  146. * December 2016
  147. *
  148. * .. Scalar Arguments ..
  149. INTEGER INFO, LDA, M, N
  150. DOUBLE PRECISION AMAX, COLCND, ROWCND
  151. * ..
  152. * .. Array Arguments ..
  153. DOUBLE PRECISION C( * ), R( * )
  154. COMPLEX*16 A( LDA, * )
  155. * ..
  156. *
  157. * =====================================================================
  158. *
  159. * .. Parameters ..
  160. DOUBLE PRECISION ONE, ZERO
  161. PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
  162. * ..
  163. * .. Local Scalars ..
  164. INTEGER I, J
  165. DOUBLE PRECISION BIGNUM, RCMAX, RCMIN, SMLNUM
  166. COMPLEX*16 ZDUM
  167. * ..
  168. * .. External Functions ..
  169. DOUBLE PRECISION DLAMCH
  170. EXTERNAL DLAMCH
  171. * ..
  172. * .. External Subroutines ..
  173. EXTERNAL XERBLA
  174. * ..
  175. * .. Intrinsic Functions ..
  176. INTRINSIC ABS, DBLE, DIMAG, MAX, MIN
  177. * ..
  178. * .. Statement Functions ..
  179. DOUBLE PRECISION CABS1
  180. * ..
  181. * .. Statement Function definitions ..
  182. CABS1( ZDUM ) = ABS( DBLE( ZDUM ) ) + ABS( DIMAG( ZDUM ) )
  183. * ..
  184. * .. Executable Statements ..
  185. *
  186. * Test the input parameters.
  187. *
  188. INFO = 0
  189. IF( M.LT.0 ) THEN
  190. INFO = -1
  191. ELSE IF( N.LT.0 ) THEN
  192. INFO = -2
  193. ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
  194. INFO = -4
  195. END IF
  196. IF( INFO.NE.0 ) THEN
  197. CALL XERBLA( 'ZGEEQU', -INFO )
  198. RETURN
  199. END IF
  200. *
  201. * Quick return if possible
  202. *
  203. IF( M.EQ.0 .OR. N.EQ.0 ) THEN
  204. ROWCND = ONE
  205. COLCND = ONE
  206. AMAX = ZERO
  207. RETURN
  208. END IF
  209. *
  210. * Get machine constants.
  211. *
  212. SMLNUM = DLAMCH( 'S' )
  213. BIGNUM = ONE / SMLNUM
  214. *
  215. * Compute row scale factors.
  216. *
  217. DO 10 I = 1, M
  218. R( I ) = ZERO
  219. 10 CONTINUE
  220. *
  221. * Find the maximum element in each row.
  222. *
  223. DO 30 J = 1, N
  224. DO 20 I = 1, M
  225. R( I ) = MAX( R( I ), CABS1( A( I, J ) ) )
  226. 20 CONTINUE
  227. 30 CONTINUE
  228. *
  229. * Find the maximum and minimum scale factors.
  230. *
  231. RCMIN = BIGNUM
  232. RCMAX = ZERO
  233. DO 40 I = 1, M
  234. RCMAX = MAX( RCMAX, R( I ) )
  235. RCMIN = MIN( RCMIN, R( I ) )
  236. 40 CONTINUE
  237. AMAX = RCMAX
  238. *
  239. IF( RCMIN.EQ.ZERO ) THEN
  240. *
  241. * Find the first zero scale factor and return an error code.
  242. *
  243. DO 50 I = 1, M
  244. IF( R( I ).EQ.ZERO ) THEN
  245. INFO = I
  246. RETURN
  247. END IF
  248. 50 CONTINUE
  249. ELSE
  250. *
  251. * Invert the scale factors.
  252. *
  253. DO 60 I = 1, M
  254. R( I ) = ONE / MIN( MAX( R( I ), SMLNUM ), BIGNUM )
  255. 60 CONTINUE
  256. *
  257. * Compute ROWCND = min(R(I)) / max(R(I))
  258. *
  259. ROWCND = MAX( RCMIN, SMLNUM ) / MIN( RCMAX, BIGNUM )
  260. END IF
  261. *
  262. * Compute column scale factors
  263. *
  264. DO 70 J = 1, N
  265. C( J ) = ZERO
  266. 70 CONTINUE
  267. *
  268. * Find the maximum element in each column,
  269. * assuming the row scaling computed above.
  270. *
  271. DO 90 J = 1, N
  272. DO 80 I = 1, M
  273. C( J ) = MAX( C( J ), CABS1( A( I, J ) )*R( I ) )
  274. 80 CONTINUE
  275. 90 CONTINUE
  276. *
  277. * Find the maximum and minimum scale factors.
  278. *
  279. RCMIN = BIGNUM
  280. RCMAX = ZERO
  281. DO 100 J = 1, N
  282. RCMIN = MIN( RCMIN, C( J ) )
  283. RCMAX = MAX( RCMAX, C( J ) )
  284. 100 CONTINUE
  285. *
  286. IF( RCMIN.EQ.ZERO ) THEN
  287. *
  288. * Find the first zero scale factor and return an error code.
  289. *
  290. DO 110 J = 1, N
  291. IF( C( J ).EQ.ZERO ) THEN
  292. INFO = M + J
  293. RETURN
  294. END IF
  295. 110 CONTINUE
  296. ELSE
  297. *
  298. * Invert the scale factors.
  299. *
  300. DO 120 J = 1, N
  301. C( J ) = ONE / MIN( MAX( C( J ), SMLNUM ), BIGNUM )
  302. 120 CONTINUE
  303. *
  304. * Compute COLCND = min(C(J)) / max(C(J))
  305. *
  306. COLCND = MAX( RCMIN, SMLNUM ) / MIN( RCMAX, BIGNUM )
  307. END IF
  308. *
  309. RETURN
  310. *
  311. * End of ZGEEQU
  312. *
  313. END