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.

cgbt02.f 6.2 kB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234
  1. *> \brief \b CGBT02
  2. *
  3. * =========== DOCUMENTATION ===========
  4. *
  5. * Online html documentation available at
  6. * http://www.netlib.org/lapack/explore-html/
  7. *
  8. * Definition:
  9. * ===========
  10. *
  11. * SUBROUTINE CGBT02( TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B,
  12. * LDB, RESID )
  13. *
  14. * .. Scalar Arguments ..
  15. * CHARACTER TRANS
  16. * INTEGER KL, KU, LDA, LDB, LDX, M, N, NRHS
  17. * REAL RESID
  18. * ..
  19. * .. Array Arguments ..
  20. * COMPLEX A( LDA, * ), B( LDB, * ), X( LDX, * )
  21. * ..
  22. *
  23. *
  24. *> \par Purpose:
  25. * =============
  26. *>
  27. *> \verbatim
  28. *>
  29. *> CGBT02 computes the residual for a solution of a banded system of
  30. *> equations A*x = b or A'*x = b:
  31. *> RESID = norm( B - A*X ) / ( norm(A) * norm(X) * EPS).
  32. *> where EPS is the machine precision.
  33. *> \endverbatim
  34. *
  35. * Arguments:
  36. * ==========
  37. *
  38. *> \param[in] TRANS
  39. *> \verbatim
  40. *> TRANS is CHARACTER*1
  41. *> Specifies the form of the system of equations:
  42. *> = 'N': A *x = b
  43. *> = 'T': A'*x = b, where A' is the transpose of A
  44. *> = 'C': A'*x = b, where A' is the transpose of A
  45. *> \endverbatim
  46. *>
  47. *> \param[in] M
  48. *> \verbatim
  49. *> M is INTEGER
  50. *> The number of rows of the matrix A. M >= 0.
  51. *> \endverbatim
  52. *>
  53. *> \param[in] N
  54. *> \verbatim
  55. *> N is INTEGER
  56. *> The number of columns of the matrix A. N >= 0.
  57. *> \endverbatim
  58. *>
  59. *> \param[in] KL
  60. *> \verbatim
  61. *> KL is INTEGER
  62. *> The number of subdiagonals within the band of A. KL >= 0.
  63. *> \endverbatim
  64. *>
  65. *> \param[in] KU
  66. *> \verbatim
  67. *> KU is INTEGER
  68. *> The number of superdiagonals within the band of A. KU >= 0.
  69. *> \endverbatim
  70. *>
  71. *> \param[in] NRHS
  72. *> \verbatim
  73. *> NRHS is INTEGER
  74. *> The number of columns of B. NRHS >= 0.
  75. *> \endverbatim
  76. *>
  77. *> \param[in] A
  78. *> \verbatim
  79. *> A is COMPLEX array, dimension (LDA,N)
  80. *> The original matrix A in band storage, stored in rows 1 to
  81. *> KL+KU+1.
  82. *> \endverbatim
  83. *>
  84. *> \param[in] LDA
  85. *> \verbatim
  86. *> LDA is INTEGER
  87. *> The leading dimension of the array A. LDA >= max(1,KL+KU+1).
  88. *> \endverbatim
  89. *>
  90. *> \param[in] X
  91. *> \verbatim
  92. *> X is COMPLEX array, dimension (LDX,NRHS)
  93. *> The computed solution vectors for the system of linear
  94. *> equations.
  95. *> \endverbatim
  96. *>
  97. *> \param[in] LDX
  98. *> \verbatim
  99. *> LDX is INTEGER
  100. *> The leading dimension of the array X. If TRANS = 'N',
  101. *> LDX >= max(1,N); if TRANS = 'T' or 'C', LDX >= max(1,M).
  102. *> \endverbatim
  103. *>
  104. *> \param[in,out] B
  105. *> \verbatim
  106. *> B is COMPLEX array, dimension (LDB,NRHS)
  107. *> On entry, the right hand side vectors for the system of
  108. *> linear equations.
  109. *> On exit, B is overwritten with the difference B - A*X.
  110. *> \endverbatim
  111. *>
  112. *> \param[in] LDB
  113. *> \verbatim
  114. *> LDB is INTEGER
  115. *> The leading dimension of the array B. IF TRANS = 'N',
  116. *> LDB >= max(1,M); if TRANS = 'T' or 'C', LDB >= max(1,N).
  117. *> \endverbatim
  118. *>
  119. *> \param[out] RESID
  120. *> \verbatim
  121. *> RESID is REAL
  122. *> The maximum over the number of right hand sides of
  123. *> norm(B - A*X) / ( norm(A) * norm(X) * EPS ).
  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 December 2016
  135. *
  136. *> \ingroup complex_lin
  137. *
  138. * =====================================================================
  139. SUBROUTINE CGBT02( TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B,
  140. $ LDB, RESID )
  141. *
  142. * -- LAPACK test routine (version 3.7.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. * December 2016
  146. *
  147. * .. Scalar Arguments ..
  148. CHARACTER TRANS
  149. INTEGER KL, KU, LDA, LDB, LDX, M, N, NRHS
  150. REAL RESID
  151. * ..
  152. * .. Array Arguments ..
  153. COMPLEX A( LDA, * ), B( LDB, * ), X( LDX, * )
  154. * ..
  155. *
  156. * =====================================================================
  157. *
  158. * .. Parameters ..
  159. REAL ZERO, ONE
  160. PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
  161. COMPLEX CONE
  162. PARAMETER ( CONE = ( 1.0E+0, 0.0E+0 ) )
  163. * ..
  164. * .. Local Scalars ..
  165. INTEGER I1, I2, J, KD, N1
  166. REAL ANORM, BNORM, EPS, XNORM
  167. * ..
  168. * .. External Functions ..
  169. LOGICAL LSAME
  170. REAL SCASUM, SLAMCH
  171. EXTERNAL LSAME, SCASUM, SLAMCH
  172. * ..
  173. * .. External Subroutines ..
  174. EXTERNAL CGBMV
  175. * ..
  176. * .. Intrinsic Functions ..
  177. INTRINSIC MAX, MIN
  178. * ..
  179. * .. Executable Statements ..
  180. *
  181. * Quick return if N = 0 pr NRHS = 0
  182. *
  183. IF( M.LE.0 .OR. N.LE.0 .OR. NRHS.LE.0 ) THEN
  184. RESID = ZERO
  185. RETURN
  186. END IF
  187. *
  188. * Exit with RESID = 1/EPS if ANORM = 0.
  189. *
  190. EPS = SLAMCH( 'Epsilon' )
  191. KD = KU + 1
  192. ANORM = ZERO
  193. DO 10 J = 1, N
  194. I1 = MAX( KD+1-J, 1 )
  195. I2 = MIN( KD+M-J, KL+KD )
  196. ANORM = MAX( ANORM, SCASUM( I2-I1+1, A( I1, J ), 1 ) )
  197. 10 CONTINUE
  198. IF( ANORM.LE.ZERO ) THEN
  199. RESID = ONE / EPS
  200. RETURN
  201. END IF
  202. *
  203. IF( LSAME( TRANS, 'T' ) .OR. LSAME( TRANS, 'C' ) ) THEN
  204. N1 = N
  205. ELSE
  206. N1 = M
  207. END IF
  208. *
  209. * Compute B - A*X (or B - A'*X )
  210. *
  211. DO 20 J = 1, NRHS
  212. CALL CGBMV( TRANS, M, N, KL, KU, -CONE, A, LDA, X( 1, J ), 1,
  213. $ CONE, B( 1, J ), 1 )
  214. 20 CONTINUE
  215. *
  216. * Compute the maximum over the number of right hand sides of
  217. * norm(B - A*X) / ( norm(A) * norm(X) * EPS ).
  218. *
  219. RESID = ZERO
  220. DO 30 J = 1, NRHS
  221. BNORM = SCASUM( N1, B( 1, J ), 1 )
  222. XNORM = SCASUM( N1, X( 1, J ), 1 )
  223. IF( XNORM.LE.ZERO ) THEN
  224. RESID = ONE / EPS
  225. ELSE
  226. RESID = MAX( RESID, ( ( BNORM/ANORM )/XNORM )/EPS )
  227. END IF
  228. 30 CONTINUE
  229. *
  230. RETURN
  231. *
  232. * End of CGBT02
  233. *
  234. END