Télécharger la plaquette Cast3M


fr en

Télécharger isheli.eso

Retour à la liste

Numérotation des lignes : 

isheli

  1. C ISHELI    SOURCE    CHAT      05/01/13    00:43:58     5004
  2.       SUBROUTINE ISHELI(NL,LIST,NK,KEY,
  3.      $     IMPR,IRET)
  4.       IMPLICIT INTEGER(I-N)
  5.       IMPLICIT REAL*8 (A-H,O-Z)
  6. C***********************************************************************
  7. C NOM         : ISHELI
  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 KEY (NK must be ge NL)
  40. C     KEY    - 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 KEY
  45. C     NK     - Unchanged
  46. C     KEY    - Unchanged
  47. C
  48. C NOTES              :
  49. C
  50. C     Efficient for medium lists only (NL lt 50).
  51. C
  52. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  53. C***********************************************************************
  54. C VERSION    : v1, 05/11/99, version initiale
  55. C HISTORIQUE : v1, 10/03/89, création
  56. C HISTORIQUE :
  57. C HISTORIQUE :
  58. C***********************************************************************
  59. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  60. C en cas de modification de ce sous-programme afin de faciliter
  61. C la maintenance !
  62. C***********************************************************************
  63.  
  64. -INC PPARAM
  65. -INC CCOPTIO
  66.       INTEGER NL,NK,I,J,T,VALUE,INC
  67.       INTEGER LIST(NL),KEY(NK)
  68.       INTEGER IMPR,IRET
  69. *
  70. * Executable statements
  71. *
  72.       IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans isheli'
  73. C  Determine the starting increment
  74.       INC=1
  75.  1    CONTINUE
  76.       INC=3*INC+1
  77.       IF (INC.LE.NL) GOTO 1
  78. C  Loop over the partial sorts
  79.  2    CONTINUE
  80.       INC=INC/3
  81. C  Outer loop of straight insertion
  82.       DO 11 I=INC+1,NL
  83.          T=LIST(I)
  84.          VALUE=KEY(T)
  85.          J=I
  86. C  Inner loop of straight insertion
  87.  3       CONTINUE
  88.          IF (KEY(LIST(J-INC)).GT.VALUE) THEN
  89.             LIST(J)=LIST(J-INC)
  90.             J=J-INC
  91.             IF (J.LE.INC) GOTO 4
  92.             GOTO 3
  93.          ENDIF
  94.  4       CONTINUE
  95.          LIST(J)=T
  96.  11   CONTINUE
  97.       IF (INC.GT.1) GOTO 2
  98. *
  99. * Normal termination
  100. *
  101.       IRET=0
  102.       RETURN
  103. *
  104. * Format handling
  105. *
  106. *
  107. * Error handling
  108. *
  109.  9999 CONTINUE
  110.       IRET=1
  111.       WRITE(IOIMP,*) 'An error was detected in subroutine isheli'
  112.       RETURN
  113. *
  114. * End of subroutine ISHELI
  115. *
  116.       END
  117.  
  118.  
  119.  
  120.  

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