[u/mrichter/AliRoot.git] / GEANT321 / gbase / ggclo2.F

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