5 * Revision 1.1.1.1 1995/10/24 10:20:49 cernlib
9 #include "geant321/pilot.h"
10 *CMZ : 3.21/02 29/03/94 15.41.28 by S.Giani
12 SUBROUTINE GGORD (IVO)
14 C. *****************************************************************
16 C. * Find and order the boundaries of the contents of the *
17 C. * IVOth volume, with respect to coordinate IAX : *
21 C. * IAX = 4 Rxy (static ordering only -> GTMEDI) *
22 C. * IAX = 14 Rxy (also dynamic ordering -> GTNEXT) *
23 C. * IAX = 5 Rxyz (static ordering only -> GTMEDI) *
24 C. * IAX = 15 Rxyz (also dynamic ordering -> GTNEXT) *
25 C. * IAX = 6 PHI (PHI=0 => X axis) *
26 C. * IAX = 7 THETA (THETA=0 => Z axis) *
28 C. * Called by : GGCLOS *
29 C. * Authors : R.Brun, F.Bruyant, A.McPherson ********* *
31 C. *****************************************************************
33 #include "geant321/gcbank.inc"
34 #include "geant321/gcunit.inc"
35 DIMENSION CLOW(500),CHIGH(500),CORD(1000),ITYPE(1000),
36 +ICONT(500),ICON(1000),ICONS(500)
38 EQUIVALENCE (CLOW(1),WS(1)),(CHIGH(1),WS(501))
39 EQUIVALENCE (CORD(1),WS(1001)),(ITYPE(1),WS(2001))
40 EQUIVALENCE (ICONT(1),WS(3001)),(ICON(1),WS(3501))
41 EQUIVALENCE (ICONS(1),WS(4501)),(P(1),WS(5001))
43 C. ------------------------------------------------------------------
49 * *** Inhibit dynamic ordering in Rxy and R unless explicitly required
50 * by user (ordering axis 14 or 15)
52 IF(IAX.EQ.4.OR.IAX.EQ.5)THEN
54 * *** Only static ordering allowed, dynamic inhibited (GNEXT,GTNEXT)
62 * *** Find the upper and lower coordinates of each content
65 CALL GFCLIM (JVO, IN, IAX, CLOW(IN), CHIGH(IN), IERR)
72 WRITE (CHMAIL, 1001) IQ(JVOLUM+IVOT), INUMT, IQ(JVOLUM+IVO),
79 * *** Order the coordinate limits, keeping track of the associated
82 CALL GFCORD (NIN, CLOW, CHIGH, CORD, ITYPE, ICON)
84 * *** Book the JSB bank to store the boundaries
87 IF(LQ(JNEAR).EQ.0) THEN
88 CALL MZBOOK (IXCONS,JSB,JNEAR,0,'VOBO',0,0,NIN*2+2,3,0)
98 * ** Count and load up the distinct boundaries
103 Q(JSB+IBO+2) = CORD(IC)
104 IF (IBO.EQ.1) GO TO 60
105 IF (CORD(IC)-CORD(IC-1).LT.1.E-4) IBO = IBO -1
109 IF (IAX.EQ.6) NDIV = IBO
111 * ** Book the JSC0 bank to store the number of contents in each
112 * section (between neighbouring boundaries)
116 CALL MZDROP(IXCONS,JSC0,'L')
118 CALL MZBOOK (IXCONS,JSC0,JVO,-NIN-2,'VOBC',NDIV,NDIV,NDIV,2,0)
121 * * Load up number of contents in each section and when greater
122 * than 0 book and load bank of contents
127 IF (IAX.NE.6) GO TO 70
132 IF (CHIGH(IN).GT.CLOW(IN)) GO TO 65
133 * (this content straddles PHI=0.)
136 IF (ICON(1).EQ.IN) GO TO 65
137 * (IN is in 1st division as well)
142 IF (ITYPE(1).EQ.2) GO TO 70
143 * (first boundary is a low, add the new content)
145 ICONT(NCONT) = ICON(1)
151 IF (CORD(IC)-CORD(IC-1).LT.1.E-4) GO TO 90
153 * New division, load up last division
155 IQ(JSC0+IDIV) = NCONT
156 IF (NCONT.LE.0) GO TO 100
158 * Book bank for contents
160 CALL MZBOOK (IXCONS,JSCV,JSC0,-IDIV,'VODC',0,0,NCONT,2,0)
167 IQ(JSCV+ICNT) = ICONT(ICNT)
176 * Update contents of current division
178 IF (ITYPE(IC).EQ.1) GO TO 120
180 * This boundary was a high, so one less content
183 DO 110 ICNT = 1,NCONT
184 IF (ICONT(ICNT).EQ.ICON(IC)) ICP=1
185 IF (ICP.EQ.1) ICONT(ICNT) = ICONT(ICNT+1)
192 * This boundary was a low, so one extra content
195 ICONT(NCONT) = ICON(IC)
199 IF (IAX.NE.6) GO TO 150
200 IQ(JSC0+NDIV) = NSTOR
201 IF (NSTOR.EQ.0) GO TO 150
202 CALL MZBOOK (IXCONS,JSCV,JSC0,-NDIV,'VOID',0,0,NSTOR,2,0)
205 IQ(JSCV+IS) = ICONS(IS)
211 IF (IQ(JSC0+I).GT.1) GO TO 999
213 IQ(JSC0) = IBSET(IQ(JSC0),0)
215 1001 FORMAT (' GGORD : Error in GFCLIM for content ',A4,I7,' in ',A4,
216 + ' along axis',I5,' IROT= ',I5)