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.

claqgb.f 7.1 kB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258
  1. *> \brief \b CLAQGB scales a general band matrix, using row and column scaling factors computed by sgbequ.
  2. *
  3. * =========== DOCUMENTATION ===========
  4. *
  5. * Online html documentation available at
  6. * http://www.netlib.org/lapack/explore-html/
  7. *
  8. *> \htmlonly
  9. *> Download CLAQGB + dependencies
  10. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/claqgb.f">
  11. *> [TGZ]</a>
  12. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/claqgb.f">
  13. *> [ZIP]</a>
  14. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/claqgb.f">
  15. *> [TXT]</a>
  16. *> \endhtmlonly
  17. *
  18. * Definition:
  19. * ===========
  20. *
  21. * SUBROUTINE CLAQGB( M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND,
  22. * AMAX, EQUED )
  23. *
  24. * .. Scalar Arguments ..
  25. * CHARACTER EQUED
  26. * INTEGER KL, KU, LDAB, M, N
  27. * REAL AMAX, COLCND, ROWCND
  28. * ..
  29. * .. Array Arguments ..
  30. * REAL C( * ), R( * )
  31. * COMPLEX AB( LDAB, * )
  32. * ..
  33. *
  34. *
  35. *> \par Purpose:
  36. * =============
  37. *>
  38. *> \verbatim
  39. *>
  40. *> CLAQGB equilibrates a general M by N band matrix A with KL
  41. *> subdiagonals and KU superdiagonals using the row and scaling factors
  42. *> in the vectors R and C.
  43. *> \endverbatim
  44. *
  45. * Arguments:
  46. * ==========
  47. *
  48. *> \param[in] M
  49. *> \verbatim
  50. *> M is INTEGER
  51. *> The number of rows of the matrix A. M >= 0.
  52. *> \endverbatim
  53. *>
  54. *> \param[in] N
  55. *> \verbatim
  56. *> N is INTEGER
  57. *> The number of columns of the matrix A. N >= 0.
  58. *> \endverbatim
  59. *>
  60. *> \param[in] KL
  61. *> \verbatim
  62. *> KL is INTEGER
  63. *> The number of subdiagonals within the band of A. KL >= 0.
  64. *> \endverbatim
  65. *>
  66. *> \param[in] KU
  67. *> \verbatim
  68. *> KU is INTEGER
  69. *> The number of superdiagonals within the band of A. KU >= 0.
  70. *> \endverbatim
  71. *>
  72. *> \param[in,out] AB
  73. *> \verbatim
  74. *> AB is COMPLEX array, dimension (LDAB,N)
  75. *> On entry, the matrix A in band storage, in rows 1 to KL+KU+1.
  76. *> The j-th column of A is stored in the j-th column of the
  77. *> array AB as follows:
  78. *> AB(ku+1+i-j,j) = A(i,j) for max(1,j-ku)<=i<=min(m,j+kl)
  79. *>
  80. *> On exit, the equilibrated matrix, in the same storage format
  81. *> as A. See EQUED for the form of the equilibrated matrix.
  82. *> \endverbatim
  83. *>
  84. *> \param[in] LDAB
  85. *> \verbatim
  86. *> LDAB is INTEGER
  87. *> The leading dimension of the array AB. LDA >= KL+KU+1.
  88. *> \endverbatim
  89. *>
  90. *> \param[in] R
  91. *> \verbatim
  92. *> R is REAL array, dimension (M)
  93. *> The row scale factors for A.
  94. *> \endverbatim
  95. *>
  96. *> \param[in] C
  97. *> \verbatim
  98. *> C is REAL array, dimension (N)
  99. *> The column scale factors for A.
  100. *> \endverbatim
  101. *>
  102. *> \param[in] ROWCND
  103. *> \verbatim
  104. *> ROWCND is REAL
  105. *> Ratio of the smallest R(i) to the largest R(i).
  106. *> \endverbatim
  107. *>
  108. *> \param[in] COLCND
  109. *> \verbatim
  110. *> COLCND is REAL
  111. *> Ratio of the smallest C(i) to the largest C(i).
  112. *> \endverbatim
  113. *>
  114. *> \param[in] AMAX
  115. *> \verbatim
  116. *> AMAX is REAL
  117. *> Absolute value of largest matrix entry.
  118. *> \endverbatim
  119. *>
  120. *> \param[out] EQUED
  121. *> \verbatim
  122. *> EQUED is CHARACTER*1
  123. *> Specifies the form of equilibration that was done.
  124. *> = 'N': No equilibration
  125. *> = 'R': Row equilibration, i.e., A has been premultiplied by
  126. *> diag(R).
  127. *> = 'C': Column equilibration, i.e., A has been postmultiplied
  128. *> by diag(C).
  129. *> = 'B': Both row and column equilibration, i.e., A has been
  130. *> replaced by diag(R) * A * diag(C).
  131. *> \endverbatim
  132. *
  133. *> \par Internal Parameters:
  134. * =========================
  135. *>
  136. *> \verbatim
  137. *> THRESH is a threshold value used to decide if row or column scaling
  138. *> should be done based on the ratio of the row or column scaling
  139. *> factors. If ROWCND < THRESH, row scaling is done, and if
  140. *> COLCND < THRESH, column scaling is done.
  141. *>
  142. *> LARGE and SMALL are threshold values used to decide if row scaling
  143. *> should be done based on the absolute size of the largest matrix
  144. *> element. If AMAX > LARGE or AMAX < SMALL, row scaling is done.
  145. *> \endverbatim
  146. *
  147. * Authors:
  148. * ========
  149. *
  150. *> \author Univ. of Tennessee
  151. *> \author Univ. of California Berkeley
  152. *> \author Univ. of Colorado Denver
  153. *> \author NAG Ltd.
  154. *
  155. *> \date December 2016
  156. *
  157. *> \ingroup complexGBauxiliary
  158. *
  159. * =====================================================================
  160. SUBROUTINE CLAQGB( M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND,
  161. $ AMAX, EQUED )
  162. *
  163. * -- LAPACK auxiliary routine (version 3.7.0) --
  164. * -- LAPACK is a software package provided by Univ. of Tennessee, --
  165. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  166. * December 2016
  167. *
  168. * .. Scalar Arguments ..
  169. CHARACTER EQUED
  170. INTEGER KL, KU, LDAB, M, N
  171. REAL AMAX, COLCND, ROWCND
  172. * ..
  173. * .. Array Arguments ..
  174. REAL C( * ), R( * )
  175. COMPLEX AB( LDAB, * )
  176. * ..
  177. *
  178. * =====================================================================
  179. *
  180. * .. Parameters ..
  181. REAL ONE, THRESH
  182. PARAMETER ( ONE = 1.0E+0, THRESH = 0.1E+0 )
  183. * ..
  184. * .. Local Scalars ..
  185. INTEGER I, J
  186. REAL CJ, LARGE, SMALL
  187. * ..
  188. * .. External Functions ..
  189. REAL SLAMCH
  190. EXTERNAL SLAMCH
  191. * ..
  192. * .. Intrinsic Functions ..
  193. INTRINSIC MAX, MIN
  194. * ..
  195. * .. Executable Statements ..
  196. *
  197. * Quick return if possible
  198. *
  199. IF( M.LE.0 .OR. N.LE.0 ) THEN
  200. EQUED = 'N'
  201. RETURN
  202. END IF
  203. *
  204. * Initialize LARGE and SMALL.
  205. *
  206. SMALL = SLAMCH( 'Safe minimum' ) / SLAMCH( 'Precision' )
  207. LARGE = ONE / SMALL
  208. *
  209. IF( ROWCND.GE.THRESH .AND. AMAX.GE.SMALL .AND. AMAX.LE.LARGE )
  210. $ THEN
  211. *
  212. * No row scaling
  213. *
  214. IF( COLCND.GE.THRESH ) THEN
  215. *
  216. * No column scaling
  217. *
  218. EQUED = 'N'
  219. ELSE
  220. *
  221. * Column scaling
  222. *
  223. DO 20 J = 1, N
  224. CJ = C( J )
  225. DO 10 I = MAX( 1, J-KU ), MIN( M, J+KL )
  226. AB( KU+1+I-J, J ) = CJ*AB( KU+1+I-J, J )
  227. 10 CONTINUE
  228. 20 CONTINUE
  229. EQUED = 'C'
  230. END IF
  231. ELSE IF( COLCND.GE.THRESH ) THEN
  232. *
  233. * Row scaling, no column scaling
  234. *
  235. DO 40 J = 1, N
  236. DO 30 I = MAX( 1, J-KU ), MIN( M, J+KL )
  237. AB( KU+1+I-J, J ) = R( I )*AB( KU+1+I-J, J )
  238. 30 CONTINUE
  239. 40 CONTINUE
  240. EQUED = 'R'
  241. ELSE
  242. *
  243. * Row and column scaling
  244. *
  245. DO 60 J = 1, N
  246. CJ = C( J )
  247. DO 50 I = MAX( 1, J-KU ), MIN( M, J+KL )
  248. AB( KU+1+I-J, J ) = CJ*R( I )*AB( KU+1+I-J, J )
  249. 50 CONTINUE
  250. 60 CONTINUE
  251. EQUED = 'B'
  252. END IF
  253. *
  254. RETURN
  255. *
  256. * End of CLAQGB
  257. *
  258. END