GEANT321/gheisha/dlpsor.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1995/10/24 10:21:01  cernlib
   6 * Geant
   7 *
   8 *
   9 #include "geant321/pilot.h"
  10 *CMZ :  3.21/02 29/03/94  15.41.39  by  S.Giani
  11 *-- Author :
  12       SUBROUTINE DLPSOR(A,N)
  13 C
  14 C *** DOUBLE PRECISION VERSION OF CERNLIB ROUTINE "FLPSOR" ***
  15 C *** NVE 29-MAR-1988 CERN GENEVA ***
  16 C
  17 C CALLED BY : PHASP
  18 C ORIGIN : H.FESEFELDT (02-DEC-1986)
  19 C
  20 #if !defined(CERNLIB_SINGLE)
  21       IMPLICIT DOUBLE PRECISION (A-H,O-Z)
  22 #endif
  23 C
  24       DIMENSION A(N)
  25       DIMENSION LT(20),RT(20)
  26       INTEGER R,RT
  27 C
  28       LEVEL=1
  29       LT(1)=1
  30       RT(1)=N
  31    10 L=LT(LEVEL)
  32       R=RT(LEVEL)
  33       LEVEL=LEVEL-1
  34    20 IF(R.LE.L) IF(LEVEL) 50,50,10
  35 C
  36 C   SUBDIVIDE THE INTERVAL L,R
  37 C     L : LOWER LIMIT OF THE INTERVAL (INPUT)
  38 C     R : UPPER LIMIT OF THE INTERVAL (INPUT)
  39 C     J : UPPER LIMIT OF LOWER SUB-INTERVAL (OUTPUT)
  40 C     I : LOWER LIMIT OF UPPER SUB-INTERVAL (OUTPUT)
  41 C
  42       I=L
  43       J=R
  44       M=(L+R)/2
  45       X=A(M)
  46   220 IF(A(I).GE.X) GO TO 230
  47       I=I+1
  48       GO TO 220
  49   230 IF(A(J).LE.X) GO TO 231
  50       J=J-1
  51       GO TO 230
  52 C
  53   231 IF(I.GT.J) GO TO 232
  54       W=A(I)
  55       A(I)=A(J)
  56       A(J)=W
  57       I=I+1
  58       J=J-1
  59       IF(I.LE.J) GO TO 220
  60 C
  61   232 LEVEL=LEVEL+1
  62       IF((R-I).GE.(J-L)) GO TO 30
  63       LT(LEVEL)=L
  64       RT(LEVEL)=J
  65       L=I
  66       GO TO 20
  67    30 LT(LEVEL)=I
  68       RT(LEVEL)=R
  69       R=J
  70       GO TO 20
  71    50 RETURN
  72       END