Télécharger ishelr.eso

Retour à la liste

Numérotation des lignes :

  1. C ISHELR SOURCE GOUNAND 14/09/16 21:15:10 8152
  2. SUBROUTINE ISHELR(NL,LIST,NK,XKEY,NINV,
  3. $ IMPR,IRET)
  4. IMPLICIT INTEGER(I-N)
  5. IMPLICIT REAL*8 (A-H,O-Z)
  6. C***********************************************************************
  7. C NOM : ISHELR
  8. C DESCRIPTION : Order a list of integers in ascending sequence of their
  9. C keys using Shell's method as implemented in Numerical
  10. C Recipes.
  11. C
  12. C LANGAGE : FORTRAN 77 (sauf E/S)
  13. C
  14. C AUTEUR : Scott Sloan
  15. C
  16. C BIBLIO : @Article{,
  17. C author = {S. W. Sloan},
  18. C title = {A Fortran Program for Profile and Wavefront Reduction},
  19. C journal = {International Journal for Numerical Methods in Engineering},
  20. C year = {1989},
  21. C volume = {28},
  22. C pages = {2651-2679}
  23. C}
  24. C@Book{,
  25. C editor = {Cambridge University Press},
  26. C title = {Numerical Recipes in Fortran 77 : the Art of Scientific
  27. C Programming},
  28. C publisher = {Cambridge University Press},
  29. C year = {1986-1992},
  30. C note = {http://www.nr.com}
  31. C}
  32. C
  33. C***********************************************************************
  34. C APPELE PAR : DIAMTR
  35. C***********************************************************************
  36. C ENTREES :
  37. C NL - Length of LIST
  38. C LIST - A list of integers
  39. C NK - Length of XKEY (NK must be ge NL)
  40. C XKEY - A list of integer keys
  41. C
  42. C SORTIES :
  43. C NL - Unchanged
  44. C LIST - A list of integers sorted in ascending sequence of XKEY
  45. C NK - Unchanged
  46. C XKEY - Unchanged
  47. C NINV - Number of inversions
  48. C
  49. C NOTES :
  50. C
  51. C Efficient for medium lists only (NL lt 50).
  52. C
  53. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  54. C***********************************************************************
  55. C VERSION : v1, 05/11/99, version initiale
  56. C HISTORIQUE : v1, 10/03/89, création
  57. C HISTORIQUE : 11/09/2014, ajout sortie nb inversions (permet de
  58. C déterminer l'ordre de la permutation)
  59. C HISTORIQUE :
  60. C***********************************************************************
  61. -INC CCOPTIO
  62. INTEGER NL,NK,I,J,T,INC
  63. INTEGER LIST(NL)
  64. INTEGER IMPR,IRET
  65. REAL*8 XKEY(NK),VALUE
  66. *
  67. * Executable statements
  68. *
  69. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans ishelr'
  70. NINV=0
  71. C Determine the starting increment
  72. INC=1
  73. 1 CONTINUE
  74. INC=3*INC+1
  75. IF (INC.LE.NL) GOTO 1
  76. C Loop over the partial sorts
  77. 2 CONTINUE
  78. INC=INC/3
  79. C Outer loop of straight insertion
  80. DO 11 I=INC+1,NL
  81. T=LIST(I)
  82. VALUE=XKEY(T)
  83. J=I
  84. C Inner loop of straight insertion
  85. 3 CONTINUE
  86. IF (XKEY(LIST(J-INC)).GT.VALUE) THEN
  87. NINV=NINV+1
  88. LIST(J)=LIST(J-INC)
  89. J=J-INC
  90. IF (J.LE.INC) GOTO 4
  91. GOTO 3
  92. ENDIF
  93. 4 CONTINUE
  94. LIST(J)=T
  95. 11 CONTINUE
  96. IF (INC.GT.1) GOTO 2
  97. *
  98. * Normal termination
  99. *
  100. IRET=0
  101. RETURN
  102. *
  103. * Format handling
  104. *
  105. *
  106. * Error handling
  107. *
  108. 9999 CONTINUE
  109. IRET=1
  110. WRITE(IOIMP,*) 'An error was detected in subroutine ishelr'
  111. RETURN
  112. *
  113. * End of subroutine ISHELR
  114. *
  115. END
  116.  
  117.  
  118.  
  119.  
  120.  
  121.  

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