Sources Esope | Cast3M

genor2
C GENOR2    SOURCE    AM        08/12/19    21:16:40     6237
      SUBROUTINE GENOR2(I1,I2,N)
C----------------------------------------------------
C
C     ON ORDONNE I1, ON FAIT SUIVRE LES PERMUTATIONS DANS I2
C
C     NUMERICAL RECIPES, HEAP SORT
C
C----------------------------------------------------
C
C     PP /9/97
C     Pierre Pegon/JRC Ispra
C
C     28/7/2005 : P. Maugis,
C                 boucle infinie si N=1 corrigé par test si N > 1
C
C      8/8/2008 : P. Pegon
C                 petit probleme de dimension de I1 ds un test!
C----------------------------------------------------
      IMPLICIT INTEGER(I-N)
      DIMENSION I1(N),I2(N)
C
*     On classe s'il y a quelque chose à classer
      IF (N.GT.1) THEN
        L   = (N/2)+1
        IR  = N
C
   1    CONTINUE
          IF (L.GT.1) THEN
            L      = L-1
            II1    = I1(L)
            II2    = I2(L)
          ELSE
            II1    = I1(IR)
            II2    = I2(IR)
            I1(IR) = I1(1)
            I2(IR) = I2(1)
            IR     = IR-1
            IF (IR.EQ.1) THEN
              I1(1) = II1
              I2(1) = II2
              RETURN
            ENDIF
          ENDIF
C
          I = L
          J = L*2
 
   2      CONTINUE
            IF (J.GT.IR) GOTO 3
C PPO       IF (J.LT.IR .AND. I1(J).LT.I1(J+1)) J=J+1
            IF(J.LT.IR)THEN
              IF(I1(J).LT.I1(J+1))J=J+1
            ENDIF
            IF (II1.LT.I1(J)) THEN
              I1(I) = I1(J)
              I2(I) = I2(J)
              I     = J
              J     = 2*J
            ELSE
              J     = IR+1
            ENDIF
          GOTO 2
   3      CONTINUE
          I1(I) = II1
          I2(I) = II2
C
        GOTO 1
C
      ENDIF
 
      END