]>
Commit | Line | Data |
---|---|---|
fe4da5cc | 1 | * |
2 | * $Id$ | |
3 | * | |
4 | * $Log$ | |
9e1a0ddb | 5 | * Revision 1.1.1.1 1999/05/18 15:55:17 fca |
6 | * AliRoot sources | |
7 | * | |
fe4da5cc | 8 | * Revision 1.1.1.1 1995/10/24 10:20:49 cernlib |
9 | * Geant | |
10 | * | |
11 | * | |
12 | #include "geant321/pilot.h" | |
13 | *CMZ : 3.21/02 29/03/94 15.41.28 by S.Giani | |
14 | *-- Author : | |
15 | SUBROUTINE GGORDQ (IVO) | |
16 | C. | |
17 | C. ***************************************************************** | |
18 | C. * * | |
19 | C. * Find and order the boundaries of the contents of the * | |
20 | C. * IVOth volume, with respect to coordinate IAX : * | |
21 | C. * IAX = 1 X Axis * | |
22 | C. * IAX = 2 Y Axis * | |
23 | C. * IAX = 3 Z Axis * | |
24 | C. * IAX = 4 Rxy * | |
25 | C. * IAX = 5 Rxyz * | |
26 | C. * IAX = 6 PHI (PHI=0 => X axis) * | |
27 | C. * IAX = 7 THETA (THETA=0 => Z axis) * | |
28 | C. * All values of IAX will be tried and then that value is * | |
29 | C. * chosen, that results in the smallest number of volumes per * | |
30 | C. * division. * | |
31 | C. * Called by : GGCLOS * | |
32 | C. * Author: Stephan Egli (large parts are copies of GGORD) * | |
33 | C. * * | |
34 | C. ***************************************************************** | |
35 | C. | |
36 | #include "geant321/gcbank.inc" | |
37 | #include "geant321/gcunit.inc" | |
9e1a0ddb | 38 | #include "geant321/gcflag.inc" |
fe4da5cc | 39 | * |
40 | ||
41 | DIMENSION CLOW(500),CHIGH(500),CORD(1000),ITYPE(1000), | |
42 | +ICONT(500),ICON(1000),ICONS(500) | |
43 | EQUIVALENCE (CLOW(1),WS(1)),(CHIGH(1),WS(501)) | |
44 | EQUIVALENCE (CORD(1),WS(1001)),(ITYPE(1),WS(2001)) | |
45 | EQUIVALENCE (ICONT(1),WS(3001)),(ICON(1),WS(3501)) | |
46 | EQUIVALENCE (ICONS(1),WS(4501)) | |
47 | C | |
48 | CHARACTER*4 NAME | |
49 | ||
50 | C. ------------------------------------------------------------------ | |
51 | * | |
52 | JVO = LQ(JVOLUM-IVO) | |
53 | CALL UHTOC(IQ(JVOLUM+IVO),4,NAME,4) | |
54 | NIN = Q(JVO+3) | |
55 | IAXNOW = 0 | |
56 | IF(IQ(JVO-2).EQ.NIN+2) THEN | |
57 | * | |
58 | * *** This is to allow re-entry in the routine from the interactive | |
59 | * *** version. | |
60 | JNEAR = LQ(JVO-NIN-1) | |
61 | IF(JNEAR.GT.0) THEN | |
62 | JSB = LQ(JNEAR) | |
63 | IF(JSB.GT.0) THEN | |
64 | IAXNOW = Q(JSB+1) | |
65 | ENDIF | |
66 | ENDIF | |
67 | ENDIF | |
68 | IF(IAXNOW.EQ.0) THEN | |
69 | IAXNOW=-Q(JVO+1) | |
70 | ENDIF | |
71 | * assume that ordering can not be done unless proven otherwise | |
72 | Q(JVO+1)=0. | |
73 | RBEST=1.E9 | |
74 | ||
75 | * try all possible axes | |
76 | ||
77 | DO 1 IAX=1,7 | |
78 | ||
79 | * count number of additional words needed and total number of volumes | |
80 | * in all divisions | |
81 | ||
82 | NCOALL=0 | |
83 | * | |
84 | * *** Find the upper and lower coordinates of each content | |
85 | * | |
86 | DO 50 IN = 1,NIN | |
87 | CALL GFCLIM (JVO, IN, IAX, CLOW(IN), CHIGH(IN), IERR) | |
88 | IF (IERR.NE.0) GOTO 1 | |
89 | 50 CONTINUE | |
90 | * | |
91 | * *** Order the coordinate limits, keeping track of the associated | |
92 | * content number | |
93 | * | |
94 | CALL GFCORD (NIN, CLOW, CHIGH, CORD, ITYPE, ICON) | |
95 | NC = NIN*2 | |
96 | * | |
97 | * ** Count and load up the distinct boundaries | |
98 | * | |
99 | IBO = 0 | |
100 | DO 60 IC = 1,NC | |
101 | IBO = IBO +1 | |
102 | IF (IBO.EQ.1) GO TO 60 | |
103 | IF (CORD(IC)-CORD(IC-1).LT.1.E-4) IBO = IBO -1 | |
104 | 60 CONTINUE | |
105 | NDIV = IBO -1 | |
106 | IF (IAX.EQ.6) NDIV = IBO | |
107 | ||
108 | * * Load up number of contents in each section | |
109 | * | |
110 | IDIV = 0 | |
111 | NCONT = 1 | |
112 | ICONT(1)= ICON(1) | |
113 | IF (IAX.NE.6) GO TO 70 | |
114 | NCONT = 0 | |
115 | NSTOR = 0 | |
116 | ICONT(1)= 0 | |
117 | DO 65 IN = 1,NIN | |
118 | IF (CHIGH(IN).GT.CLOW(IN)) GO TO 65 | |
119 | * (this content straddles PHI=0.) | |
120 | NSTOR = NSTOR +1 | |
121 | ICONS(NSTOR) = IN | |
122 | IF (ICON(1).EQ.IN) GO TO 65 | |
123 | * (IN is in 1st division as well) | |
124 | NCONT = NCONT +1 | |
125 | ICONT(NCONT) = IN | |
126 | 65 CONTINUE | |
127 | * | |
128 | IF (ITYPE(1).EQ.2) GO TO 70 | |
129 | * (first boundary is a low, add the new content) | |
130 | NCONT = NCONT +1 | |
131 | ICONT(NCONT) = ICON(1) | |
132 | * | |
133 | 70 CONTINUE | |
134 | * | |
135 | DO 130 IC = 2,NC | |
136 | IDIV = IDIV +1 | |
137 | IF (CORD(IC)-CORD(IC-1).LT.1.E-4) GO TO 90 | |
138 | * | |
139 | * New division, load up last division | |
140 | * | |
141 | IF (NCONT.LE.0) GO TO 100 | |
142 | NCOALL=NCOALL+NCONT | |
143 | GO TO 100 | |
144 | 90 CONTINUE | |
145 | IDIV = IDIV -1 | |
146 | * | |
147 | 100 CONTINUE | |
148 | * | |
149 | * Update contents of current division | |
150 | * | |
151 | IF (ITYPE(IC).EQ.1) GO TO 120 | |
152 | * | |
153 | * This boundary was a high, so one less content | |
154 | * | |
155 | ICP = 0 | |
156 | DO 110 ICNT = 1,NCONT | |
157 | IF (ICONT(ICNT).EQ.ICON(IC)) ICP=1 | |
158 | IF (ICP.EQ.1) ICONT(ICNT) = ICONT(ICNT+1) | |
159 | 110 CONTINUE | |
160 | NCONT = NCONT -1 | |
161 | GO TO 130 | |
162 | * | |
163 | 120 CONTINUE | |
164 | * | |
165 | * This boundary was a low, so one extra content | |
166 | * | |
167 | NCONT = NCONT +1 | |
168 | ICONT(NCONT) = ICON(IC) | |
169 | * | |
170 | 130 CONTINUE | |
171 | * | |
172 | IF(IAX.EQ.6) NCOALL = NCOALL+NSTOR | |
173 | RNOW=FLOAT(NCOALL)/NDIV | |
174 | IF(RNOW.LT.RBEST)THEN | |
175 | IAXOPT=IAX | |
176 | RBEST=RNOW | |
177 | NDIVB=NDIV | |
178 | ENDIF | |
179 | ||
180 | * end of loop over IAX | |
181 | ||
182 | 1 CONTINUE | |
183 | ||
184 | ||
185 | * now the best axis is selected - compare with axis requested by CALL | |
186 | * to GSORD (if any) | |
187 | ||
188 | IF(IAXNOW.GT.0)THEN | |
189 | ||
9e1a0ddb | 190 | IF(IDEBUG.NE.0) THEN |
191 | WRITE (CHMAIL,1002) NAME,NIN,IAXOPT,NDIVB,RBEST,IAXNOW | |
192 | CALL GMAIL (0, 0) | |
fe4da5cc | 193 | 1002 FORMAT(' GGORDQ : Volume ',A4,2X,'NIN=',I4,' IAX=',I2,2X, |
194 | + 'NDIV=',I3,2X,'NVOL/DIV=',F5.1,2X,'IAX wanted by user:',I2) | |
9e1a0ddb | 195 | ENDIF |
fe4da5cc | 196 | |
197 | ELSE | |
9e1a0ddb | 198 | |
199 | IF(IDEBUG.NE.0) THEN | |
200 | WRITE (CHMAIL,1003) NAME,NIN,IAXOPT,NDIVB,RBEST | |
201 | CALL GMAIL (0, 0) | |
fe4da5cc | 202 | 1003 FORMAT(' GGORDQ : Volume ',A4,2X,'NIN=',I4,' IAX=',I2,2X, |
203 | + 'NDIV=',I3,2X,'NVOL/DIV=',F5.1) | |
9e1a0ddb | 204 | ENDIF |
fe4da5cc | 205 | |
206 | ENDIF | |
207 | ||
208 | * overwrite old axis and store sorting information for new axis | |
209 | ||
210 | Q(JVO+1)=-IAXOPT | |
211 | CALL GGORD(IVO) | |
212 | ||
213 | END |