This commit was generated by cvs2svn to compensate for changes in r2,
[u/mrichter/AliRoot.git] / GEANT321 / cgpack / cgbsor.F
1 *
2 * $Id$
3 *
4 * $Log$
5 * Revision 1.1.1.1  1995/10/24 10:19:42  cernlib
6 * Geant
7 *
8 *
9 #include "geant321/pilot.h"
10 *CMZ :  3.21/02 29/03/94  15.41.31  by  S.Giani
11 *-- Author :
12       SUBROUTINE CGBSOR(NEDGE,EDGE)
13 ************************************************************************
14 *                                                                      *
15 *     Name: CGBSOR                                                     *
16 *     Author: E. Chernyaev                       Date:    15.03.89     *
17 *                                                Revised:              *
18 *                                                                      *
19 *     Function: Shell sort of edges                                    *
20 *                                                                      *
21 *     References: none                                                 *
22 *                                                                      *
23 *     Input:  NEDGE - number of edges                                  *
24 *     Output: EDGE(*,*)  - edges                                       *
25 *                                                                      *
26 *     Output:                                                          *
27 *                                                                      *
28 *     Errors: none                                                     *
29 *                                                                      *
30 ************************************************************************
31 #include "geant321/cggpar.inc"
32 #include "geant321/cgdelt.inc"
33       REAL      EDGE(LCGEDG,*)
34 *-
35       ERROR  = 1.5*EEWOR
36       ATRINV = 4.
37       CALL CGSHEL(ATRINV,ERROR,NEDGE,EDGE)
38 *
39 **          D E L E T E   D O U B L E   E D G E S
40 **          A T R I B U T E   A N A L I S A T I O N
41 *
42       IF (NEDGE .LE. 0)                 GOTO 999
43       IF (NEDGE .EQ. 1)                 GOTO 810
44       J       = 1
45       NSAME = 1
46       DO 800 NE=2,NEDGE
47         IF (J .EQ. 0)                   GOTO 720
48         IF (ABS(EDGE(KCGX1,NE)-EDGE(KCGX1,J)) .GT. ERROR) GOTO 720
49         IF (ABS(EDGE(KCGY1,NE)-EDGE(KCGY1,J)) .GT. ERROR) GOTO 720
50         IF (ABS(EDGE(KCGZ1,NE)-EDGE(KCGZ1,J)) .GT. ERROR) GOTO 720
51         IF (ABS(EDGE(KCGX2,NE)-EDGE(KCGX2,J)) .GT. ERROR) GOTO 720
52         IF (ABS(EDGE(KCGY2,NE)-EDGE(KCGY2,J)) .GT. ERROR) GOTO 720
53         IF (ABS(EDGE(KCGZ2,NE)-EDGE(KCGZ2,J)) .GT. ERROR) GOTO 720
54 *           A T R I B U T E   A N A L I S A T I O N
55         AJ     = EDGE(KCGAE,J)
56         ANE    = EDGE(KCGAE,NE)
57         IF (AJ .EQ. ANE)                GOTO 705
58         IF (AJ.LE.-4. .AND. ANE.GT.-4.) GOTO 710
59         IF (AJ.GT.-4. .AND. ANE.LE.-4.) GOTO 710
60         IF (AJ .GT. ANE)                EDGE(KCGAE,J) = EDGE(KCGAE,NE)
61   705   EDGE(KCGX1,J)=((EDGE(KCGX1,J)*NSAME)+EDGE(KCGX1,NE))/(NSAME+1)
62         EDGE(KCGY1,J)=((EDGE(KCGY1,J)*NSAME)+EDGE(KCGY1,NE))/(NSAME+1)
63         EDGE(KCGZ1,J)=((EDGE(KCGZ1,J)*NSAME)+EDGE(KCGZ1,NE))/(NSAME+1)
64         EDGE(KCGX2,J)=((EDGE(KCGX2,J)*NSAME)+EDGE(KCGX2,NE))/(NSAME+1)
65         EDGE(KCGY2,J)=((EDGE(KCGY2,J)*NSAME)+EDGE(KCGY2,NE))/(NSAME+1)
66         EDGE(KCGZ2,J)=((EDGE(KCGZ2,J)*NSAME)+EDGE(KCGZ2,NE))/(NSAME+1)
67         NSAME = NSAME + 1
68         GOTO 800
69 *
70   710   J      = J - 1
71         GOTO 800
72 *
73   720   J      = J + 1
74         EDGE(KCGAE,J) = EDGE(KCGAE,NE)
75         EDGE(KCGX1,J) = EDGE(KCGX1,NE)
76         EDGE(KCGY1,J) = EDGE(KCGY1,NE)
77         EDGE(KCGZ1,J) = EDGE(KCGZ1,NE)
78         EDGE(KCGX2,J) = EDGE(KCGX2,NE)
79         EDGE(KCGY2,J) = EDGE(KCGY2,NE)
80         EDGE(KCGZ2,J) = EDGE(KCGZ2,NE)
81         NSAME = 1
82   800   CONTINUE
83       NEDGE  = J
84 *
85   810 DO 900 NE=1,NEDGE
86         ANE    = EDGE(KCGAE,NE)
87         IF (ANE .GE. -3.)       GOTO 850
88         ANE    = ANE + 4.
89         X      = EDGE(KCGX1,NE)
90         Y      = EDGE(KCGY1,NE)
91         Z      = EDGE(KCGZ1,NE)
92         EDGE(KCGX1,NE) = EDGE(KCGX2,NE)
93         EDGE(KCGY1,NE) = EDGE(KCGY2,NE)
94         EDGE(KCGZ1,NE) = EDGE(KCGZ2,NE)
95         EDGE(KCGX2,NE) = X
96         EDGE(KCGY2,NE) = Y
97         EDGE(KCGZ2,NE) = Z
98   850   IF (ANE .LT. -1.)       ANE = ANE + 2.
99         EDGE(KCGAE,NE) = ANE
100   900   CONTINUE
101 *
102   999 RETURN
103       END