1 : C ISHELR SOURCE GOUNAND 08/12/18 21:15:08 6227
2 : SUBROUTINE ISHELR(NL,LIST,NK,XKEY,
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
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 : -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 : C Determine the starting increment
73 : INC=1
74 : 1 CONTINUE
75 : INC=3*INC+1
76 : IF (INC.LE.NL) GOTO 1
77 : C Loop over the partial sorts
78 : 2 CONTINUE
79 : INC=INC/3
80 : C Outer loop of straight insertion
81 : DO 11 I=INC+1,NL
82 : T=LIST(I)
83 : VALUE=XKEY(T)
84 : J=I
85 : C Inner loop of straight insertion
86 : 3 CONTINUE
87 : IF (XKEY(LIST(J-INC)).GT.VALUE) THEN
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 :
© Cast3M 2003 - All rights reserved.
Disclaimer