]> git.uio.no Git - u/mrichter/AliRoot.git/blobdiff - MINICERN/mathlib/gen/h/h101s2.F
Merging the VirtualMC branch to the main development branch (HEAD)
[u/mrichter/AliRoot.git] / MINICERN / mathlib / gen / h / h101s2.F
diff --git a/MINICERN/mathlib/gen/h/h101s2.F b/MINICERN/mathlib/gen/h/h101s2.F
deleted file mode 100644 (file)
index 2190b01..0000000
+++ /dev/null
@@ -1,104 +0,0 @@
-*
-* $Id$
-*
-* $Log$
-* Revision 1.1.1.1  1996/04/01 15:02:49  mclareni
-* Mathlib gen
-*
-*
-#include "gen/pilot.h"
-      SUBROUTINE H101S2(A,B,C,M,N,IDA,IP,KP,KK,LW,IDW,W,X,EPS,IRC)
-
-#include "gen/imp64.inc"
-
-      DIMENSION A(IDA,*),B(*),C(*),X(*),W(*),LW(IDW,*)
-
-C     Finds the pivot-column, by taking degeneracy into account.
-C     Columns with C(K) >= 0 and A(IP,K) > 0: LW(.,3) = 1
-
-      DO 1 K = 1,N
-    1 LW(K,3)=0
-      DO 5 K = 1,N
-      IF(LW(K,2) .EQ. IRC .AND. K .NE. KK) THEN
-       IF(ABS(A(IP,K)) .LT. EPS) A(IP,K)=0
-       IF(ABS(C(K)) .LT. EPS) C(K)=0
-       IF(A(IP,K) .GT. 0 .AND. C(K) .GE. 0) THEN
-        LW(K,3)=1
-        Q=C(K)/A(IP,K)
-       ENDIF
-      ENDIF
-    5 CONTINUE
-      KP=0
-      DO 6 K = 1,N
-    6 KP=KP+LW(K,3)
-      IF(KP .EQ. 0) RETURN
-
-C     KP = 0 : No column found.
-C     Only columns with minimum quotient: LW(.,3) = 1.
-
-      DMIN=Q
-      DO 11 J = 1,2
-      DO 11 K = 1,N
-      IF(LW(K,3) .NE. 0) THEN
-       Q=C(K)/A(IP,K)
-       IF(Q .LE. DMIN) THEN
-        DMIN=Q
-        KP=K
-        GO TO 11
-       ENDIF
-       LW(K,3)=0
-      ENDIF
-   11 CONTINUE
-
-   12 IND=0
-      DO 15 K = 1,N
-   15 IND=IND+LW(K,3)
-      IF(IND .EQ. 1) RETURN
-
-C     Two possible columns are picked out
-
-      KP1=0
-      DO 20 K = 1,N
-      IF(LW(K,3) .NE. 0) THEN
-       IF(KP1 .EQ. 0) KP1=K
-       KP2=K
-      ENDIF
-   20 CONTINUE
-
-C     Choose pivot column from two columns with equal quotient.
-
-      DO 25 J = 1,M+N
-      X(J)=0
-   25 W(J)=0
-      X(LW(KP1,5))=1
-      W(LW(KP2,5))=1
-      DO 30 I = 1,M
-      IF(LW(I,1) .EQ. IRC) THEN
-       IF(ABS(A(I,KP1)) .LT. EPS) A(I,KP1)=0
-       IF(ABS(A(I,KP2)) .LT. EPS) A(I,KP2)=0
-       X(LW(I,4))=A(I,KP1)
-       W(LW(I,4))=A(I,KP2)
-      ENDIF
-   30 CONTINUE
-      DO 35 J = 1,M+N
-      IF(J .EQ. LW(IP,4)) THEN
-       X(J)=1
-       W(J)=1
-      ELSE
-       X(J)=X(J)/A(IP,KP1)
-       W(J)=W(J)/A(IP,KP2)
-      ENDIF
-   35 CONTINUE
-      DO 50 J = 1,M+N
-      IF(X(J) .LT. W(J)) THEN
-       LW(KP2,3)=0
-       KP=KP1
-       GO TO 12
-      ELSEIF(X(J) .GT. W(J)) THEN
-       LW(KP1,3)=0
-       KP=KP2
-       GO TO 12
-      ENDIF
-   50 CONTINUE
-      RETURN
-      END