comhes.f 4.7 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142
  1. *DECK COMHES
  2. SUBROUTINE COMHES (NM, N, LOW, IGH, AR, AI, INT)
  3. C***BEGIN PROLOGUE COMHES
  4. C***PURPOSE Reduce a complex general matrix to complex upper Hessenberg
  5. C form using stabilized elementary similarity
  6. C transformations.
  7. C***LIBRARY SLATEC (EISPACK)
  8. C***CATEGORY D4C1B2
  9. C***TYPE COMPLEX (ELMHES-S, COMHES-C)
  10. C***KEYWORDS EIGENVALUES, EIGENVECTORS, EISPACK
  11. C***AUTHOR Smith, B. T., et al.
  12. C***DESCRIPTION
  13. C
  14. C This subroutine is a translation of the ALGOL procedure COMHES,
  15. C NUM. MATH. 12, 349-368(1968) by Martin and Wilkinson.
  16. C HANDBOOK FOR AUTO. COMP., VOL.II-LINEAR ALGEBRA, 339-358(1971).
  17. C
  18. C Given a COMPLEX GENERAL matrix, this subroutine
  19. C reduces a submatrix situated in rows and columns
  20. C LOW through IGH to upper Hessenberg form by
  21. C stabilized elementary similarity transformations.
  22. C
  23. C On INPUT
  24. C
  25. C NM must be set to the row dimension of the two-dimensional
  26. C array parameters, AR and AI, as declared in the calling
  27. C program dimension statement. NM is an INTEGER variable.
  28. C
  29. C N is the order of the matrix A=(AR,AI). N is an INTEGER
  30. C variable. N must be less than or equal to NM.
  31. C
  32. C LOW and IGH are two INTEGER variables determined by the
  33. C balancing subroutine CBAL. If CBAL has not been used,
  34. C set LOW=1 and IGH equal to the order of the matrix, N.
  35. C
  36. C AR and AI contain the real and imaginary parts, respectively,
  37. C of the complex input matrix. AR and AI are two-dimensional
  38. C REAL arrays, dimensioned AR(NM,N) and AI(NM,N).
  39. C
  40. C On OUTPUT
  41. C
  42. C AR and AI contain the real and imaginary parts, respectively,
  43. C of the upper Hessenberg matrix. The multipliers which
  44. C were used in the reduction are stored in the remaining
  45. C triangles under the Hessenberg matrix.
  46. C
  47. C INT contains information on the rows and columns
  48. C interchanged in the reduction. Only elements LOW through
  49. C IGH are used. INT is a one-dimensional INTEGER array,
  50. C dimensioned INT(IGH).
  51. C
  52. C Calls CDIV for complex division.
  53. C
  54. C Questions and comments should be directed to B. S. Garbow,
  55. C APPLIED MATHEMATICS DIVISION, ARGONNE NATIONAL LABORATORY
  56. C ------------------------------------------------------------------
  57. C
  58. C***REFERENCES B. T. Smith, J. M. Boyle, J. J. Dongarra, B. S. Garbow,
  59. C Y. Ikebe, V. C. Klema and C. B. Moler, Matrix Eigen-
  60. C system Routines - EISPACK Guide, Springer-Verlag,
  61. C 1976.
  62. C***ROUTINES CALLED CDIV
  63. C***REVISION HISTORY (YYMMDD)
  64. C 760101 DATE WRITTEN
  65. C 890831 Modified array declarations. (WRB)
  66. C 890831 REVISION DATE from Version 3.2
  67. C 891214 Prologue converted to Version 4.0 format. (BAB)
  68. C 920501 Reformatted the REFERENCES section. (WRB)
  69. C***END PROLOGUE COMHES
  70. C
  71. INTEGER I,J,M,N,LA,NM,IGH,KP1,LOW,MM1,MP1
  72. REAL AR(NM,*),AI(NM,*)
  73. REAL XR,XI,YR,YI
  74. INTEGER INT(*)
  75. C
  76. C***FIRST EXECUTABLE STATEMENT COMHES
  77. LA = IGH - 1
  78. KP1 = LOW + 1
  79. IF (LA .LT. KP1) GO TO 200
  80. C
  81. DO 180 M = KP1, LA
  82. MM1 = M - 1
  83. XR = 0.0E0
  84. XI = 0.0E0
  85. I = M
  86. C
  87. DO 100 J = M, IGH
  88. IF (ABS(AR(J,MM1)) + ABS(AI(J,MM1))
  89. 1 .LE. ABS(XR) + ABS(XI)) GO TO 100
  90. XR = AR(J,MM1)
  91. XI = AI(J,MM1)
  92. I = J
  93. 100 CONTINUE
  94. C
  95. INT(M) = I
  96. IF (I .EQ. M) GO TO 130
  97. C .......... INTERCHANGE ROWS AND COLUMNS OF AR AND AI ..........
  98. DO 110 J = MM1, N
  99. YR = AR(I,J)
  100. AR(I,J) = AR(M,J)
  101. AR(M,J) = YR
  102. YI = AI(I,J)
  103. AI(I,J) = AI(M,J)
  104. AI(M,J) = YI
  105. 110 CONTINUE
  106. C
  107. DO 120 J = 1, IGH
  108. YR = AR(J,I)
  109. AR(J,I) = AR(J,M)
  110. AR(J,M) = YR
  111. YI = AI(J,I)
  112. AI(J,I) = AI(J,M)
  113. AI(J,M) = YI
  114. 120 CONTINUE
  115. C .......... END INTERCHANGE ..........
  116. 130 IF (XR .EQ. 0.0E0 .AND. XI .EQ. 0.0E0) GO TO 180
  117. MP1 = M + 1
  118. C
  119. DO 160 I = MP1, IGH
  120. YR = AR(I,MM1)
  121. YI = AI(I,MM1)
  122. IF (YR .EQ. 0.0E0 .AND. YI .EQ. 0.0E0) GO TO 160
  123. CALL CDIV(YR,YI,XR,XI,YR,YI)
  124. AR(I,MM1) = YR
  125. AI(I,MM1) = YI
  126. C
  127. DO 140 J = M, N
  128. AR(I,J) = AR(I,J) - YR * AR(M,J) + YI * AI(M,J)
  129. AI(I,J) = AI(I,J) - YR * AI(M,J) - YI * AR(M,J)
  130. 140 CONTINUE
  131. C
  132. DO 150 J = 1, IGH
  133. AR(J,M) = AR(J,M) + YR * AR(J,I) - YI * AI(J,I)
  134. AI(J,M) = AI(J,M) + YR * AI(J,I) + YI * AR(J,I)
  135. 150 CONTINUE
  136. C
  137. 160 CONTINUE
  138. C
  139. 180 CONTINUE
  140. C
  141. 200 RETURN
  142. END