Esope source files

   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 :