Esope source files

   1 : C GENOR2    SOURCE    AM        08/12/19    21:16:40     6237           
   2 :       SUBROUTINE GENOR2(I1,I2,N)
   3 : C----------------------------------------------------
   4 : C
   5 : C     ON ORDONNE I1, ON FAIT SUIVRE LES PERMUTATIONS DANS I2
   6 : C
   7 : C     NUMERICAL RECIPES, HEAP SORT
   8 : C
   9 : C----------------------------------------------------
  10 : C
  11 : C     PP /9/97
  12 : C     Pierre Pegon/JRC Ispra
  13 : C
  14 : C     28/7/2005 : P. Maugis,
  15 : C                 boucle infinie si N=1 corrigé par test si N > 1
  16 : C
  17 : C      8/8/2008 : P. Pegon
  18 : C                 petit probleme de dimension de I1 ds un test!
  19 : C----------------------------------------------------
  20 :       IMPLICIT INTEGER(I-N)
  21 :       DIMENSION I1(N),I2(N)
  22 : C
  23 : *     On classe s'il y a quelque chose à classer
  24 :       IF (N.GT.1) THEN
  25 :         L   = (N/2)+1
  26 :         IR  = N
  27 : C
  28 :    1    CONTINUE
  29 :           IF (L.GT.1) THEN
  30 :             L      = L-1
  31 :             II1    = I1(L)
  32 :             II2    = I2(L)
  33 :           ELSE
  34 :             II1    = I1(IR)
  35 :             II2    = I2(IR)
  36 :             I1(IR) = I1(1)
  37 :             I2(IR) = I2(1)
  38 :             IR     = IR-1
  39 :             IF (IR.EQ.1) THEN
  40 :               I1(1) = II1
  41 :               I2(1) = II2
  42 :               RETURN
  43 :             ENDIF
  44 :           ENDIF
  45 : C
  46 :           I = L
  47 :           J = L*2
  48 : 
  49 :    2      CONTINUE
  50 :             IF (J.GT.IR) GOTO 3
  51 : C PPO       IF (J.LT.IR .AND. I1(J).LT.I1(J+1)) J=J+1
  52 :             IF(J.LT.IR)THEN
  53 :               IF(I1(J).LT.I1(J+1))J=J+1
  54 :             ENDIF
  55 :             IF (II1.LT.I1(J)) THEN
  56 :               I1(I) = I1(J)
  57 :               I2(I) = I2(J)
  58 :               I     = J
  59 :               J     = 2*J
  60 :             ELSE
  61 :               J     = IR+1
  62 :             ENDIF
  63 :           GOTO 2
  64 :    3      CONTINUE
  65 :           I1(I) = II1
  66 :           I2(I) = II2
  67 : C
  68 :         GOTO 1
  69 : C
  70 :       ENDIF
  71 : 
  72 :       END
  73 : 
  74 : 
  75 : 
  76 :