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.8 kB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301
  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. *> \ingroup realGEcomputational
  135. *
  136. * =====================================================================
  137. SUBROUTINE SGEEQU( M, N, A, LDA, R, C, ROWCND, COLCND, AMAX,
  138. $ INFO )
  139. *
  140. * -- LAPACK computational routine --
  141. * -- LAPACK is a software package provided by Univ. of Tennessee, --
  142. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  143. *
  144. * .. Scalar Arguments ..
  145. INTEGER INFO, LDA, M, N
  146. REAL AMAX, COLCND, ROWCND
  147. * ..
  148. * .. Array Arguments ..
  149. REAL A( LDA, * ), C( * ), R( * )
  150. * ..
  151. *
  152. * =====================================================================
  153. *
  154. * .. Parameters ..
  155. REAL ONE, ZERO
  156. PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
  157. * ..
  158. * .. Local Scalars ..
  159. INTEGER I, J
  160. REAL BIGNUM, RCMAX, RCMIN, SMLNUM
  161. * ..
  162. * .. External Functions ..
  163. REAL SLAMCH
  164. EXTERNAL SLAMCH
  165. * ..
  166. * .. External Subroutines ..
  167. EXTERNAL XERBLA
  168. * ..
  169. * .. Intrinsic Functions ..
  170. INTRINSIC ABS, MAX, MIN
  171. * ..
  172. * .. Executable Statements ..
  173. *
  174. * Test the input parameters.
  175. *
  176. INFO = 0
  177. IF( M.LT.0 ) THEN
  178. INFO = -1
  179. ELSE IF( N.LT.0 ) THEN
  180. INFO = -2
  181. ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
  182. INFO = -4
  183. END IF
  184. IF( INFO.NE.0 ) THEN
  185. CALL XERBLA( 'SGEEQU', -INFO )
  186. RETURN
  187. END IF
  188. *
  189. * Quick return if possible
  190. *
  191. IF( M.EQ.0 .OR. N.EQ.0 ) THEN
  192. ROWCND = ONE
  193. COLCND = ONE
  194. AMAX = ZERO
  195. RETURN
  196. END IF
  197. *
  198. * Get machine constants.
  199. *
  200. SMLNUM = SLAMCH( 'S' )
  201. BIGNUM = ONE / SMLNUM
  202. *
  203. * Compute row scale factors.
  204. *
  205. DO 10 I = 1, M
  206. R( I ) = ZERO
  207. 10 CONTINUE
  208. *
  209. * Find the maximum element in each row.
  210. *
  211. DO 30 J = 1, N
  212. DO 20 I = 1, M
  213. R( I ) = MAX( R( I ), ABS( A( I, J ) ) )
  214. 20 CONTINUE
  215. 30 CONTINUE
  216. *
  217. * Find the maximum and minimum scale factors.
  218. *
  219. RCMIN = BIGNUM
  220. RCMAX = ZERO
  221. DO 40 I = 1, M
  222. RCMAX = MAX( RCMAX, R( I ) )
  223. RCMIN = MIN( RCMIN, R( I ) )
  224. 40 CONTINUE
  225. AMAX = RCMAX
  226. *
  227. IF( RCMIN.EQ.ZERO ) THEN
  228. *
  229. * Find the first zero scale factor and return an error code.
  230. *
  231. DO 50 I = 1, M
  232. IF( R( I ).EQ.ZERO ) THEN
  233. INFO = I
  234. RETURN
  235. END IF
  236. 50 CONTINUE
  237. ELSE
  238. *
  239. * Invert the scale factors.
  240. *
  241. DO 60 I = 1, M
  242. R( I ) = ONE / MIN( MAX( R( I ), SMLNUM ), BIGNUM )
  243. 60 CONTINUE
  244. *
  245. * Compute ROWCND = min(R(I)) / max(R(I))
  246. *
  247. ROWCND = MAX( RCMIN, SMLNUM ) / MIN( RCMAX, BIGNUM )
  248. END IF
  249. *
  250. * Compute column scale factors
  251. *
  252. DO 70 J = 1, N
  253. C( J ) = ZERO
  254. 70 CONTINUE
  255. *
  256. * Find the maximum element in each column,
  257. * assuming the row scaling computed above.
  258. *
  259. DO 90 J = 1, N
  260. DO 80 I = 1, M
  261. C( J ) = MAX( C( J ), ABS( A( I, J ) )*R( I ) )
  262. 80 CONTINUE
  263. 90 CONTINUE
  264. *
  265. * Find the maximum and minimum scale factors.
  266. *
  267. RCMIN = BIGNUM
  268. RCMAX = ZERO
  269. DO 100 J = 1, N
  270. RCMIN = MIN( RCMIN, C( J ) )
  271. RCMAX = MAX( RCMAX, C( J ) )
  272. 100 CONTINUE
  273. *
  274. IF( RCMIN.EQ.ZERO ) THEN
  275. *
  276. * Find the first zero scale factor and return an error code.
  277. *
  278. DO 110 J = 1, N
  279. IF( C( J ).EQ.ZERO ) THEN
  280. INFO = M + J
  281. RETURN
  282. END IF
  283. 110 CONTINUE
  284. ELSE
  285. *
  286. * Invert the scale factors.
  287. *
  288. DO 120 J = 1, N
  289. C( J ) = ONE / MIN( MAX( C( J ), SMLNUM ), BIGNUM )
  290. 120 CONTINUE
  291. *
  292. * Compute COLCND = min(C(J)) / max(C(J))
  293. *
  294. COLCND = MAX( RCMIN, SMLNUM ) / MIN( RCMAX, BIGNUM )
  295. END IF
  296. *
  297. RETURN
  298. *
  299. * End of SGEEQU
  300. *
  301. END