]> git.uio.no Git - u/mrichter/AliRoot.git/blobdiff - MINICERN/mathlib/gen/f/comlr.F
Merging the VirtualMC branch to the main development branch (HEAD)
[u/mrichter/AliRoot.git] / MINICERN / mathlib / gen / f / comlr.F
diff --git a/MINICERN/mathlib/gen/f/comlr.F b/MINICERN/mathlib/gen/f/comlr.F
deleted file mode 100644 (file)
index f38723e..0000000
+++ /dev/null
@@ -1,136 +0,0 @@
-*
-* $Id$
-*
-* $Log$
-* Revision 1.1.1.1  1996/04/01 15:02:33  mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-      SUBROUTINE COMLR(NM,N,LOW,IGH,HR,HI,WR,WI,IERR)
-      INTEGER I,J,L,M,N,EN,LL,MM,NM,IGH,IM1,ITS,LOW,MP1,ENM1,IERR
-      REAL HR(NM,N),HI(NM,N),WR(N),WI(N)
-      REAL SI,SR,TI,TR,XI,XR,YI,YR,ZZI,ZZR,MACHEP
-      COMPLEX X,Y,Z
-      REAL T1(2),T2(2),T3(2)
-      EQUIVALENCE (X,T1(1),XR),(T1(2),XI),(Y,T2(1),YR),(T2(2),YI),
-     X            (Z,T3(1),ZZR),(T3(2),ZZI)
-#if defined(CERNLIB_CDC)
-      MACHEP=2.**(-47)
-#endif
-#if !defined(CERNLIB_CDC)
-      MACHEP=2.**(-23)
-#endif
-      IERR = 0
-C*UL  180 DO 200 I = 1, N
-      DO 200 I = 1, N
-         IF (I .GE. LOW .AND. I .LE. IGH) GO TO 200
-         WR(I) = HR(I,I)
-         WI(I) = HI(I,I)
-  200 CONTINUE
-      EN = IGH
-      TR = 0.0
-      TI = 0.0
-  220 IF (EN .LT. LOW) GO TO 1001
-      ITS = 0
-      ENM1 = EN - 1
-  240 DO 260 LL = LOW, EN
-         L = EN + LOW - LL
-         IF (L .EQ. LOW) GO TO 300
-         IF (ABS(HR(L,L-1)) + ABS(HI(L,L-1)) .LE.
-     X      MACHEP * (ABS(HR(L-1,L-1)) + ABS(HI(L-1,L-1))
-     X             + ABS(HR(L,L)) +ABS(HI(L,L)))) GO TO 300
-  260 CONTINUE
-  300 IF (L .EQ. EN) GO TO 660
-      IF (ITS .EQ. 30) GO TO 1000
-      IF (ITS .EQ. 10 .OR. ITS .EQ. 20) GO TO 320
-      SR = HR(EN,EN)
-      SI = HI(EN,EN)
-      XR = HR(ENM1,EN) * HR(EN,ENM1) - HI(ENM1,EN) * HI(EN,ENM1)
-      XI = HR(ENM1,EN) * HI(EN,ENM1) + HI(ENM1,EN) * HR(EN,ENM1)
-      IF (XR .EQ. 0.0 .AND. XI .EQ. 0.0) GO TO 340
-      YR = (HR(ENM1,ENM1) - SR) / 2.0
-      YI = (HI(ENM1,ENM1) - SI) / 2.0
-      Z = SQRT(CMPLX(YR**2-YI**2+XR,2.0*YR*YI+XI))
-      IF (YR * ZZR + YI * ZZI .LT. 0.0) Z = -Z
-      X = X / (Y + Z)
-      SR = SR - XR
-      SI = SI - XI
-      GO TO 340
-  320 SR = ABS(HR(EN,ENM1)) + ABS(HR(ENM1,EN-2))
-      SI = ABS(HI(EN,ENM1)) + ABS(HI(ENM1,EN-2))
-  340 DO 360 I = LOW, EN
-         HR(I,I) = HR(I,I) - SR
-         HI(I,I) = HI(I,I) - SI
-  360 CONTINUE
-      TR = TR + SR
-      TI = TI + SI
-      ITS = ITS + 1
-      XR = ABS(HR(ENM1,ENM1)) + ABS(HI(ENM1,ENM1))
-      YR = ABS(HR(EN,ENM1)) + ABS(HI(EN,ENM1))
-      ZZR = ABS(HR(EN,EN)) + ABS(HI(EN,EN))
-      DO 380 MM = L, ENM1
-         M = ENM1 + L - MM
-         IF (M .EQ. L) GO TO 420
-         YI = YR
-         YR = ABS(HR(M,M-1)) + ABS(HI(M,M-1))
-         XI = ZZR
-         ZZR = XR
-         XR = ABS(HR(M-1,M-1)) + ABS(HI(M-1,M-1))
-         IF (YR .LE. MACHEP * ZZR / YI * (ZZR + XR + XI)) GO TO 420
-  380 CONTINUE
-  420 MP1 = M + 1
-      DO 520 I = MP1, EN
-         IM1 = I - 1
-         XR = HR(IM1,IM1)
-         XI = HI(IM1,IM1)
-         YR = HR(I,IM1)
-         YI = HI(I,IM1)
-         IF (ABS(XR) + ABS(XI) .GE. ABS(YR) + ABS(YI)) GO TO 460
-         DO 440 J = IM1, N
-            ZZR = HR(IM1,J)
-            HR(IM1,J) = HR(I,J)
-            HR(I,J) = ZZR
-            ZZI = HI(IM1,J)
-            HI(IM1,J) = HI(I,J)
-            HI(I,J) = ZZI
-  440    CONTINUE
-         Z = X / Y
-         WR(I) = 1.0
-         GO TO 480
-  460    Z = Y / X
-         WR(I) = -1.0
-  480    HR(I,IM1) = ZZR
-         HI(I,IM1) = ZZI
-         DO 500 J = I, EN
-            HR(I,J) = HR(I,J) - ZZR * HR(IM1,J) + ZZI * HI(IM1,J)
-            HI(I,J) = HI(I,J) - ZZR * HI(IM1,J) - ZZI * HR(IM1,J)
-  500   CONTINUE
-  520 CONTINUE
-      DO 640 J = MP1, EN
-         XR = HR(J,J-1)
-         XI = HI(J,J-1)
-         HR(J,J-1) = 0.0
-         HI(J,J-1) = 0.0
-         IF (WR(J) .LE. 0.0) GO TO 580
-         DO 540 I = L, J
-            ZZR = HR(I,J-1)
-            HR(I,J-1) = HR(I,J)
-            HR(I,J) = ZZR
-            ZZI = HI(I,J-1)
-            HI(I,J-1) = HI(I,J)
-            HI(I,J) = ZZI
-  540    CONTINUE
-  580    DO 600 I = L, J
-            HR(I,J-1) = HR(I,J-1) + XR * HR(I,J) - XI * HI(I,J)
-            HI(I,J-1) = HI(I,J-1) + XR * HI(I,J) + XI * HR(I,J)
-  600    CONTINUE
-  640 CONTINUE
-      GO TO 240
-  660 WR(EN) = HR(EN,EN) + TR
-      WI(EN) = HI(EN,EN) + TI
-      EN = ENM1
-      GO TO 220
- 1000 IERR = EN
- 1001 RETURN
-      END