Télécharger genor2.eso

Retour à la liste

Numérotation des lignes :

  1. C GENOR2 SOURCE AM 08/12/19 21:16:40 6237
  2. SUBROUTINE GENOR2(I1,I2,N)
  3. C----------------------------------------------------
  4. C
  5. C ON ORDONNE I1, ON FAIT SUIVRE LES PERMUTATIONS DANS I2
  6. C
  7. C NUMERICAL RECIPES, HEAP SORT
  8. C
  9. C----------------------------------------------------
  10. C
  11. C PP /9/97
  12. C Pierre Pegon/JRC Ispra
  13. C
  14. C 28/7/2005 : P. Maugis,
  15. C boucle infinie si N=1 corrigé par test si N > 1
  16. C
  17. C 8/8/2008 : P. Pegon
  18. C petit probleme de dimension de I1 ds un test!
  19. C----------------------------------------------------
  20. IMPLICIT INTEGER(I-N)
  21. DIMENSION I1(N),I2(N)
  22. C
  23. * On classe s'il y a quelque chose à classer
  24. IF (N.GT.1) THEN
  25. L = (N/2)+1
  26. IR = N
  27. C
  28. 1 CONTINUE
  29. IF (L.GT.1) THEN
  30. L = L-1
  31. II1 = I1(L)
  32. II2 = I2(L)
  33. ELSE
  34. II1 = I1(IR)
  35. II2 = I2(IR)
  36. I1(IR) = I1(1)
  37. I2(IR) = I2(1)
  38. IR = IR-1
  39. IF (IR.EQ.1) THEN
  40. I1(1) = II1
  41. I2(1) = II2
  42. RETURN
  43. ENDIF
  44. ENDIF
  45. C
  46. I = L
  47. J = L*2
  48.  
  49. 2 CONTINUE
  50. IF (J.GT.IR) GOTO 3
  51. C PPO IF (J.LT.IR .AND. I1(J).LT.I1(J+1)) J=J+1
  52. IF(J.LT.IR)THEN
  53. IF(I1(J).LT.I1(J+1))J=J+1
  54. ENDIF
  55. IF (II1.LT.I1(J)) THEN
  56. I1(I) = I1(J)
  57. I2(I) = I2(J)
  58. I = J
  59. J = 2*J
  60. ELSE
  61. J = IR+1
  62. ENDIF
  63. GOTO 2
  64. 3 CONTINUE
  65. I1(I) = II1
  66. I2(I) = II2
  67. C
  68. GOTO 1
  69. C
  70. ENDIF
  71.  
  72. END
  73.  
  74.  
  75.  
  76.  
  77.  

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