]> git.uio.no Git - u/mrichter/AliRoot.git/blame - GEANT321/cgpack/cgshel.F
git://git.uio.no / u / mrichter / AliRoot.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Make the default config without ZDC
[u/mrichter/AliRoot.git] / GEANT321 / cgpack / cgshel.F
CommitLineData
fe4da5cc 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