Télécharger perm23.eso

Retour à la liste

Numérotation des lignes :

  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