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.

cgtt02.f 5.3 kB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204
  1. *> \brief \b CGTT02
  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 CGTT02( TRANS, N, NRHS, DL, D, DU, X, LDX, B, LDB,
  12. * RESID )
  13. *
  14. * .. Scalar Arguments ..
  15. * CHARACTER TRANS
  16. * INTEGER LDB, LDX, N, NRHS
  17. * REAL RESID
  18. * ..
  19. * .. Array Arguments ..
  20. * COMPLEX B( LDB, * ), D( * ), DL( * ), DU( * ),
  21. * $ X( LDX, * )
  22. * ..
  23. *
  24. *
  25. *> \par Purpose:
  26. * =============
  27. *>
  28. *> \verbatim
  29. *>
  30. *> CGTT02 computes the residual for the solution to a tridiagonal
  31. *> system of equations:
  32. *> RESID = norm(B - op(A)*X) / (norm(op(A)) * norm(X) * EPS),
  33. *> where EPS is the machine epsilon.
  34. *> \endverbatim
  35. *
  36. * Arguments:
  37. * ==========
  38. *
  39. *> \param[in] TRANS
  40. *> \verbatim
  41. *> TRANS is CHARACTER
  42. *> Specifies the form of the residual.
  43. *> = 'N': B - A * X (No transpose)
  44. *> = 'T': B - A**T * X (Transpose)
  45. *> = 'C': B - A**H * X (Conjugate transpose)
  46. *> \endverbatim
  47. *>
  48. *> \param[in] N
  49. *> \verbatim
  50. *> N is INTEGER
  51. *> The order of the matrix A. N >= 0.
  52. *> \endverbatim
  53. *>
  54. *> \param[in] NRHS
  55. *> \verbatim
  56. *> NRHS is INTEGER
  57. *> The number of right hand sides, i.e., the number of columns
  58. *> of the matrices B and X. NRHS >= 0.
  59. *> \endverbatim
  60. *>
  61. *> \param[in] DL
  62. *> \verbatim
  63. *> DL is COMPLEX array, dimension (N-1)
  64. *> The (n-1) sub-diagonal elements of A.
  65. *> \endverbatim
  66. *>
  67. *> \param[in] D
  68. *> \verbatim
  69. *> D is COMPLEX array, dimension (N)
  70. *> The diagonal elements of A.
  71. *> \endverbatim
  72. *>
  73. *> \param[in] DU
  74. *> \verbatim
  75. *> DU is COMPLEX array, dimension (N-1)
  76. *> The (n-1) super-diagonal elements of A.
  77. *> \endverbatim
  78. *>
  79. *> \param[in] X
  80. *> \verbatim
  81. *> X is COMPLEX array, dimension (LDX,NRHS)
  82. *> The computed solution vectors X.
  83. *> \endverbatim
  84. *>
  85. *> \param[in] LDX
  86. *> \verbatim
  87. *> LDX is INTEGER
  88. *> The leading dimension of the array X. LDX >= max(1,N).
  89. *> \endverbatim
  90. *>
  91. *> \param[in,out] B
  92. *> \verbatim
  93. *> B is COMPLEX array, dimension (LDB,NRHS)
  94. *> On entry, the right hand side vectors for the system of
  95. *> linear equations.
  96. *> On exit, B is overwritten with the difference B - op(A)*X.
  97. *> \endverbatim
  98. *>
  99. *> \param[in] LDB
  100. *> \verbatim
  101. *> LDB is INTEGER
  102. *> The leading dimension of the array B. LDB >= max(1,N).
  103. *> \endverbatim
  104. *>
  105. *> \param[out] RESID
  106. *> \verbatim
  107. *> RESID is REAL
  108. *> norm(B - op(A)*X) / (norm(op(A)) * norm(X) * EPS)
  109. *> \endverbatim
  110. *
  111. * Authors:
  112. * ========
  113. *
  114. *> \author Univ. of Tennessee
  115. *> \author Univ. of California Berkeley
  116. *> \author Univ. of Colorado Denver
  117. *> \author NAG Ltd.
  118. *
  119. *> \ingroup complex_lin
  120. *
  121. * =====================================================================
  122. SUBROUTINE CGTT02( TRANS, N, NRHS, DL, D, DU, X, LDX, B, LDB,
  123. $ RESID )
  124. *
  125. * -- LAPACK test routine --
  126. * -- LAPACK is a software package provided by Univ. of Tennessee, --
  127. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  128. *
  129. * .. Scalar Arguments ..
  130. CHARACTER TRANS
  131. INTEGER LDB, LDX, N, NRHS
  132. REAL RESID
  133. * ..
  134. * .. Array Arguments ..
  135. COMPLEX B( LDB, * ), D( * ), DL( * ), DU( * ),
  136. $ X( LDX, * )
  137. * ..
  138. *
  139. * =====================================================================
  140. *
  141. * .. Parameters ..
  142. REAL ONE, ZERO
  143. PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
  144. * ..
  145. * .. Local Scalars ..
  146. INTEGER J
  147. REAL ANORM, BNORM, EPS, XNORM
  148. * ..
  149. * .. External Functions ..
  150. LOGICAL LSAME
  151. REAL CLANGT, SCASUM, SLAMCH
  152. EXTERNAL LSAME, CLANGT, SCASUM, SLAMCH
  153. * ..
  154. * .. External Subroutines ..
  155. EXTERNAL CLAGTM
  156. * ..
  157. * .. Intrinsic Functions ..
  158. INTRINSIC MAX
  159. * ..
  160. * .. Executable Statements ..
  161. *
  162. * Quick exit if N = 0 or NRHS = 0
  163. *
  164. RESID = ZERO
  165. IF( N.LE.0 .OR. NRHS.EQ.0 )
  166. $ RETURN
  167. *
  168. * Compute the maximum over the number of right hand sides of
  169. * norm(B - op(A)*X) / ( norm(op(A)) * norm(X) * EPS ).
  170. *
  171. IF( LSAME( TRANS, 'N' ) ) THEN
  172. ANORM = CLANGT( '1', N, DL, D, DU )
  173. ELSE
  174. ANORM = CLANGT( 'I', N, DL, D, DU )
  175. END IF
  176. *
  177. * Exit with RESID = 1/EPS if ANORM = 0.
  178. *
  179. EPS = SLAMCH( 'Epsilon' )
  180. IF( ANORM.LE.ZERO ) THEN
  181. RESID = ONE / EPS
  182. RETURN
  183. END IF
  184. *
  185. * Compute B - op(A)*X and store in B.
  186. *
  187. CALL CLAGTM( TRANS, N, NRHS, -ONE, DL, D, DU, X, LDX, ONE, B,
  188. $ LDB )
  189. *
  190. DO 10 J = 1, NRHS
  191. BNORM = SCASUM( N, B( 1, J ), 1 )
  192. XNORM = SCASUM( N, X( 1, J ), 1 )
  193. IF( XNORM.LE.ZERO ) THEN
  194. RESID = ONE / EPS
  195. ELSE
  196. RESID = MAX( RESID, ( ( BNORM / ANORM ) / XNORM ) / EPS )
  197. END IF
  198. 10 CONTINUE
  199. *
  200. RETURN
  201. *
  202. * End of CGTT02
  203. *
  204. END