This commit was generated by cvs2svn to compensate for changes in r2,
[u/mrichter/AliRoot.git] / GEANT321 / cgpack / cgshel.F
1 *
2 * $Id$
3 *
4 * $Log$
5 * Revision 1.1.1.1  1995/10/24 10:19:44  cernlib
6 * Geant
7 *
8 *
9 #include "geant321/pilot.h"
10 *CMZ :  3.21/02 29/03/94  15.41.32  by  S.Giani
11 *-- Author :
12       SUBROUTINE CGSHEL(ATRINV,ERROR,NEDGE,EDGE)
13 ************************************************************************
14 *                                                                      *
15 *     Name: CGSHEL                                                     *
16 *     Author: E. Chernyaev                       Date:    13.04.89     *
17 *                                                Revised:              *
18 *                                                                      *
19 *     Function: Shell sort of edges                                    *
20 *                                                                      *
21 *     References: none                                                 *
22 *                                                                      *
23 *     Input:  ATRINV - atribute decrement for inverse edges            *
24 *             ERROR  - presision error                                 *
25 *     Output: NEDGE - number of edges                                  *
26 *             EDGE(*,*)  - edges                                       *
27 *                                                                      *
28 *     Output:                                                          *
29 *                                                                      *
30 *     Errors: none                                                     *
31 *                                                                      *
32 ************************************************************************
33 #include "geant321/cggpar.inc"
34       REAL      EDGE(LCGEDG,*),SAVE(LCGEDG)
35 *-
36       IF (NEDGE .LE. 1)                 GOTO 999
37       KE     = 0
38       DO 200 NE=1,NEDGE
39         IF (EDGE(KCGX1,NE) .GT. EDGE(KCGX2,NE)+ERROR)   GOTO 120
40         IF (EDGE(KCGX1,NE) .LT. EDGE(KCGX2,NE)-ERROR)   GOTO 110
41         IF (EDGE(KCGY1,NE) .GT. EDGE(KCGY2,NE)+ERROR)   GOTO 120
42         IF (EDGE(KCGY1,NE) .LT. EDGE(KCGY2,NE)-ERROR)   GOTO 110
43         IF (EDGE(KCGZ1,NE) .GT. EDGE(KCGZ2,NE)+ERROR)   GOTO 120
44         IF (EDGE(KCGZ1,NE) .LT. EDGE(KCGZ2,NE)-ERROR)   GOTO 110
45         GOTO 200
46   110   KE     = KE + 1
47         IF (KE .EQ. NE)         GOTO 200
48         EDGE(KCGAE,KE) = EDGE(KCGAE,NE)
49         EDGE(KCGX1,KE) = EDGE(KCGX1,NE)
50         EDGE(KCGY1,KE) = EDGE(KCGY1,NE)
51         EDGE(KCGZ1,KE) = EDGE(KCGZ1,NE)
52         EDGE(KCGX2,KE) = EDGE(KCGX2,NE)
53         EDGE(KCGY2,KE) = EDGE(KCGY2,NE)
54         EDGE(KCGZ2,KE) = EDGE(KCGZ2,NE)
55         GOTO 200
56   120   KE     = KE + 1
57         EDGE(KCGAE,KE) = EDGE(KCGAE,NE)-ATRINV
58         X      = EDGE(KCGX1,NE)
59         Y      = EDGE(KCGY1,NE)
60         Z      = EDGE(KCGZ1,NE)
61         EDGE(KCGX1,KE) = EDGE(KCGX2,NE)
62         EDGE(KCGY1,KE) = EDGE(KCGY2,NE)
63         EDGE(KCGZ1,KE) = EDGE(KCGZ2,NE)
64         EDGE(KCGX2,KE) = X
65         EDGE(KCGY2,KE) = Y
66         EDGE(KCGZ2,KE) = Z
67   200   CONTINUE
68       NEDGE = KE
69 *
70 **          S H E L L   S O R T   O F   E D G E S
71 *
72       IF (NEDGE .LE. 1)                 GOTO 999
73       ISTEP  = 1
74   210 ISTEP  = ISTEP*3 + 1
75       IF (ISTEP*2 .LT. NEDGE)           GOTO 210
76 *
77   300 ISTEP  = ISTEP/3
78       DO 500 I=1,NEDGE-ISTEP
79         J1    = I
80         J2    = I + ISTEP
81 *           I F  (E D G E (J 1)  .L E.  E D G E (J 2))  G O T O  5 0 0
82         IF (EDGE(KCGX1,J1) .LT. EDGE(KCGX1,J2)-ERROR)   GOTO 500
83         IF (EDGE(KCGX1,J1) .GT. EDGE(KCGX1,J2)+ERROR)   GOTO 350
84         IF (EDGE(KCGY1,J1) .LT. EDGE(KCGY1,J2)-ERROR)   GOTO 500
85         IF (EDGE(KCGY1,J1) .GT. EDGE(KCGY1,J2)+ERROR)   GOTO 350
86         IF (EDGE(KCGZ1,J1) .LT. EDGE(KCGZ1,J2)-ERROR)   GOTO 500
87         IF (EDGE(KCGZ1,J1) .GT. EDGE(KCGZ1,J2)+ERROR)   GOTO 350
88         IF (EDGE(KCGX2,J1) .LT. EDGE(KCGX2,J2)-ERROR)   GOTO 500
89         IF (EDGE(KCGX2,J1) .GT. EDGE(KCGX2,J2)+ERROR)   GOTO 350
90         IF (EDGE(KCGY2,J1) .LT. EDGE(KCGY2,J2)-ERROR)   GOTO 500
91         IF (EDGE(KCGY2,J1) .GT. EDGE(KCGY2,J2)+ERROR)   GOTO 350
92         IF (EDGE(KCGZ2,J1) .LT. EDGE(KCGZ2,J2)-ERROR)   GOTO 500
93         IF (EDGE(KCGZ2,J1) .GT. EDGE(KCGZ2,J2)+ERROR)   GOTO 350
94         GOTO 500
95 *            S A V E = E D G E (J 2)
96   350   SAVE(KCGAE) = EDGE(KCGAE,J2)
97         SAVE(KCGX1) = EDGE(KCGX1,J2)
98         SAVE(KCGY1) = EDGE(KCGY1,J2)
99         SAVE(KCGZ1) = EDGE(KCGZ1,J2)
100         SAVE(KCGX2) = EDGE(KCGX2,J2)
101         SAVE(KCGY2) = EDGE(KCGY2,J2)
102         SAVE(KCGZ2) = EDGE(KCGZ2,J2)
103 *            E D G E (J 2) = E D G E (J 1)
104   400   EDGE(KCGAE,J2) = EDGE(KCGAE,J1)
105         EDGE(KCGX1,J2) = EDGE(KCGX1,J1)
106         EDGE(KCGY1,J2) = EDGE(KCGY1,J1)
107         EDGE(KCGZ1,J2) = EDGE(KCGZ1,J1)
108         EDGE(KCGX2,J2) = EDGE(KCGX2,J1)
109         EDGE(KCGY2,J2) = EDGE(KCGY2,J1)
110         EDGE(KCGZ2,J2) = EDGE(KCGZ2,J1)
111         J2     = J1
112         J1     = J1 - ISTEP
113         IF (J1 .LE. 0)     GOTO 450
114 *           I F  (E D G E (J 1) .G T. S A V E)  G O T O  4 0 0
115         IF (EDGE(KCGX1,J1) .LT. SAVE(KCGX1)-ERROR)      GOTO 450
116         IF (EDGE(KCGX1,J1) .GT. SAVE(KCGX1)+ERROR)      GOTO 400
117         IF (EDGE(KCGY1,J1) .LT. SAVE(KCGY1)-ERROR)      GOTO 450
118         IF (EDGE(KCGY1,J1) .GT. SAVE(KCGY1)+ERROR)      GOTO 400
119         IF (EDGE(KCGZ1,J1) .LT. SAVE(KCGZ1)-ERROR)      GOTO 450
120         IF (EDGE(KCGZ1,J1) .GT. SAVE(KCGZ1)+ERROR)      GOTO 400
121         IF (EDGE(KCGX2,J1) .LT. SAVE(KCGX2)-ERROR)      GOTO 450
122         IF (EDGE(KCGX2,J1) .GT. SAVE(KCGX2)+ERROR)      GOTO 400
123         IF (EDGE(KCGY2,J1) .LT. SAVE(KCGY2)-ERROR)      GOTO 450
124         IF (EDGE(KCGY2,J1) .GT. SAVE(KCGY2)+ERROR)      GOTO 400
125         IF (EDGE(KCGZ2,J1) .LT. SAVE(KCGZ2)-ERROR)      GOTO 450
126         IF (EDGE(KCGZ2,J1) .GT. SAVE(KCGZ2)+ERROR)      GOTO 400
127 *           E D G E (J 2) = S A V E
128   450   EDGE(KCGAE,J2) = SAVE(KCGAE)
129         EDGE(KCGX1,J2) = SAVE(KCGX1)
130         EDGE(KCGY1,J2) = SAVE(KCGY1)
131         EDGE(KCGZ1,J2) = SAVE(KCGZ1)
132         EDGE(KCGX2,J2) = SAVE(KCGX2)
133         EDGE(KCGY2,J2) = SAVE(KCGY2)
134         EDGE(KCGZ2,J2) = SAVE(KCGZ2)
135   500   CONTINUE
136       IF (ISTEP .NE. 1)         GOTO 300
137 *
138   999 RETURN
139       END