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.

dlctsx.f 2.8 kB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122
  1. *> \brief \b DLCTSX
  2. *
  3. * =========== DOCUMENTATION ===========
  4. *
  5. * Online html documentation available at
  6. * http://www.netlib.org/lapack/explore-html/
  7. *
  8. * Definition:
  9. * ===========
  10. *
  11. * LOGICAL FUNCTION DLCTSX( AR, AI, BETA )
  12. *
  13. * .. Scalar Arguments ..
  14. * DOUBLE PRECISION AI, AR, BETA
  15. * ..
  16. *
  17. *
  18. *> \par Purpose:
  19. * =============
  20. *>
  21. *> \verbatim
  22. *>
  23. *> This function is used to determine what eigenvalues will be
  24. *> selected. If this is part of the test driver DDRGSX, do not
  25. *> change the code UNLESS you are testing input examples and not
  26. *> using the built-in examples.
  27. *> \endverbatim
  28. *
  29. * Arguments:
  30. * ==========
  31. *
  32. *> \param[in] AR
  33. *> \verbatim
  34. *> AR is DOUBLE PRECISION
  35. *> The numerator of the real part of a complex eigenvalue
  36. *> (AR/BETA) + i*(AI/BETA).
  37. *> \endverbatim
  38. *>
  39. *> \param[in] AI
  40. *> \verbatim
  41. *> AI is DOUBLE PRECISION
  42. *> The numerator of the imaginary part of a complex eigenvalue
  43. *> (AR/BETA) + i*(AI).
  44. *> \endverbatim
  45. *>
  46. *> \param[in] BETA
  47. *> \verbatim
  48. *> BETA is DOUBLE PRECISION
  49. *> The denominator part of a complex eigenvalue
  50. *> (AR/BETA) + i*(AI/BETA).
  51. *> \endverbatim
  52. *
  53. * Authors:
  54. * ========
  55. *
  56. *> \author Univ. of Tennessee
  57. *> \author Univ. of California Berkeley
  58. *> \author Univ. of Colorado Denver
  59. *> \author NAG Ltd.
  60. *
  61. *> \ingroup double_eig
  62. *
  63. * =====================================================================
  64. LOGICAL FUNCTION DLCTSX( AR, AI, BETA )
  65. *
  66. * -- LAPACK test routine --
  67. * -- LAPACK is a software package provided by Univ. of Tennessee, --
  68. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  69. *
  70. * .. Scalar Arguments ..
  71. DOUBLE PRECISION AI, AR, BETA
  72. * ..
  73. *
  74. * =====================================================================
  75. *
  76. * .. Scalars in Common ..
  77. LOGICAL FS
  78. INTEGER I, M, MPLUSN, N
  79. * ..
  80. * .. Common blocks ..
  81. COMMON / MN / M, N, MPLUSN, I, FS
  82. * ..
  83. * .. Save statement ..
  84. SAVE
  85. * ..
  86. * .. Executable Statements ..
  87. *
  88. IF( FS ) THEN
  89. I = I + 1
  90. IF( I.LE.M ) THEN
  91. DLCTSX = .FALSE.
  92. ELSE
  93. DLCTSX = .TRUE.
  94. END IF
  95. IF( I.EQ.MPLUSN ) THEN
  96. FS = .FALSE.
  97. I = 0
  98. END IF
  99. ELSE
  100. I = I + 1
  101. IF( I.LE.N ) THEN
  102. DLCTSX = .TRUE.
  103. ELSE
  104. DLCTSX = .FALSE.
  105. END IF
  106. IF( I.EQ.MPLUSN ) THEN
  107. FS = .TRUE.
  108. I = 0
  109. END IF
  110. END IF
  111. *
  112. * IF( AR/BETA.GT.0.0 )THEN
  113. * DLCTSX = .TRUE.
  114. * ELSE
  115. * DLCTSX = .FALSE.
  116. * END IF
  117. *
  118. RETURN
  119. *
  120. * End of DLCTSX
  121. *
  122. END