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.

cget03.f 4.9 kB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191
  1. *> \brief \b CGET03
  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 CGET03( N, A, LDA, AINV, LDAINV, WORK, LDWORK, RWORK,
  12. * RCOND, RESID )
  13. *
  14. * .. Scalar Arguments ..
  15. * INTEGER LDA, LDAINV, LDWORK, N
  16. * REAL RCOND, RESID
  17. * ..
  18. * .. Array Arguments ..
  19. * REAL RWORK( * )
  20. * COMPLEX A( LDA, * ), AINV( LDAINV, * ),
  21. * $ WORK( LDWORK, * )
  22. * ..
  23. *
  24. *
  25. *> \par Purpose:
  26. * =============
  27. *>
  28. *> \verbatim
  29. *>
  30. *> CGET03 computes the residual for a general matrix times its inverse:
  31. *> norm( I - AINV*A ) / ( N * norm(A) * norm(AINV) * EPS ),
  32. *> where EPS is the machine epsilon.
  33. *> \endverbatim
  34. *
  35. * Arguments:
  36. * ==========
  37. *
  38. *> \param[in] N
  39. *> \verbatim
  40. *> N is INTEGER
  41. *> The number of rows and columns of the matrix A. N >= 0.
  42. *> \endverbatim
  43. *>
  44. *> \param[in] A
  45. *> \verbatim
  46. *> A is COMPLEX array, dimension (LDA,N)
  47. *> The original N x N matrix A.
  48. *> \endverbatim
  49. *>
  50. *> \param[in] LDA
  51. *> \verbatim
  52. *> LDA is INTEGER
  53. *> The leading dimension of the array A. LDA >= max(1,N).
  54. *> \endverbatim
  55. *>
  56. *> \param[in] AINV
  57. *> \verbatim
  58. *> AINV is COMPLEX array, dimension (LDAINV,N)
  59. *> The inverse of the matrix A.
  60. *> \endverbatim
  61. *>
  62. *> \param[in] LDAINV
  63. *> \verbatim
  64. *> LDAINV is INTEGER
  65. *> The leading dimension of the array AINV. LDAINV >= max(1,N).
  66. *> \endverbatim
  67. *>
  68. *> \param[out] WORK
  69. *> \verbatim
  70. *> WORK is COMPLEX array, dimension (LDWORK,N)
  71. *> \endverbatim
  72. *>
  73. *> \param[in] LDWORK
  74. *> \verbatim
  75. *> LDWORK is INTEGER
  76. *> The leading dimension of the array WORK. LDWORK >= max(1,N).
  77. *> \endverbatim
  78. *>
  79. *> \param[out] RWORK
  80. *> \verbatim
  81. *> RWORK is REAL array, dimension (N)
  82. *> \endverbatim
  83. *>
  84. *> \param[out] RCOND
  85. *> \verbatim
  86. *> RCOND is REAL
  87. *> The reciprocal of the condition number of A, computed as
  88. *> ( 1/norm(A) ) / norm(AINV).
  89. *> \endverbatim
  90. *>
  91. *> \param[out] RESID
  92. *> \verbatim
  93. *> RESID is REAL
  94. *> norm(I - AINV*A) / ( N * norm(A) * norm(AINV) * EPS )
  95. *> \endverbatim
  96. *
  97. * Authors:
  98. * ========
  99. *
  100. *> \author Univ. of Tennessee
  101. *> \author Univ. of California Berkeley
  102. *> \author Univ. of Colorado Denver
  103. *> \author NAG Ltd.
  104. *
  105. *> \date December 2016
  106. *
  107. *> \ingroup complex_lin
  108. *
  109. * =====================================================================
  110. SUBROUTINE CGET03( N, A, LDA, AINV, LDAINV, WORK, LDWORK, RWORK,
  111. $ RCOND, RESID )
  112. *
  113. * -- LAPACK test routine (version 3.7.0) --
  114. * -- LAPACK is a software package provided by Univ. of Tennessee, --
  115. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  116. * December 2016
  117. *
  118. * .. Scalar Arguments ..
  119. INTEGER LDA, LDAINV, LDWORK, N
  120. REAL RCOND, RESID
  121. * ..
  122. * .. Array Arguments ..
  123. REAL RWORK( * )
  124. COMPLEX A( LDA, * ), AINV( LDAINV, * ),
  125. $ WORK( LDWORK, * )
  126. * ..
  127. *
  128. * =====================================================================
  129. *
  130. * .. Parameters ..
  131. REAL ZERO, ONE
  132. PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
  133. COMPLEX CZERO, CONE
  134. PARAMETER ( CZERO = ( 0.0E+0, 0.0E+0 ),
  135. $ CONE = ( 1.0E+0, 0.0E+0 ) )
  136. * ..
  137. * .. Local Scalars ..
  138. INTEGER I
  139. REAL AINVNM, ANORM, EPS
  140. * ..
  141. * .. External Functions ..
  142. REAL CLANGE, SLAMCH
  143. EXTERNAL CLANGE, SLAMCH
  144. * ..
  145. * .. External Subroutines ..
  146. EXTERNAL CGEMM
  147. * ..
  148. * .. Intrinsic Functions ..
  149. INTRINSIC REAL
  150. * ..
  151. * .. Executable Statements ..
  152. *
  153. * Quick exit if N = 0.
  154. *
  155. IF( N.LE.0 ) THEN
  156. RCOND = ONE
  157. RESID = ZERO
  158. RETURN
  159. END IF
  160. *
  161. * Exit with RESID = 1/EPS if ANORM = 0 or AINVNM = 0.
  162. *
  163. EPS = SLAMCH( 'Epsilon' )
  164. ANORM = CLANGE( '1', N, N, A, LDA, RWORK )
  165. AINVNM = CLANGE( '1', N, N, AINV, LDAINV, RWORK )
  166. IF( ANORM.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN
  167. RCOND = ZERO
  168. RESID = ONE / EPS
  169. RETURN
  170. END IF
  171. RCOND = ( ONE/ANORM ) / AINVNM
  172. *
  173. * Compute I - A * AINV
  174. *
  175. CALL CGEMM( 'No transpose', 'No transpose', N, N, N, -CONE,
  176. $ AINV, LDAINV, A, LDA, CZERO, WORK, LDWORK )
  177. DO 10 I = 1, N
  178. WORK( I, I ) = CONE + WORK( I, I )
  179. 10 CONTINUE
  180. *
  181. * Compute norm(I - AINV*A) / (N * norm(A) * norm(AINV) * EPS)
  182. *
  183. RESID = CLANGE( '1', N, N, WORK, LDWORK, RWORK )
  184. *
  185. RESID = ( ( RESID*RCOND )/EPS ) / REAL( N )
  186. *
  187. RETURN
  188. *
  189. * End of CGET03
  190. *
  191. END