C ISHELI SOURCE CHAT 05/01/13 00:43:58 5004 SUBROUTINE ISHELI(NL,LIST,NK,KEY, $ IMPR,IRET) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) C*********************************************************************** C NOM : ISHELI C DESCRIPTION : Order a list of integers in ascending sequence of their C keys using Shell's method as implemented in Numerical C Recipes. C C LANGAGE : FORTRAN 77 (sauf E/S) C C AUTEUR : Scott Sloan C C BIBLIO : @Article{, C author = {S. W. Sloan}, C title = {A Fortran Program for Profile and Wavefront Reduction}, C journal = {International Journal for Numerical Methods in Engineering}, C year = {1989}, C volume = {28}, C pages = {2651-2679} C} C@Book{, C editor = {Cambridge University Press}, C title = {Numerical Recipes in Fortran 77 : the Art of Scientific C Programming}, C publisher = {Cambridge University Press}, C year = {1986-1992}, C note = {http://www.nr.com} C} C C*********************************************************************** C APPELE PAR : DIAMTR C*********************************************************************** C ENTREES : C NL - Length of LIST C LIST - A list of integers C NK - Length of KEY (NK must be ge NL) C KEY - A list of integer keys C C SORTIES : C NL - Unchanged C LIST - A list of integers sorted in ascending sequence of KEY C NK - Unchanged C KEY - Unchanged C C NOTES : C C Efficient for medium lists only (NL lt 50). C C CODE RETOUR (IRET) : = 0 si tout s'est bien passé C*********************************************************************** C VERSION : v1, 05/11/99, version initiale C HISTORIQUE : v1, 10/03/89, création C HISTORIQUE : C HISTORIQUE : C*********************************************************************** C Prière de PRENDRE LE TEMPS de compléter les commentaires C en cas de modification de ce sous-programme afin de faciliter C la maintenance ! C*********************************************************************** -INC PPARAM -INC CCOPTIO INTEGER NL,NK,I,J,T,VALUE,INC INTEGER LIST(NL),KEY(NK) INTEGER IMPR,IRET * * Executable statements * IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans isheli' C Determine the starting increment INC=1 1 CONTINUE INC=3*INC+1 IF (INC.LE.NL) GOTO 1 C Loop over the partial sorts 2 CONTINUE INC=INC/3 C Outer loop of straight insertion DO 11 I=INC+1,NL T=LIST(I) VALUE=KEY(T) J=I C Inner loop of straight insertion 3 CONTINUE IF (KEY(LIST(J-INC)).GT.VALUE) THEN LIST(J)=LIST(J-INC) J=J-INC IF (J.LE.INC) GOTO 4 GOTO 3 ENDIF 4 CONTINUE LIST(J)=T 11 CONTINUE IF (INC.GT.1) GOTO 2 * * Normal termination * IRET=0 RETURN * * Format handling * * * Error handling * 9999 CONTINUE IRET=1 WRITE(IOIMP,*) 'An error was detected in subroutine isheli' RETURN * * End of subroutine ISHELI * END