Sources Esope | Cast3M

perm14
C PERM14    SOURCE    BP208322  16/06/27    21:16:20     8990           
 
      SUBROUTINE PERM14(N,A,II,F,XINF,JJ,U,V,FB,RC)
C
C DETERMINATION OF AN AUGMENTING PATH STARTING FROM
C UNASSIGNED ROW  II  AND TERMINATING AT UNASSIGNED COLUMN
C JJ , WITH UPDATING OF DUAL VARIABLES  U(I)  AND  V(J) .
C
C MEANING OF THE MAIN INTERNAL VARIABLES:
C LR(L) = L-TH LABELLED ROW ( L=1,NLR ).
C PI(J) = MIN ( A(I,J) - U(I) - V(J) , SUCH THAT ROW  I  IS
C         LABELLED AND NOT EQUAL TO  FB(J) ).
C RC(J) = ROW PRECEDING COLUMN  J  IN THE CURRENT
C         ALTERNATING PATH.
C UC(L) = L-TH UNLABELLED COLUMN ( L=1,NUC ).
C
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
 
      REAL*8  A(N,N),U(N),V(N),PI(N)
      INTEGER F(N)
      INTEGER LR(N),UC(N)
      INTEGER FB(N),RC(N),R
C INITIALIZATION.
      LR(1) = II
      DO 10 K=1,N
        PI(K) = A(II,K) - U(II) - V(K)
        RC(K) = II
        UC(K) = K
   10 CONTINUE
      NUC = N
      NLR = 1
      GO TO 40
C SCANNING OF THE LABELLED ROWS.
   20 R = LR(NLR)
      DO 30 L=1,NUC
        J = UC(L)
        XA = A(R,J) - U(R) - V(J)
        IF ( XA .GE. PI(J) ) GO TO 30
        PI(J) = XA
        RC(J) = R
   30 CONTINUE
C SEARCH FOR A ZERO ELEMENT IN AN UNLABELLED COLUMN.
   40 DO 50 L=1,NUC
        J = UC(L)
        IF ( PI(J) .EQ. 0 ) GO TO 100
   50 CONTINUE
C UPDATING OF THE DUAL VARIABLES  U(I)  AND  V(J) .
      XMIN = XINF
      DO 60 L=1,NUC
        J = UC(L)
        IF ( XMIN .GT. PI(J) ) XMIN = PI(J)
   60 CONTINUE
      DO 70 L=1,NLR
        R = LR(L)
        U(R) = U(R) + XMIN
   70 CONTINUE
      DO 90 J=1,N
        IF ( PI(J) .EQ. 0 ) GO TO 80
        PI(J) = PI(J) - XMIN
        GO TO 90
   80   V(J) = V(J) - XMIN
   90 CONTINUE
      GO TO 40
  100 IF ( FB(J) .EQ. 0 ) GO TO 110
C LABELLING OF ROW  FB(J)  AND REMOVAL OF THE LABEL  OF
C COLUMN  J .
      NLR = NLR + 1
      LR(NLR) = FB(J)
      UC(L) = UC(NUC)
      NUC = NUC - 1
      GO TO 20
C DETERMINATION OF THE UNASSIGNED COLUMN  J .
  110 JJ = J
      RETURN
      END