]>
Commit | Line | Data |
---|---|---|
fe4da5cc | 1 | * |
2 | * $Id$ | |
3 | * | |
4 | * $Log$ | |
5 | * Revision 1.1.1.1 1996/04/01 15:02:33 mclareni | |
6 | * Mathlib gen | |
7 | * | |
8 | * | |
9 | #include "gen/pilot.h" | |
10 | SUBROUTINE COMHES(NM,N,LOW,IGH,AR,AI,INT) | |
11 | INTEGER I,J,M,N,LA,NM,IGH,KP1,LOW,MM1,MP1 | |
12 | REAL AR(NM,N),AI(NM,N) | |
13 | REAL XR,XI,YR,YI | |
14 | INTEGER INT(IGH) | |
15 | COMPLEX X,Y | |
16 | REAL T1(2),T2(2) | |
17 | EQUIVALENCE (X,T1(1),XR),(T1(2),XI),(Y,T2(1),YR),(T2(2),YI) | |
18 | LA = IGH - 1 | |
19 | KP1 = LOW + 1 | |
20 | IF (LA .LT. KP1) GO TO 200 | |
21 | DO 180 M = KP1, LA | |
22 | MM1 = M - 1 | |
23 | XR = 0.0 | |
24 | XI = 0.0 | |
25 | I = M | |
26 | DO 100 J = M, IGH | |
27 | IF (ABS(AR(J,MM1)) + ABS(AI(J,MM1)) | |
28 | X .LE. ABS(XR) + ABS(XI)) GO TO 100 | |
29 | XR = AR(J,MM1) | |
30 | XI = AI(J,MM1) | |
31 | I = J | |
32 | 100 CONTINUE | |
33 | INT(M) = I | |
34 | IF (I .EQ. M) GO TO 130 | |
35 | DO 110 J = MM1, N | |
36 | YR = AR(I,J) | |
37 | AR(I,J) = AR(M,J) | |
38 | AR(M,J) = YR | |
39 | YI = AI(I,J) | |
40 | AI(I,J) = AI(M,J) | |
41 | AI(M,J) = YI | |
42 | 110 CONTINUE | |
43 | DO 120 J = 1, IGH | |
44 | YR = AR(J,I) | |
45 | AR(J,I) = AR(J,M) | |
46 | AR(J,M) = YR | |
47 | YI = AI(J,I) | |
48 | AI(J,I) = AI(J,M) | |
49 | AI(J,M) = YI | |
50 | 120 CONTINUE | |
51 | 130 IF (XR .EQ. 0.0 .AND. XI .EQ. 0.0) GO TO 180 | |
52 | MP1 = M + 1 | |
53 | DO 160 I = MP1, IGH | |
54 | YR = AR(I,MM1) | |
55 | YI = AI(I,MM1) | |
56 | IF (YR .EQ. 0.0 .AND. YI .EQ. 0.0) GO TO 160 | |
57 | Y = Y / X | |
58 | AR(I,MM1) = YR | |
59 | AI(I,MM1) = YI | |
60 | DO 140 J = M, N | |
61 | AR(I,J) = AR(I,J) - YR * AR(M,J) + YI * AI(M,J) | |
62 | AI(I,J) = AI(I,J) - YR * AI(M,J) - YI * AR(M,J) | |
63 | 140 CONTINUE | |
64 | DO 150 J = 1, IGH | |
65 | AR(J,M) = AR(J,M) + YR * AR(J,I) - YI * AI(J,I) | |
66 | AI(J,M) = AI(J,M) + YR * AI(J,I) + YI * AR(J,I) | |
67 | 150 CONTINUE | |
68 | 160 CONTINUE | |
69 | 180 CONTINUE | |
70 | 200 RETURN | |
71 | END |