+++ /dev/null
-*
-* $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