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.

zget02.f 6.1 kB

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