Télécharger la plaquette Cast3M


fr en

Télécharger perm13.eso

Retour à la liste

Numérotation des lignes : 

perm13

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

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