Bugfix in AliPoints2Memory
[u/mrichter/AliRoot.git] / GEANT321 / gbase / ggclo2.F
1 *
2 * $Id$
3 *
4 * $Log$
5 * Revision 1.1.1.1  1999/05/18 15:55:16  fca
6 * AliRoot sources
7 *
8 * Revision 1.1.1.1  1995/10/24 10:20:11  cernlib
9 * Geant
10 *
11 *
12 #include "geant321/pilot.h"
13 #if defined(CERNLIB_OLD)
14 *CMZ :  3.21/02 29/03/94  15.41.19  by  S.Giani
15 *-- Author :
16       SUBROUTINE GGCLOS
17 C.
18 C.    ******************************************************************
19 C.    *                                                                *
20 C.    *    Closes off the geometry setting.                            *
21 C.    *    Initializes the search list for the contents of each        *
22 C.    *    volume following the order they have been positioned, and   *
23 C.    *    inserting the content '0' when a call to GSNEXT (-1) has    *
24 C.    *    been required by the user.                                  *
25 C.    *    Performs the development of the JVOLUM structure for all    *
26 C.    *    volumes with variable parameters, by calling GGDVLP.        *
27 C.    *    Interprets the user calls to GSORD, through GGORD.          *
28 C.    *    Computes and stores in a bank (next to JVOLUM mother bank)  *
29 C.    *    the number of levels in the geometrical tree and the        *
30 C.    *    maximum number of contents per level, by calling GGNLEV.    *
31 C.    *    Sets status bit for CONCAVE volumes, through GGCAVE.        *
32 C.    *    Completes the JSET structure with the list of volume names  *
33 C.    *    which identify uniquely a given physical detector, the      *
34 C.    *    list of bit numbers to pack the corresponding volume copy   *
35 C.    *    numbers, and the generic path(s) in the JVOLUM tree,        *
36 C.    *    through the routine GHCLOS.                                 *
37 C.    *                                                                *
38 C.    *    Called by : <USER>                                          *
39 C.    *    Authors   : R.Brun, F.Bruyant  *********                    *
40 C.    *                                                                *
41 C.    *    Modified by S.Egli at 15.9.90: automatic sorting of volumes *
42 C     *    done by calling GGORDQ for each volume                      *
43 C.    ******************************************************************
44 C.
45 #include "geant321/gcbank.inc"
46 #include "geant321/gcflag.inc"
47 #include "geant321/gclist.inc"
48 #include "geant321/gcnum.inc"
49 #include "geant321/gcunit.inc"
50 #include "geant321/gcopti.inc"
51       CHARACTER*4 NAME
52       LOGICAL BTEST
53 C.
54 C.    ------------------------------------------------------------------
55 C.
56 *
57 * *** Stop the run in case of serious anomaly during initialization
58 *
59       IF (IEORUN.NE.0) THEN
60          WRITE (CHMAIL, 1001)
61          CALL GMAIL (0, 0)
62          STOP
63       ENDIF
64 *
65       IF (NVOLUM.LE.0) THEN
66          WRITE (CHMAIL, 1002) NVOLUM
67          CALL GMAIL (0, 0)
68          GO TO 999
69       ENDIF
70 *
71       NPUSH = NVOLUM -IQ(JVOLUM-2)
72       CALL MZPUSH (IXCONS, JVOLUM, NPUSH, NPUSH,'I')
73 *
74 * *** Loop over volumes, create default JNear banks as relevant,
75 *      and release unused bank space
76 *
77       IDO = 0
78       DO 80 IVO = 1,NVOLUM
79          JVO = LQ(JVOLUM-IVO)
80 *
81 * *** Check if Tracking medium has been defined
82 *
83          NMED=Q(JVO+4)
84          IF(NMED.LE.0.OR.NMED.GT.IQ(JTMED-2))THEN
85             WRITE(CHMAIL,1003)IQ(JVOLUM+IVO)
86             CALL GMAIL (0, 0)
87          ELSE
88             IF(LQ(JTMED-NMED).EQ.0)THEN
89                WRITE(CHMAIL,1003)IQ(JVOLUM+IVO)
90                CALL GMAIL (0, 0)
91             ENDIF
92          ENDIF
93          IF (BTEST(IQ(JVO),0)) GO TO 80
94          IDO = 1
95          IQ(JVO) = IBSET(IQ(JVO),0)
96          NINL  = IQ(JVO-2)
97          NIN   = Q(JVO+3)
98          NUSED = IABS(NIN)
99          IF (NIN.GT.0) THEN
100 *           reserve enough additional space for sorted volumes
101             IF(NIN.LE.1.OR.NIN.GT.500.OR.IOPTIM.LT.0)THEN
102               NUSED=NUSED+1
103             ELSE
104               NUSED=NUSED+2
105             ENDIF
106          ENDIF
107 *
108          NPUSH = NUSED -NINL
109          DO 90 IN=NINL,NUSED+1,-1
110             JIN = LQ(JVO-IN)
111             IF(JIN.GT.0) THEN
112                CALL MZDROP(IXCONS,JIN,'L')
113             ENDIF
114   90     CONTINUE
115          CALL MZPUSH (IXCONS, JVO, NPUSH, 0, 'I')
116          IF (NIN.LE.0) GO TO 80
117 *
118          IF(BTEST(IQ(JVO),3)) THEN
119             IZERO=1
120          ELSE
121             IZERO=0
122          ENDIF
123          NEL = NIN +IZERO
124          JN = LQ(JVO-NIN-1)
125          IF(JN.EQ.0) THEN
126             CALL MZBOOK (IXCONS,JN,JVO,-NIN-1,'VONE',0,0,NEL+1,2,0)
127          ENDIF
128          IQ(JN-5) = IVO
129          IQ(JN+1) = NEL
130          JN = JN +1
131          DO 29 I = 1,NIN
132             IQ(JN+IZERO+I) = I
133    29    CONTINUE
134          IF (IZERO.NE.0) IQ(JN+1) = 0
135 *
136    80 CONTINUE
137 *
138       IF (IDO.NE.0) THEN
139 *
140 * ***    Perform development of JVOLUM structure where necessary
141 *
142          CALL GGDVLP
143 *
144 * ***    Fill GSORD ordering banks if required
145 *
146 * Modified by S.Egli to allow GGORDQ to find the optimum sorting for
147 * all volumes
148 *
149          IF(IOPTIM.GE.1)THEN
150             WRITE(6,'(A)')' GGCLOS: Start automatic volume ordering:'
151          ENDIF
152          DO 91 IVO = 1,NVOLUM
153             JVO = LQ(JVOLUM-IVO)
154             NIN = Q(JVO+3)
155             ISEARC=Q(JVO+1)
156             IF(ISEARC.GT.0) GO TO 91
157 *           check if sorting not possible or not wanted
158             IF(NIN.LE.1.OR.NIN.GT.500.OR.IOPTIM.LT.0)THEN
159                Q(JVO+1)=0.
160                IF(NIN.GT.500.AND.IOPTIM.GE.1)THEN
161                  CALL UHTOC(IQ(JVOLUM+IVO),4,NAME,4)
162                  WRITE (CHMAIL,1004) NAME,NIN
163                  CALL  GMAIL (0, 0)
164                ENDIF
165             ELSEIF(IOPTIM.EQ.0)THEN
166                IF(ISEARC.LT.0)CALL GGORD (IVO)
167             ELSEIF(IOPTIM.EQ.1)THEN
168                IF(ISEARC.EQ.0) THEN
169                   CALL GGORDQ(IVO)
170                ELSE
171                   CALL GGORD (IVO)
172                END IF
173             ELSE
174                CALL GGORDQ(IVO)
175             ENDIF
176    91    CONTINUE
177 *
178 * ***    Set status bit for concave volumes
179 *
180          CALL GGCAVE
181 *
182 * ***    Compute maximum number of levels and of contents per level
183 *
184          CALL GGNLEV
185 *
186       ENDIF
187 *
188 * *** Scan the volume structure to retrieve the path through
189 *      the physical tree for all sensitive detectors
190 *
191        CALL GHCLOS
192 *
193 * *** Books STAT banks if data card STAT is submitted
194 *
195       IF (NSTAT.GT.0)  CALL GBSTAT
196 *
197       CALL MZGARB (IXCONS, 0)
198 *
199  1001 FORMAT (' Severe diagnostic in initialization phase. STOP')
200  1002 FORMAT (' GGCLOS : NVOLUM =',I5,' *****')
201  1003 FORMAT (' Illegal tracking medium number in volume : ',A4)
202  1004 FORMAT (' GGORDQ : Volume ',A4,' has more than 500 (',
203      +        I3,') daughters ; volume sorting not possible !')
204 *                                                             END GGCLOS
205   999 END
206 #else
207       SUBROUTINE GGCLO2_DUMMY
208       END
209 #endif