[u/mrichter/AliRoot.git] / MINICERN / mathlib / gen / f / cbabk2.F

*
* $Id$
*
* $Log$
* Revision 1.1.1.1  1996/04/01 15:02:33  mclareni
* Mathlib gen
*
*
#include "gen/pilot.h"
      SUBROUTINE CBABK2(NM,N,LOW,IGH,SCALE,M,ZR,ZI)
      INTEGER I,J,K,M,N,II,NM,IGH,LOW
      REAL SCALE(N),ZR(NM,M),ZI(NM,M)
      REAL S
      IF (IGH .EQ. LOW) GO TO 120
      DO 110 I = LOW, IGH
         S = SCALE(I)
         DO 100 J = 1, M
            ZR(I,J) = ZR(I,J) * S
            ZI(I,J) = ZI(I,J) * S
  100    CONTINUE
  110 CONTINUE
  120 DO 140 II = 1, N
         I = II
         IF (I .GE. LOW .AND. I .LE. IGH) GO TO 140
         IF (I .LT. LOW) I = LOW - II
         K = SCALE(I)
         IF (K .EQ. I) GO TO 140
         DO 130 J = 1, M
            S = ZR(I,J)
            ZR(I,J) = ZR(K,J)
            ZR(K,J) = S
            S = ZI(I,J)
            ZI(I,J) = ZI(K,J)
            ZI(K,J) = S
  130    CONTINUE
  140 CONTINUE
      RETURN
      END
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 CBABK2(NM,N,LOW,IGH,SCALE,M,ZR,ZI)
	11	INTEGER I,J,K,M,N,II,NM,IGH,LOW
	12	REAL SCALE(N),ZR(NM,M),ZI(NM,M)
	13	REAL S
	14	IF (IGH .EQ. LOW) GO TO 120
	15	DO 110 I = LOW, IGH
	16	S = SCALE(I)
	17	DO 100 J = 1, M
	18	ZR(I,J) = ZR(I,J) * S
	19	ZI(I,J) = ZI(I,J) * S
	20	100 CONTINUE
	21	110 CONTINUE
	22	120 DO 140 II = 1, N
	23	I = II
	24	IF (I .GE. LOW .AND. I .LE. IGH) GO TO 140
	25	IF (I .LT. LOW) I = LOW - II
	26	K = SCALE(I)
	27	IF (K .EQ. I) GO TO 140
	28	DO 130 J = 1, M
	29	S = ZR(I,J)
	30	ZR(I,J) = ZR(K,J)
	31	ZR(K,J) = S
	32	S = ZI(I,J)
	33	ZI(I,J) = ZI(K,J)
	34	ZI(K,J) = S
	35	130 CONTINUE
	36	140 CONTINUE
	37	RETURN
	38	END