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.1 kB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164
  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. *> \date November 2011
  102. *
  103. *> \ingroup double_eig
  104. *
  105. * =====================================================================
  106. DOUBLE PRECISION FUNCTION DSXT1( IJOB, D1, N1, D2, N2, ABSTOL,
  107. $ ULP, UNFL )
  108. *
  109. * -- LAPACK test routine (version 3.4.0) --
  110. * -- LAPACK is a software package provided by Univ. of Tennessee, --
  111. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  112. * November 2011
  113. *
  114. * .. Scalar Arguments ..
  115. INTEGER IJOB, N1, N2
  116. DOUBLE PRECISION ABSTOL, ULP, UNFL
  117. * ..
  118. * .. Array Arguments ..
  119. DOUBLE PRECISION D1( * ), D2( * )
  120. * ..
  121. *
  122. * =====================================================================
  123. *
  124. * .. Parameters ..
  125. DOUBLE PRECISION ZERO
  126. PARAMETER ( ZERO = 0.0D0 )
  127. * ..
  128. * .. Local Scalars ..
  129. INTEGER I, J
  130. DOUBLE PRECISION TEMP1, TEMP2
  131. * ..
  132. * .. Intrinsic Functions ..
  133. INTRINSIC ABS, MAX, MIN
  134. * ..
  135. * .. Executable Statements ..
  136. *
  137. TEMP1 = ZERO
  138. *
  139. J = 1
  140. DO 20 I = 1, N1
  141. 10 CONTINUE
  142. IF( D2( J ).LT.D1( I ) .AND. J.LT.N2 ) THEN
  143. J = J + 1
  144. GO TO 10
  145. END IF
  146. IF( J.EQ.1 ) THEN
  147. TEMP2 = ABS( D2( J )-D1( I ) )
  148. IF( IJOB.EQ.2 )
  149. $ TEMP2 = TEMP2 / MAX( UNFL, ABSTOL+ULP*ABS( D1( I ) ) )
  150. ELSE
  151. TEMP2 = MIN( ABS( D2( J )-D1( I ) ),
  152. $ ABS( D1( I )-D2( J-1 ) ) )
  153. IF( IJOB.EQ.2 )
  154. $ TEMP2 = TEMP2 / MAX( UNFL, ABSTOL+ULP*ABS( D1( I ) ) )
  155. END IF
  156. TEMP1 = MAX( TEMP1, TEMP2 )
  157. 20 CONTINUE
  158. *
  159. DSXT1 = TEMP1
  160. RETURN
  161. *
  162. * End of DSXT1
  163. *
  164. END