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.

clctsx.f 2.8 kB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123
  1. *> \brief \b CLCTSX
  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 CLCTSX( ALPHA, BETA )
  12. *
  13. * .. Scalar Arguments ..
  14. * COMPLEX ALPHA, 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 CDRGSX, 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] ALPHA
  33. *> \verbatim
  34. *> ALPHA is COMPLEX
  35. *> \endverbatim
  36. *>
  37. *> \param[in] BETA
  38. *> \verbatim
  39. *> BETA is COMPLEX
  40. *>
  41. *> parameters to decide whether the pair (ALPHA, BETA) is
  42. *> selected.
  43. *> \endverbatim
  44. *
  45. * Authors:
  46. * ========
  47. *
  48. *> \author Univ. of Tennessee
  49. *> \author Univ. of California Berkeley
  50. *> \author Univ. of Colorado Denver
  51. *> \author NAG Ltd.
  52. *
  53. *> \date December 2016
  54. *
  55. *> \ingroup complex_eig
  56. *
  57. * =====================================================================
  58. LOGICAL FUNCTION CLCTSX( ALPHA, BETA )
  59. *
  60. * -- LAPACK test routine (version 3.7.0) --
  61. * -- LAPACK is a software package provided by Univ. of Tennessee, --
  62. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  63. * December 2016
  64. *
  65. * .. Scalar Arguments ..
  66. COMPLEX ALPHA, BETA
  67. * ..
  68. *
  69. * =====================================================================
  70. *
  71. * .. Parameters ..
  72. * REAL ZERO
  73. * PARAMETER ( ZERO = 0.0E+0 )
  74. * COMPLEX CZERO
  75. * PARAMETER ( CZERO = ( 0.0E+0, 0.0E+0 ) )
  76. * ..
  77. * .. Scalars in Common ..
  78. LOGICAL FS
  79. INTEGER I, M, MPLUSN, N
  80. * ..
  81. * .. Common blocks ..
  82. COMMON / MN / M, N, MPLUSN, I, FS
  83. * ..
  84. * .. Save statement ..
  85. SAVE
  86. * ..
  87. * .. Executable Statements ..
  88. *
  89. IF( FS ) THEN
  90. I = I + 1
  91. IF( I.LE.M ) THEN
  92. CLCTSX = .FALSE.
  93. ELSE
  94. CLCTSX = .TRUE.
  95. END IF
  96. IF( I.EQ.MPLUSN ) THEN
  97. FS = .FALSE.
  98. I = 0
  99. END IF
  100. ELSE
  101. I = I + 1
  102. IF( I.LE.N ) THEN
  103. CLCTSX = .TRUE.
  104. ELSE
  105. CLCTSX = .FALSE.
  106. END IF
  107. IF( I.EQ.MPLUSN ) THEN
  108. FS = .TRUE.
  109. I = 0
  110. END IF
  111. END IF
  112. *
  113. * IF( BETA.EQ.CZERO ) THEN
  114. * CLCTSX = ( REAL( ALPHA ).GT.ZERO )
  115. * ELSE
  116. * CLCTSX = ( REAL( ALPHA/BETA ).GT.ZERO )
  117. * END IF
  118. *
  119. RETURN
  120. *
  121. * End of CLCTSX
  122. *
  123. END