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.

ctbt02.f 6.9 kB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242
  1. *> \brief \b CTBT02
  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 CTBT02( UPLO, TRANS, DIAG, N, KD, NRHS, AB, LDAB, X,
  12. * LDX, B, LDB, WORK, RWORK, RESID )
  13. *
  14. * .. Scalar Arguments ..
  15. * CHARACTER DIAG, TRANS, UPLO
  16. * INTEGER KD, LDAB, LDB, LDX, N, NRHS
  17. * REAL RESID
  18. * ..
  19. * .. Array Arguments ..
  20. * REAL RWORK( * )
  21. * COMPLEX AB( LDAB, * ), B( LDB, * ), WORK( * ),
  22. * $ X( LDX, * )
  23. * ..
  24. *
  25. *
  26. *> \par Purpose:
  27. * =============
  28. *>
  29. *> \verbatim
  30. *>
  31. *> CTBT02 computes the residual for the computed solution to a
  32. *> triangular system of linear equations op(A)*X = B, when A is a
  33. *> triangular band matrix. The test ratio is the maximum over
  34. *> norm(b - op(A)*x) / ( ||op(A)||_1 * norm(x) * EPS ),
  35. *> where op(A) = A, A**T, or A**H, b is the column of B, x is the
  36. *> solution vector, and EPS is the machine epsilon.
  37. *> \endverbatim
  38. *
  39. * Arguments:
  40. * ==========
  41. *
  42. *> \param[in] UPLO
  43. *> \verbatim
  44. *> UPLO is CHARACTER*1
  45. *> Specifies whether the matrix A is upper or lower triangular.
  46. *> = 'U': Upper triangular
  47. *> = 'L': Lower triangular
  48. *> \endverbatim
  49. *>
  50. *> \param[in] TRANS
  51. *> \verbatim
  52. *> TRANS is CHARACTER*1
  53. *> Specifies the operation applied to A.
  54. *> = 'N': A * X = B (No transpose)
  55. *> = 'T': A**T * X = B (Transpose)
  56. *> = 'C': A**H * X = B (Conjugate transpose)
  57. *> \endverbatim
  58. *>
  59. *> \param[in] DIAG
  60. *> \verbatim
  61. *> DIAG is CHARACTER*1
  62. *> Specifies whether or not the matrix A is unit triangular.
  63. *> = 'N': Non-unit triangular
  64. *> = 'U': Unit triangular
  65. *> \endverbatim
  66. *>
  67. *> \param[in] N
  68. *> \verbatim
  69. *> N is INTEGER
  70. *> The order of the matrix A. N >= 0.
  71. *> \endverbatim
  72. *>
  73. *> \param[in] KD
  74. *> \verbatim
  75. *> KD is INTEGER
  76. *> The number of superdiagonals or subdiagonals of the
  77. *> triangular band matrix A. KD >= 0.
  78. *> \endverbatim
  79. *>
  80. *> \param[in] NRHS
  81. *> \verbatim
  82. *> NRHS is INTEGER
  83. *> The number of right hand sides, i.e., the number of columns
  84. *> of the matrices X and B. NRHS >= 0.
  85. *> \endverbatim
  86. *>
  87. *> \param[in] AB
  88. *> \verbatim
  89. *> AB is COMPLEX array, dimension (LDA,N)
  90. *> The upper or lower triangular band matrix A, stored in the
  91. *> first kd+1 rows of the array. The j-th column of A is stored
  92. *> in the j-th column of the array AB as follows:
  93. *> if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
  94. *> if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd).
  95. *> \endverbatim
  96. *>
  97. *> \param[in] LDAB
  98. *> \verbatim
  99. *> LDAB is INTEGER
  100. *> The leading dimension of the array AB. LDAB >= max(1,KD+1).
  101. *> \endverbatim
  102. *>
  103. *> \param[in] X
  104. *> \verbatim
  105. *> X is COMPLEX array, dimension (LDX,NRHS)
  106. *> The computed solution vectors for the system of linear
  107. *> equations.
  108. *> \endverbatim
  109. *>
  110. *> \param[in] LDX
  111. *> \verbatim
  112. *> LDX is INTEGER
  113. *> The leading dimension of the array X. LDX >= max(1,N).
  114. *> \endverbatim
  115. *>
  116. *> \param[in] B
  117. *> \verbatim
  118. *> B is COMPLEX array, dimension (LDB,NRHS)
  119. *> The right hand side vectors for the system of linear
  120. *> equations.
  121. *> \endverbatim
  122. *>
  123. *> \param[in] LDB
  124. *> \verbatim
  125. *> LDB is INTEGER
  126. *> The leading dimension of the array B. LDB >= max(1,N).
  127. *> \endverbatim
  128. *>
  129. *> \param[out] WORK
  130. *> \verbatim
  131. *> WORK is COMPLEX array, dimension (N)
  132. *> \endverbatim
  133. *>
  134. *> \param[out] RWORK
  135. *> \verbatim
  136. *> RWORK is REAL array, dimension (N)
  137. *> \endverbatim
  138. *>
  139. *> \param[out] RESID
  140. *> \verbatim
  141. *> RESID is REAL
  142. *> The maximum over the number of right hand sides of
  143. *> norm(op(A)*x - b) / ( norm(op(A)) * norm(x) * EPS ).
  144. *> \endverbatim
  145. *
  146. * Authors:
  147. * ========
  148. *
  149. *> \author Univ. of Tennessee
  150. *> \author Univ. of California Berkeley
  151. *> \author Univ. of Colorado Denver
  152. *> \author NAG Ltd.
  153. *
  154. *> \ingroup complex_lin
  155. *
  156. * =====================================================================
  157. SUBROUTINE CTBT02( UPLO, TRANS, DIAG, N, KD, NRHS, AB, LDAB, X,
  158. $ LDX, B, LDB, WORK, RWORK, RESID )
  159. *
  160. * -- LAPACK test routine --
  161. * -- LAPACK is a software package provided by Univ. of Tennessee, --
  162. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  163. *
  164. * .. Scalar Arguments ..
  165. CHARACTER DIAG, TRANS, UPLO
  166. INTEGER KD, LDAB, LDB, LDX, N, NRHS
  167. REAL RESID
  168. * ..
  169. * .. Array Arguments ..
  170. REAL RWORK( * )
  171. COMPLEX AB( LDAB, * ), B( LDB, * ), WORK( * ),
  172. $ X( LDX, * )
  173. * ..
  174. *
  175. * =====================================================================
  176. *
  177. * .. Parameters ..
  178. REAL ZERO, ONE
  179. PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
  180. * ..
  181. * .. Local Scalars ..
  182. INTEGER J
  183. REAL ANORM, BNORM, EPS, XNORM
  184. * ..
  185. * .. External Functions ..
  186. LOGICAL LSAME
  187. REAL CLANTB, SCASUM, SLAMCH
  188. EXTERNAL LSAME, CLANTB, SCASUM, SLAMCH
  189. * ..
  190. * .. External Subroutines ..
  191. EXTERNAL CAXPY, CCOPY, CTBMV
  192. * ..
  193. * .. Intrinsic Functions ..
  194. INTRINSIC CMPLX, MAX
  195. * ..
  196. * .. Executable Statements ..
  197. *
  198. * Quick exit if N = 0 or NRHS = 0
  199. *
  200. IF( N.LE.0 .OR. NRHS.LE.0 ) THEN
  201. RESID = ZERO
  202. RETURN
  203. END IF
  204. *
  205. * Compute the 1-norm of op(A).
  206. *
  207. IF( LSAME( TRANS, 'N' ) ) THEN
  208. ANORM = CLANTB( '1', UPLO, DIAG, N, KD, AB, LDAB, RWORK )
  209. ELSE
  210. ANORM = CLANTB( 'I', UPLO, DIAG, N, KD, AB, LDAB, RWORK )
  211. END IF
  212. *
  213. * Exit with RESID = 1/EPS if ANORM = 0.
  214. *
  215. EPS = SLAMCH( 'Epsilon' )
  216. IF( ANORM.LE.ZERO ) THEN
  217. RESID = ONE / EPS
  218. RETURN
  219. END IF
  220. *
  221. * Compute the maximum over the number of right hand sides of
  222. * norm(op(A)*x - b) / ( norm(op(A)) * norm(x) * EPS ).
  223. *
  224. RESID = ZERO
  225. DO 10 J = 1, NRHS
  226. CALL CCOPY( N, X( 1, J ), 1, WORK, 1 )
  227. CALL CTBMV( UPLO, TRANS, DIAG, N, KD, AB, LDAB, WORK, 1 )
  228. CALL CAXPY( N, CMPLX( -ONE ), B( 1, J ), 1, WORK, 1 )
  229. BNORM = SCASUM( N, WORK, 1 )
  230. XNORM = SCASUM( N, X( 1, J ), 1 )
  231. IF( XNORM.LE.ZERO ) THEN
  232. RESID = ONE / EPS
  233. ELSE
  234. RESID = MAX( RESID, ( ( BNORM / ANORM ) / XNORM ) / EPS )
  235. END IF
  236. 10 CONTINUE
  237. *
  238. RETURN
  239. *
  240. * End of CTBT02
  241. *
  242. END