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.

ctpt06.f 5.2 kB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190
  1. *> \brief \b CTPT06
  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 CTPT06( RCOND, RCONDC, UPLO, DIAG, N, AP, RWORK, RAT )
  12. *
  13. * .. Scalar Arguments ..
  14. * CHARACTER DIAG, UPLO
  15. * INTEGER N
  16. * REAL RAT, RCOND, RCONDC
  17. * ..
  18. * .. Array Arguments ..
  19. * REAL RWORK( * )
  20. * COMPLEX AP( * )
  21. * ..
  22. *
  23. *
  24. *> \par Purpose:
  25. * =============
  26. *>
  27. *> \verbatim
  28. *>
  29. *> CTPT06 computes a test ratio comparing RCOND (the reciprocal
  30. *> condition number of the triangular matrix A) and RCONDC, the estimate
  31. *> computed by CTPCON. Information about the triangular matrix is used
  32. *> if one estimate is zero and the other is non-zero to decide if
  33. *> underflow in the estimate is justified.
  34. *> \endverbatim
  35. *
  36. * Arguments:
  37. * ==========
  38. *
  39. *> \param[in] RCOND
  40. *> \verbatim
  41. *> RCOND is REAL
  42. *> The estimate of the reciprocal condition number obtained by
  43. *> forming the explicit inverse of the matrix A and computing
  44. *> RCOND = 1/( norm(A) * norm(inv(A)) ).
  45. *> \endverbatim
  46. *>
  47. *> \param[in] RCONDC
  48. *> \verbatim
  49. *> RCONDC is REAL
  50. *> The estimate of the reciprocal condition number computed by
  51. *> CTPCON.
  52. *> \endverbatim
  53. *>
  54. *> \param[in] UPLO
  55. *> \verbatim
  56. *> UPLO is CHARACTER
  57. *> Specifies whether the matrix A is upper or lower triangular.
  58. *> = 'U': Upper triangular
  59. *> = 'L': Lower triangular
  60. *> \endverbatim
  61. *>
  62. *> \param[in] DIAG
  63. *> \verbatim
  64. *> DIAG is CHARACTER
  65. *> Specifies whether or not the matrix A is unit triangular.
  66. *> = 'N': Non-unit triangular
  67. *> = 'U': Unit triangular
  68. *> \endverbatim
  69. *>
  70. *> \param[in] N
  71. *> \verbatim
  72. *> N is INTEGER
  73. *> The order of the matrix A. N >= 0.
  74. *> \endverbatim
  75. *>
  76. *> \param[in] AP
  77. *> \verbatim
  78. *> AP is COMPLEX array, dimension (N*(N+1)/2)
  79. *> The upper or lower triangular matrix A, packed columnwise in
  80. *> a linear array. The j-th column of A is stored in the array
  81. *> AP as follows:
  82. *> if UPLO = 'U', AP((j-1)*j/2 + i) = A(i,j) for 1<=i<=j;
  83. *> if UPLO = 'L',
  84. *> AP((j-1)*(n-j) + j*(j+1)/2 + i-j) = A(i,j) for j<=i<=n.
  85. *> \endverbatim
  86. *>
  87. *> \param[out] RWORK
  88. *> \verbatim
  89. *> RWORK is REAL array, dimension (N)
  90. *> \endverbatim
  91. *>
  92. *> \param[out] RAT
  93. *> \verbatim
  94. *> RAT is REAL
  95. *> The test ratio. If both RCOND and RCONDC are nonzero,
  96. *> RAT = MAX( RCOND, RCONDC )/MIN( RCOND, RCONDC ) - 1.
  97. *> If RAT = 0, the two estimates are exactly the same.
  98. *> \endverbatim
  99. *
  100. * Authors:
  101. * ========
  102. *
  103. *> \author Univ. of Tennessee
  104. *> \author Univ. of California Berkeley
  105. *> \author Univ. of Colorado Denver
  106. *> \author NAG Ltd.
  107. *
  108. *> \date December 2016
  109. *
  110. *> \ingroup complex_lin
  111. *
  112. * =====================================================================
  113. SUBROUTINE CTPT06( RCOND, RCONDC, UPLO, DIAG, N, AP, RWORK, RAT )
  114. *
  115. * -- LAPACK test routine (version 3.7.0) --
  116. * -- LAPACK is a software package provided by Univ. of Tennessee, --
  117. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  118. * December 2016
  119. *
  120. * .. Scalar Arguments ..
  121. CHARACTER DIAG, UPLO
  122. INTEGER N
  123. REAL RAT, RCOND, RCONDC
  124. * ..
  125. * .. Array Arguments ..
  126. REAL RWORK( * )
  127. COMPLEX AP( * )
  128. * ..
  129. *
  130. * =====================================================================
  131. *
  132. * .. Parameters ..
  133. REAL ZERO, ONE
  134. PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
  135. * ..
  136. * .. Local Scalars ..
  137. REAL ANORM, BIGNUM, EPS, RMAX, RMIN
  138. * ..
  139. * .. External Functions ..
  140. REAL CLANTP, SLAMCH
  141. EXTERNAL CLANTP, SLAMCH
  142. * ..
  143. * .. Intrinsic Functions ..
  144. INTRINSIC MAX, MIN
  145. * ..
  146. * .. Executable Statements ..
  147. *
  148. EPS = SLAMCH( 'Epsilon' )
  149. RMAX = MAX( RCOND, RCONDC )
  150. RMIN = MIN( RCOND, RCONDC )
  151. *
  152. * Do the easy cases first.
  153. *
  154. IF( RMIN.LT.ZERO ) THEN
  155. *
  156. * Invalid value for RCOND or RCONDC, return 1/EPS.
  157. *
  158. RAT = ONE / EPS
  159. *
  160. ELSE IF( RMIN.GT.ZERO ) THEN
  161. *
  162. * Both estimates are positive, return RMAX/RMIN - 1.
  163. *
  164. RAT = RMAX / RMIN - ONE
  165. *
  166. ELSE IF( RMAX.EQ.ZERO ) THEN
  167. *
  168. * Both estimates zero.
  169. *
  170. RAT = ZERO
  171. *
  172. ELSE
  173. *
  174. * One estimate is zero, the other is non-zero. If the matrix is
  175. * ill-conditioned, return the nonzero estimate multiplied by
  176. * 1/EPS; if the matrix is badly scaled, return the nonzero
  177. * estimate multiplied by BIGNUM/TMAX, where TMAX is the maximum
  178. * element in absolute value in A.
  179. *
  180. BIGNUM = ONE / SLAMCH( 'Safe minimum' )
  181. ANORM = CLANTP( 'M', UPLO, DIAG, N, AP, RWORK )
  182. *
  183. RAT = RMAX*( MIN( BIGNUM / MAX( ONE, ANORM ), ONE / EPS ) )
  184. END IF
  185. *
  186. RETURN
  187. *
  188. * End of CTPT06
  189. *
  190. END