Télécharger genos2.eso

Retour à la liste

Numérotation des lignes :

  1. C GENOS2 SOURCE CHAT 05/01/13 00:17:33 5004
  2. SUBROUTINE GENOS2(R1,I2,N)
  3. C----------------------------------------------------
  4. C ON ORDONNE R1, ON FAIT SUIVRE LES PERMUTATION DANS I2
  5. C
  6. C NUMERICAL RECIPES, HEAP SORT
  7. C
  8. C PP /9/97
  9. C Pierre Pegon/JRC Ispra
  10. C----------------------------------------------------
  11. IMPLICIT INTEGER(I-N)
  12. IMPLICIT REAL*8 (A-H,O-Z)
  13. DIMENSION R1(N),I2(N)
  14. C
  15. IF (N.LE.1) RETURN
  16. L=(N/2)+1
  17. IR=N
  18. C
  19. 1 CONTINUE
  20. IF(L.GT.1)THEN
  21. L=L-1
  22. RR1=R1(L)
  23. II2=I2(L)
  24. ELSE
  25. RR1=R1(IR)
  26. II2=I2(IR)
  27. R1(IR)=R1(1)
  28. I2(IR)=I2(1)
  29. IR=IR-1
  30. IF(IR.EQ.1)THEN
  31. R1(1)=RR1
  32. I2(1)=II2
  33. RETURN
  34. ENDIF
  35. ENDIF
  36. C
  37. I=L
  38. J=L*2
  39.  
  40. 2 CONTINUE
  41. IF(J.GT.IR)GOTO 3
  42. IF(J.LT.IR.AND.R1(J).LT.R1(J+1))J=J+1
  43. IF(RR1.LT.R1(J))THEN
  44. R1(I)=R1(J)
  45. I2(I)=I2(J)
  46. I=J
  47. J=2*J
  48. ELSE
  49. J=IR+1
  50. ENDIF
  51. GOTO 2
  52. 3 CONTINUE
  53. R1(I)=RR1
  54. I2(I)=II2
  55. C
  56. GOTO 1
  57. C
  58. END
  59.  
  60.  
  61.  
  62.  

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