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.

zgbequ.f 9.0 kB

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