Télécharger ordm13.eso

Retour à la liste

Numérotation des lignes :

  1. C ORDM13 SOURCE JC220346 14/12/16 21:15:06 8324
  2. ************************************************************************
  3. * NOM : ORDM13
  4. * DESCRIPTION : Tri par fusion (Merge Sort) pour une liste de reels
  5. * On tient seulement compte de leur valeur ABSOLUE
  6. * On renvoie en plus le nouvel ORDRE des elements
  7. ************************************************************************
  8. * APPELE PAR : pilot.eso
  9. ************************************************************************
  10. * ENTREES :: A = liste de reels a trier
  11. * AI = rang des elements de A (entiers de 1 a N)
  12. * N = longueur des listes A et AI
  13. * T = tableau de travail de reels de longueur (N+1)/2
  14. * TI = tableau de travail d'entiers de longueur (N+1)/2
  15. * CROISS = booleen indiquant l'ordre du tri
  16. * SORTIES :: A = liste triee
  17. * AI = position initiale des elements de la liste triee
  18. ************************************************************************
  19. RECURSIVE SUBROUTINE ORDM13(A,AI,N,T,TI,CROISS)
  20. *
  21. INTEGER I,J,K,N,NA,NB,AI,TI,VI
  22. REAL*8 A,T,V
  23. DIMENSION A(N),AI(N),T((N+1)/2),TI((N+1)/2)
  24. LOGICAL CROISS,DECROI
  25. *
  26. * On arrete la recursion pour N=1 ou N=2
  27. IF (N.LT.2) RETURN
  28. DECROI = .NOT.CROISS
  29. IF (N.EQ.2) THEN
  30. IF ((CROISS.AND.ABS(A(1)).GT.ABS(A(2))).OR.
  31. & (DECROI.AND.ABS(A(1)).LT.ABS(A(2)))) THEN
  32. V = A(1)
  33. A(1) = A(2)
  34. A(2) = V
  35. VI = AI(1)
  36. AI(1) = AI(2)
  37. AI(2) = VI
  38. ENDIF
  39. RETURN
  40. ENDIF
  41. *
  42. * Sinon, on subdivise en deux sous-listes plus petites que l'on
  43. * va ordonner separement
  44. NA=(N+1)/2
  45. NB=N-NA
  46. CALL ORDM13(A,AI,NA,T,TI,CROISS)
  47. CALL ORDM13(A(NA+1),AI(NA+1),NB,T,TI,CROISS)
  48. *
  49. * On melange les deux petites sous-listes en une grande liste
  50. * ordonnee (avec un peu de chance, il n'y a rien a faire...)
  51. IF ((CROISS.AND.ABS(A(NA)).GT.ABS(A(NA+1))).OR.
  52. & (DECROI.AND.ABS(A(NA)).LT.ABS(A(NA+1)))) THEN
  53. T(1:NA)=A(1:NA)
  54. TI(1:NA)=AI(1:NA)
  55. I = 1
  56. J = 1
  57. K = 1
  58. DO WHILE (I.LE.NA.AND.J.LE.NB)
  59. V = A(NA+J)
  60. VI = AI(NA+J)
  61. IF ((CROISS.AND.ABS(T(I)).LE.ABS(V)).OR.
  62. & (DECROI.AND.ABS(T(I)).GE.ABS(V))) THEN
  63. A(K) = T(I)
  64. AI(K) = TI(I)
  65. I = I+1
  66. ELSE
  67. A(K) = V
  68. AI(K) = VI
  69. J = J+1
  70. ENDIF
  71. K = K + 1
  72. ENDDO
  73. *
  74. DO WHILE (I.LE.NA)
  75. A(K) = T(I)
  76. AI(K) = TI(I)
  77. I = I + 1
  78. K = K + 1
  79. ENDDO
  80. ENDIF
  81. *
  82. RETURN
  83. *
  84. END
  85. *
  86.  

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