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