*
* $Id: h101s2.F,v 1.1.1.1 1996/04/01 15:02:49 mclareni Exp $
*
* $Log: h101s2.F,v $
* 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