This commit was generated by cvs2svn to compensate for changes in r2,
[u/mrichter/AliRoot.git] / MINICERN / mathlib / gen / f / combak.F
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