C PERM13    SOURCE    BP208322  16/06/27    21:16:20     8990           

      SUBROUTINE PERM13(N,A,F,M,XINF,U,V,FB)
C
C SEARCH FOR THE INITXAL DUAL AND PARTXAL PRIMAL SOLUTIONS.
C
C P(I) = FIRST UNSCANNED COLUMN OF ROW  I .
C
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
      
      REAL*8  A(N,N),U(N),V(N)
      INTEGER F(N)
      INTEGER FB(N),P(N),R
C PHASE 1 .
      M = 0
      DO 10 K=1,N
        F(K) = 0
        FB(K) = 0
   10 CONTINUE
C SCANNING OF THE COLUMNS ( INITIALIZATION OF  V(J) ).
      DO 40 J=1,N
        XMIN = XINF
        DO 30 I=1,N
          XA = A(I,J)
          IF ( XA .GT. XMIN ) GO TO 30
          IF ( XA .LT. XMIN ) GO TO 20
          IF ( F(I) .NE. 0 ) GO TO 30
   20     XMIN = XA
          R = I
   30   CONTINUE
        V(J) = XMIN
        IF ( F(R) .NE. 0 ) GO TO 40
C ASSIGNMENT OF COLUMN  J  TO ROW  R .
        M = M + 1
        FB(J) = R
        F(R) = J
        U(R) = 0
        P(R) = J + 1
   40 CONTINUE
C PHASE 2 .
C SCANNING OF THE UNASSIGNED ROWS ( UPDATING OF  U(I) ).
      DO 110 I=1,N
        IF ( F(I) .NE. 0 ) GO TO 110
        XMIN = XINF
        DO 60 K=1,N
          XA = A(I,K) - V(K)
          IF ( XA .GT. XMIN ) GO TO 60
          IF ( XA .LT. XMIN ) GO TO 50
          IF ( FB(K) .NE. 0 ) GO TO 60
          IF ( FB(J) .EQ. 0 ) GO TO 60
   50     XMIN = XA
          J = K
   60   CONTINUE
        U(I) = XMIN
        JMIN = J
        IF ( FB(J) .EQ. 0 ) GO TO 100
        DO 80 J=JMIN,N
          IF ( A(I,J) - V(J) .GT. XMIN ) GO TO 80
          R = FB(J)
          KK = P(R)
          IF ( KK .GT. N ) GO TO 80
          DO 70 K=KK,N
            IF ( FB(K) .GT. 0 ) GO TO 70
            IF ( A(R,K) - U(R) - V(K) .EQ. 0 ) GO TO 90
   70     CONTINUE
          P(R) = N + 1
   80   CONTINUE
        GO TO 110
C REASSIGNMENT OF ROW  R  AND COLUMN  K .
   90   F(R) = K
        FB(K) = R
        P(R) = K + 1
C ASSIGNMENT OF COLUMN  J  TO ROW  I .
  100   M = M + 1
        F(I) = J
        FB(J)= I
        P(I) = J + 1
  110 CONTINUE
      RETURN
      END