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.

sgeequ.f 7.9 kB

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