Télécharger la plaquette Cast3M


fr en

Télécharger genos2.eso

Retour à la liste

Numérotation des lignes : 

genos2

  1. C GENOS2    SOURCE    CHAT      05/01/13    00:17:33     5004
  2.       SUBROUTINE GENOS2(R1,I2,N)
  3. C----------------------------------------------------
  4. C     ON ORDONNE R1, ON FAIT SUIVRE LES PERMUTATION DANS I2
  5. C
  6. C     NUMERICAL RECIPES, HEAP SORT
  7. C
  8. C     PP /9/97
  9. C     Pierre Pegon/JRC Ispra
  10. C----------------------------------------------------
  11.       IMPLICIT INTEGER(I-N)
  12.       IMPLICIT REAL*8 (A-H,O-Z)
  13.       DIMENSION R1(N),I2(N)
  14. C
  15.       IF (N.LE.1) RETURN
  16.       L=(N/2)+1
  17.       IR=N
  18. C
  19.  1    CONTINUE
  20.         IF(L.GT.1)THEN
  21.           L=L-1
  22.           RR1=R1(L)
  23.           II2=I2(L)
  24.         ELSE
  25.           RR1=R1(IR)
  26.           II2=I2(IR)
  27.           R1(IR)=R1(1)
  28.           I2(IR)=I2(1)
  29.           IR=IR-1
  30.           IF(IR.EQ.1)THEN
  31.             R1(1)=RR1
  32.             I2(1)=II2
  33.             RETURN
  34.           ENDIF
  35.         ENDIF
  36. C
  37.         I=L
  38.         J=L*2
  39.  
  40.  2      CONTINUE
  41.           IF(J.GT.IR)GOTO 3
  42.           IF(J.LT.IR.AND.R1(J).LT.R1(J+1))J=J+1
  43.           IF(RR1.LT.R1(J))THEN
  44.             R1(I)=R1(J)
  45.             I2(I)=I2(J)
  46.             I=J
  47.             J=2*J
  48.           ELSE
  49.             J=IR+1
  50.           ENDIF
  51.         GOTO 2
  52.  3      CONTINUE
  53.         R1(I)=RR1
  54.         I2(I)=II2
  55. C
  56.       GOTO 1
  57. C
  58.       END
  59.  
  60.  
  61.  
  62.  

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