← Back to branch summary

~ubuntu-branches/ubuntu/wily/julia/wily

« back to all changes in this revision

Viewing changes to deps/openlibm/slatec/comhes.f

  • Committer: Package Import Robot
  • Author(s): Sébastien Villemot
  • Date: 2013-01-16 12:29:42 UTC
  • mfrom: (1.1.2)
  • Revision ID: package-import@ubuntu.com-20130116122942-x86e42akjq31repw
Tags: 0.0.0+20130107.gitd9656f41-1
* New upstream snashot
* No longer try to rebuild helpdb.jl.
   + debian/rules: remove helpdb.jl from build-arch rule
   + debian/control: move back python-sphinx to Build-Depends-Indep
* debian/copyright: reflect upstream changes
* Add Build-Conflicts on libatlas3-base (makes linalg tests fail)
* debian/rules: replace obsolete USE_DEBIAN makeflag by a list of
  USE_SYSTEM_* flags
* debian/rules: on non-x86 systems, use libm instead of openlibm
* dpkg-buildflags.patch: remove patch, applied upstream
* Refreshed other patches

Show diffs side-by-side

added added

removed removed

Lines of Context:
deps/openlibm/slatec/comhes.f
 
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