Télécharger ordm12.eso

Retour à la liste

Numérotation des lignes :

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

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