| 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 COMBAK(NM,LOW,IGH,AR,AI,INT,M,ZR,ZI) |
| 11 | INTEGER I,J,M,LA,MM,MP,NM,IGH,KP1,LOW,MP1 |
| 12 | REAL AR(NM,IGH),AI(NM,IGH),ZR(NM,M),ZI(NM,M) |
| 13 | REAL XR,XI |
| 14 | INTEGER INT(IGH) |
| 15 | LA = IGH - 1 |
| 16 | KP1 = LOW + 1 |
| 17 | IF (LA .LT. KP1) GO TO 200 |
| 18 | DO 140 MM = KP1, LA |
| 19 | MP = LOW + IGH - MM |
| 20 | MP1 = MP + 1 |
| 21 | DO 110 I = MP1, IGH |
| 22 | XR = AR(I,MP-1) |
| 23 | XI = AI(I,MP-1) |
| 24 | IF (XR .EQ. 0.0 .AND. XI .EQ. 0.0) GO TO 110 |
| 25 | DO 100 J = 1, M |
| 26 | ZR(I,J) = ZR(I,J) + XR * ZR(MP,J) - XI * ZI(MP,J) |
| 27 | ZI(I,J) = ZI(I,J) + XR * ZI(MP,J) + XI * ZR(MP,J) |
| 28 | 100 CONTINUE |
| 29 | 110 CONTINUE |
| 30 | I = INT(MP) |
| 31 | IF (I .EQ. MP) GO TO 140 |
| 32 | DO 130 J = 1, M |
| 33 | XR = ZR(I,J) |
| 34 | ZR(I,J) = ZR(MP,J) |
| 35 | ZR(MP,J) = XR |
| 36 | XI = ZI(I,J) |
| 37 | ZI(I,J) = ZI(MP,J) |
| 38 | ZI(MP,J) = XI |
| 39 | 130 CONTINUE |
| 40 | 140 CONTINUE |
| 41 | 200 RETURN |
| 42 | END |
git://git.uio.no / u / mrichter / AliRoot.git / blame