Télécharger la plaquette Cast3M


fr en

Télécharger perm23.eso

Retour à la liste

Numérotation des lignes : 

perm23

  1. C PERM23    SOURCE    BP208322  16/06/27    21:16:22     8990           
  2.  
  3.       SUBROUTINE PERM23(N,A,F,M,INF,U,V,FB)
  4. C
  5. C SEARCH FOR THE INITIAL DUAL AND PARTIAL PRIMAL SOLUTIONS.
  6. C
  7. C P(I) = FIRST UNSCANNED COLUMN OF ROW  I .
  8. C
  9.       IMPLICIT INTEGER(I-N)
  10.       IMPLICIT REAL*8(A-H,O-Z)
  11.  
  12.       INTEGER A(N,N),F(N)
  13.       INTEGER U(N),V(N),FB(N),P(N),R
  14. C PHASE 1 .
  15.       M = 0
  16.       DO 10 K=1,N
  17.         F(K) = 0
  18.         FB(K) = 0
  19.    10 CONTINUE
  20. C SCANNING OF THE COLUMNS ( INITIALIZATION OF  V(J) ).
  21.       DO 40 J=1,N
  22.         MIN = INF
  23.         DO 30 I=1,N
  24.           IA = A(I,J)
  25.           IF ( IA .GT. MIN ) GO TO 30
  26.           IF ( IA .LT. MIN ) GO TO 20
  27.           IF ( F(I) .NE. 0 ) GO TO 30
  28.    20     MIN = IA
  29.           R = I
  30.    30   CONTINUE
  31.         V(J) = MIN
  32.         IF ( F(R) .NE. 0 ) GO TO 40
  33. C ASSIGNMENT OF COLUMN  J  TO ROW  R .
  34.         M = M + 1
  35.         FB(J) = R
  36.         F(R) = J
  37.         U(R) = 0
  38.         P(R) = J + 1
  39.    40 CONTINUE
  40. C PHASE 2 .
  41. C SCANNING OF THE UNASSIGNED ROWS ( UPDATING OF  U(I) ).
  42.       DO 110 I=1,N
  43.         IF ( F(I) .NE. 0 ) GO TO 110
  44.         MIN = INF
  45.         DO 60 K=1,N
  46.           IA = A(I,K) - V(K)
  47.           IF ( IA .GT. MIN ) GO TO 60
  48.           IF ( IA .LT. MIN ) GO TO 50
  49.           IF ( FB(K) .NE. 0 ) GO TO 60
  50.           IF ( FB(J) .EQ. 0 ) GO TO 60
  51.    50     MIN = IA
  52.           J = K
  53.    60   CONTINUE
  54.         U(I) = MIN
  55.         JMIN = J
  56.         IF ( FB(J) .EQ. 0 ) GO TO 100
  57.         DO 80 J=JMIN,N
  58.           IF ( A(I,J) - V(J) .GT. MIN ) GO TO 80
  59.           R = FB(J)
  60.           KK = P(R)
  61.           IF ( KK .GT. N ) GO TO 80
  62.           DO 70 K=KK,N
  63.             IF ( FB(K) .GT. 0 ) GO TO 70
  64.             IF ( A(R,K) - U(R) - V(K) .EQ. 0 ) GO TO 90
  65.    70     CONTINUE
  66.           P(R) = N + 1
  67.    80   CONTINUE
  68.         GO TO 110
  69. C REASSIGNMENT OF ROW  R  AND COLUMN  K .
  70.    90   F(R) = K
  71.         FB(K) = R
  72.         P(R) = K + 1
  73. C ASSIGNMENT OF COLUMN  J  TO ROW  I .
  74.   100   M = M + 1
  75.         F(I) = J
  76.         FB(J)= I
  77.         P(I) = J + 1
  78.   110 CONTINUE
  79.       RETURN
  80.       END
  81.  
  82.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales