Télécharger la plaquette Cast3M


fr en

Télécharger ishelr.eso

Retour à la liste

Numérotation des lignes : 

ishelr

  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.  
  62. -INC PPARAM
  63. -INC CCOPTIO
  64.       INTEGER NL,NK,I,J,T,INC
  65.       INTEGER LIST(NL)
  66.       INTEGER IMPR,IRET
  67.       REAL*8 XKEY(NK),VALUE
  68. *
  69. * Executable statements
  70. *
  71.       IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans ishelr'
  72.       NINV=0
  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=XKEY(T)
  85.          J=I
  86. C  Inner loop of straight insertion
  87.  3       CONTINUE
  88.          IF (XKEY(LIST(J-INC)).GT.VALUE) THEN
  89.             NINV=NINV+1
  90.             LIST(J)=LIST(J-INC)
  91.             J=J-INC
  92.             IF (J.LE.INC) GOTO 4
  93.             GOTO 3
  94.          ENDIF
  95.  4       CONTINUE
  96.          LIST(J)=T
  97.  11   CONTINUE
  98.       IF (INC.GT.1) GOTO 2
  99. *
  100. * Normal termination
  101. *
  102.       IRET=0
  103.       RETURN
  104. *
  105. * Format handling
  106. *
  107. *
  108. * Error handling
  109. *
  110.  9999 CONTINUE
  111.       IRET=1
  112.       WRITE(IOIMP,*) 'An error was detected in subroutine ishelr'
  113.       RETURN
  114. *
  115. * End of subroutine ISHELR
  116. *
  117.       END
  118.  
  119.  
  120.  
  121.  
  122.  
  123.  

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