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.

dsxt1.f 4.0 kB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161
  1. *> \brief \b DSXT1
  2. *
  3. * =========== DOCUMENTATION ===========
  4. *
  5. * Online html documentation available at
  6. * http://www.netlib.org/lapack/explore-html/
  7. *
  8. * Definition:
  9. * ===========
  10. *
  11. * DOUBLE PRECISION FUNCTION DSXT1( IJOB, D1, N1, D2, N2, ABSTOL,
  12. * ULP, UNFL )
  13. *
  14. * .. Scalar Arguments ..
  15. * INTEGER IJOB, N1, N2
  16. * DOUBLE PRECISION ABSTOL, ULP, UNFL
  17. * ..
  18. * .. Array Arguments ..
  19. * DOUBLE PRECISION D1( * ), D2( * )
  20. * ..
  21. *
  22. *
  23. *> \par Purpose:
  24. * =============
  25. *>
  26. *> \verbatim
  27. *>
  28. *> DSXT1 computes the difference between a set of eigenvalues.
  29. *> The result is returned as the function value.
  30. *>
  31. *> IJOB = 1: Computes max { min | D1(i)-D2(j) | }
  32. *> i j
  33. *>
  34. *> IJOB = 2: Computes max { min | D1(i)-D2(j) | /
  35. *> i j
  36. *> ( ABSTOL + |D1(i)|*ULP ) }
  37. *> \endverbatim
  38. *
  39. * Arguments:
  40. * ==========
  41. *
  42. *> \param[in] IJOB
  43. *> \verbatim
  44. *> IJOB is INTEGER
  45. *> Specifies the type of tests to be performed. (See above.)
  46. *> \endverbatim
  47. *>
  48. *> \param[in] D1
  49. *> \verbatim
  50. *> D1 is DOUBLE PRECISION array, dimension (N1)
  51. *> The first array. D1 should be in increasing order, i.e.,
  52. *> D1(j) <= D1(j+1).
  53. *> \endverbatim
  54. *>
  55. *> \param[in] N1
  56. *> \verbatim
  57. *> N1 is INTEGER
  58. *> The length of D1.
  59. *> \endverbatim
  60. *>
  61. *> \param[in] D2
  62. *> \verbatim
  63. *> D2 is DOUBLE PRECISION array, dimension (N2)
  64. *> The second array. D2 should be in increasing order, i.e.,
  65. *> D2(j) <= D2(j+1).
  66. *> \endverbatim
  67. *>
  68. *> \param[in] N2
  69. *> \verbatim
  70. *> N2 is INTEGER
  71. *> The length of D2.
  72. *> \endverbatim
  73. *>
  74. *> \param[in] ABSTOL
  75. *> \verbatim
  76. *> ABSTOL is DOUBLE PRECISION
  77. *> The absolute tolerance, used as a measure of the error.
  78. *> \endverbatim
  79. *>
  80. *> \param[in] ULP
  81. *> \verbatim
  82. *> ULP is DOUBLE PRECISION
  83. *> Machine precision.
  84. *> \endverbatim
  85. *>
  86. *> \param[in] UNFL
  87. *> \verbatim
  88. *> UNFL is DOUBLE PRECISION
  89. *> The smallest positive number whose reciprocal does not
  90. *> overflow.
  91. *> \endverbatim
  92. *
  93. * Authors:
  94. * ========
  95. *
  96. *> \author Univ. of Tennessee
  97. *> \author Univ. of California Berkeley
  98. *> \author Univ. of Colorado Denver
  99. *> \author NAG Ltd.
  100. *
  101. *> \ingroup double_eig
  102. *
  103. * =====================================================================
  104. DOUBLE PRECISION FUNCTION DSXT1( IJOB, D1, N1, D2, N2, ABSTOL,
  105. $ ULP, UNFL )
  106. *
  107. * -- LAPACK test routine --
  108. * -- LAPACK is a software package provided by Univ. of Tennessee, --
  109. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  110. *
  111. * .. Scalar Arguments ..
  112. INTEGER IJOB, N1, N2
  113. DOUBLE PRECISION ABSTOL, ULP, UNFL
  114. * ..
  115. * .. Array Arguments ..
  116. DOUBLE PRECISION D1( * ), D2( * )
  117. * ..
  118. *
  119. * =====================================================================
  120. *
  121. * .. Parameters ..
  122. DOUBLE PRECISION ZERO
  123. PARAMETER ( ZERO = 0.0D0 )
  124. * ..
  125. * .. Local Scalars ..
  126. INTEGER I, J
  127. DOUBLE PRECISION TEMP1, TEMP2
  128. * ..
  129. * .. Intrinsic Functions ..
  130. INTRINSIC ABS, MAX, MIN
  131. * ..
  132. * .. Executable Statements ..
  133. *
  134. TEMP1 = ZERO
  135. *
  136. J = 1
  137. DO 20 I = 1, N1
  138. 10 CONTINUE
  139. IF( D2( J ).LT.D1( I ) .AND. J.LT.N2 ) THEN
  140. J = J + 1
  141. GO TO 10
  142. END IF
  143. IF( J.EQ.1 ) THEN
  144. TEMP2 = ABS( D2( J )-D1( I ) )
  145. IF( IJOB.EQ.2 )
  146. $ TEMP2 = TEMP2 / MAX( UNFL, ABSTOL+ULP*ABS( D1( I ) ) )
  147. ELSE
  148. TEMP2 = MIN( ABS( D2( J )-D1( I ) ),
  149. $ ABS( D1( I )-D2( J-1 ) ) )
  150. IF( IJOB.EQ.2 )
  151. $ TEMP2 = TEMP2 / MAX( UNFL, ABSTOL+ULP*ABS( D1( I ) ) )
  152. END IF
  153. TEMP1 = MAX( TEMP1, TEMP2 )
  154. 20 CONTINUE
  155. *
  156. DSXT1 = TEMP1
  157. RETURN
  158. *
  159. * End of DSXT1
  160. *
  161. END