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.

zget08.f 6.2 kB

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