[u/mrichter/AliRoot.git] / GEANT321 / ggeom / ggdvlp.F

*
* $Id$
*
* $Log$
* Revision 1.1.1.1  1995/10/24 10:20:49  cernlib
* Geant
*
*
#include "geant321/pilot.h"
*CMZ :  3.21/02 29/03/94  15.41.28  by  S.Giani
*-- Author :
      SUBROUTINE GGDVLP
C.
C.    ******************************************************************
C.    *                                                                *
C.    *    SUBR. GGDVLP                                                *
C.    *                                                                *
C.    *   DeVeLoPs locally the JVOLUM structure so as not to have to   *
C.    *   recompute variable parameters and division specifications    *
C.    *   at tracking time.                                            *
C.    *                                                                *
C.    *   Called by : GGCLOS                                           *
C.    *   Authors   : S.Banerjee, F.Bruyant                            *
C.    *                                                                *
C.    ******************************************************************
C.
#include "geant321/gcbank.inc"
#include "geant321/gcnum.inc"
#include "geant321/gcunit.inc"
C.
      PARAMETER (NLVMAX=15, NPAMAX=50)
C.
      COMMON /GCDVLP/ LREF(2), JVO, LJVOM(NLVMAX), LLVODV(NLVMAX), LVODV
C.
      INTEGER     ILINK(NLVMAX), LVAR(NPAMAX), NLINK(NLVMAX)
      INTEGER     NUMB(NLVMAX+1), NBGN(NLVMAX+1), IVOL(5200)
      EQUIVALENCE (IVOL(1), WS(1))
      REAL        PAR(NPAMAX)
      LOGICAL     BTEST
C.
C.    ------------------------------------------------------------------
*
      CALL MZLINT (IXSTOR, '/GCDVLP/', LREF, JVO, LVODV)
*
      CALL MZFORM ('VODV', '1I 2F 2I -F', IOVODV)
*
* *** Create the volume tree in memory
*
      IF (NVOLUM.LT.1) GO TO 990
      NUMB(1) = 1
      NBGN(1) = 1
      IVOL(1) = 1
      NLVT = 1
*
   10 NLEV = NLVT + 1
      NUMB(NLEV) = 0
      NBGN(NLEV) = NBGN(NLVT) + NUMB(NLVT)
      DO 30 I = 1, NUMB(NLVT)
         IVO  = IVOL(NBGN(NLVT) + I - 1)
         JVO  = LQ(JVOLUM-IVO)
         NIN  = Q(JVO+3)
         IF (NIN.GT.0) THEN
            DO 20 IN = 1, NIN
               JIN  = LQ(JVO-IN)
               IVOT = Q(JIN+2)
               DO 15 I1 = 1, NUMB(NLEV)
                  IVOS = IVOL(NBGN(NLEV)+I1-1)
                  IF (IVOS.EQ.IVOT) GO TO 20
   15          CONTINUE
               NUMB(NLEV) = NUMB(NLEV) + 1
               I1         = NBGN(NLEV) + NUMB(NLEV) - 1
               IVOL(I1)   = IVOT
   20       CONTINUE
         ELSE IF (NIN.LT.0) THEN
            JDIV = LQ(JVO-1)
            IVOT = Q(JDIV+2)
            DO 25 I1 = 1, NUMB(NLEV)
               IVOS = IVOL(NBGN(NLEV)+I1-1)
               IF (IVOS.EQ.IVOT) GO TO 30
   25       CONTINUE
            NUMB(NLEV) = NUMB(NLEV) + 1
            I1         = NBGN(NLEV) + NUMB(NLEV) - 1
            IVOL(I1)   = IVOT
         ENDIF
   30 CONTINUE
*
      IF (NUMB(NLEV).GT.0) THEN
         NLVT = NLEV
         GO TO 10
      ENDIF
*
      NLEV  = 1
      NLEVS = 1
*
* *** Loop over volumes in a given level
*
  110 IF (NLEVS.GT.NLVT) GO TO 990
      IF (NUMB(NLEVS).GT.0) THEN
         NUMB(NLEVS) = NUMB(NLEVS) - 1
         IVOM  = IVOL(NBGN(NLEVS)+NUMB(NLEVS))
      ELSE
         NLEVS = NLEVS + 1
         GO TO 110
      ENDIF
*
* *** Check if current volume should be locally developed
*
      LJVOM(1) = LQ(JVOLUM-IVOM)
      IF(LQ(LJVOM(1)).GT.0) THEN
         CALL MZDROP(IXCONS,LQ(LJVOM(1)),'L')
      ENDIF
      NIN  = Q(LJVOM(1)+3)
#if defined(CERNLIB_DEBUGG)
      WRITE (CHMAIL,2000) IQ(JVOLUM+IVOM),NIN
      CALL GMAIL (0, 0)
 2000 FORMAT (' GGDVLP : Volume ',A4,'  NIN = ',I3)
#endif
*
*  **  Skip it if not a possible source of local development
*
      IF (NIN.EQ.0)                  GO TO 110
      IF (LQ(LJVOM(1)).NE.0)         GO TO 110
      IF (BTEST(IQ(LJVOM(1)),1))     GO TO 110
      CALL GGVCHK (LJVOM(1), 0, NVAR, LVAR)
      IF (NVAR.NE.0) GO TO 110
*
*  **  Otherwise, analyze contents
*
      IOK = 0
      IF (NIN.LT.0) GO TO 120
*
*   *   Current volume has contents defined by position
*
      DO 119 IN = 1,NIN
         CALL GGVCHK (LJVOM(1), IN, NVAR, LVAR)
         IF (NVAR.NE.0) THEN
*
*         In case a content is found with variable parameters,
*          initialize development
*
            NLINK(1) = NIN
            ILINK(1) = IN
            GO TO 200
         ENDIF
  119 CONTINUE
      GO TO 110
*
*   *   Current volume is divided
*
  120 CALL GGVCHK (LJVOM(1), 1, NVAR, LVAR)
      IF (NVAR.EQ.0) GO TO 110
*
*        If cells have variable sizes, initialize development
*
      IOK  = 2
      JDIV = LQ(LJVOM(1)-1)
      NLINK(1) = Q(JDIV+3)
      ILINK(1) = 1
*
  200 CALL MZBOOK (IXCONS, LLVODV(1), LJVOM(1), 0, 'VODV',
     +                         NLINK(1), NLINK(1), 1, 2, 1)
#if defined(CERNLIB_DEBUGG)
      WRITE (CHMAIL, 2002) ILINK(1), NLINK(1), NVAR
      CALL GMAIL (0, 0)
 2002 FORMAT (' GGDVLP :         I, N, NVAR = ',3I5)
#endif
*
* *** Complete development for current content at current level
*
      IF (IOK.EQ.0) GO TO 250
      IOK = 0
      IQ(LLVODV(1)+1) = NLINK(1)
      GO TO 260
*
  210 NIN = Q(LJVOM(NLEV)+3)
      IF (NIN.LT.0) THEN
         CALL GGVCHK (LJVOM(NLEV), 1, NVAR, LVAR)
      ELSE
         CALL GGVCHK (LJVOM(NLEV), ILINK(NLEV), NVAR, LVAR)
      ENDIF
      IF (NVAR.EQ.0) GO TO 290
#if defined(CERNLIB_DEBUGG)
      WRITE (CHMAIL, 2004) NLEV, ILINK(NLEV), NVAR
      CALL GMAIL (0, 0)
 2004 FORMAT (' GGDVLP :              LEVEL,I,NVAR,NIN = ',4I5)
#endif
      IF (NIN.LT.0)  GO TO 260
*
*  **  Compute actual parameters for current content
*
*   *   Case with contents obtained by position
*
  250 CALL GGPPAR (LJVOM(NLEV), ILINK(NLEV), NVAR,LVAR, LLVODV(NLEV),
     +                                                     NPAR, PAR)
      JIN = LQ(LJVOM(NLEV)-ILINK(NLEV))
      GO TO 270
*
*   *   Case with contents obtained by division
*
  260 CALL GGDPAR (LJVOM(NLEV), ILINK(NLEV), NVAR,LVAR, LLVODV(NLEV),
     +                                                     NPAR, PAR)
      JIN = LQ(LJVOM(NLEV)-1)
*
*  **  Initialize next level down
*
  270 IVO = Q(JIN+2)
      JVO = LQ(JVOLUM-IVO)
      NIN = Q(JVO+3)
      IF (NIN.GE.0) THEN
         IF (NIN.NE.0) IOK = 1
         NL = NIN
      ELSE
         IOK = 2
*
*   *   Current content is divided, compute division specifications
*
         CALL GGDSPE (JVO, NPAR, PAR, NL, NDIV, ORIG, STEP)
      ENDIF
*
      IQ(JVO) = IBSET(IQ(JVO),1)
      CALL MZBOOK (IXCONS, LVODV, LLVODV(NLEV), -ILINK(NLEV), 'VODV',
     +                  NL, NL, NPAR+5, IOVODV, 3)
      IF (IOK.EQ.2) THEN
         IQ(LVODV+1) = NDIV
          Q(LVODV+2) = ORIG
          Q(LVODV+3) = STEP
#if defined(CERNLIB_DEBUGG)
          WRITE (CHMAIL, 2006) NDIV, ORIG, STEP
          CALL GMAIL (0, 0)
 2006     FORMAT (' GGDVLP : After GGDSPE, NDIV ORIG STEP = ',I4,2F10.4)
#endif
      ENDIF
      IQ(LVODV+4) = IVO
      IQ(LVODV+5) = NPAR
      CALL UCOPY (PAR, Q(LVODV+6), NPAR)
#if defined(CERNLIB_DEBUGG)
      WRITE (CHMAIL, 2008)
      CALL GMAIL (0, 0)
 2008 FORMAT (' GGDVLP : Store parameters into development structure')
#endif
*
  290 IF (IOK.EQ.0) THEN
         IF (ILINK(NLEV).EQ.NLINK(NLEV)) THEN
*
*          Go one level up
*
            IF (NLEV.EQ.1) GO TO 110
            NLEV = NLEV -1
            GO TO 290
         ENDIF
*
*       Analyze next content
*
         ILINK(NLEV) = ILINK(NLEV) +1
         GO TO 210
      ENDIF
*
*      A new level has been initialized, start analyzing it
*
      NLEV = NLEV +1
      LJVOM(NLEV)  = JVO
      LLVODV(NLEV) = LVODV
      ILINK(NLEV)  = 1
      NLINK(NLEV)  = NL
      IOK = 0
      GO TO 210
*
  990 DO 991 IVO = 1, NVOLUM
         JVO = LQ(JVOLUM-IVO)
         IF (BTEST(IQ(JVO),1)) THEN
            IF (LQ(JVO).GT.0) THEN
               CALL MZDROP (IXCONS, LQ(JVO), ' ')
               WRITE (CHMAIL, 1001) IQ(JVOLUM+IVO)
            ENDIF
         ENDIF
  991 CONTINUE
      LREF(1) = 0
*
 1001 FORMAT (' GGDVLP : Unnecessary development at volume  ',A4)
*                                                             END GGDVLP
      END
Commit	Line	Data
fe4da5cc	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 GGDVLP
	13	C.
	14	C. ******************************************************************
	15	C. * *
	16	C. * SUBR. GGDVLP *
	17	C. * *
	18	C. * DeVeLoPs locally the JVOLUM structure so as not to have to *
	19	C. * recompute variable parameters and division specifications *
	20	C. * at tracking time. *
	21	C. * *
	22	C. * Called by : GGCLOS *
	23	C. * Authors : S.Banerjee, F.Bruyant *
	24	C. * *
	25	C. ******************************************************************
	26	C.
	27	#include "geant321/gcbank.inc"
	28	#include "geant321/gcnum.inc"
	29	#include "geant321/gcunit.inc"
	30	C.
	31	PARAMETER (NLVMAX=15, NPAMAX=50)
	32	C.
	33	COMMON /GCDVLP/ LREF(2), JVO, LJVOM(NLVMAX), LLVODV(NLVMAX), LVODV
	34	C.
	35	INTEGER ILINK(NLVMAX), LVAR(NPAMAX), NLINK(NLVMAX)
	36	INTEGER NUMB(NLVMAX+1), NBGN(NLVMAX+1), IVOL(5200)
	37	EQUIVALENCE (IVOL(1), WS(1))
	38	REAL PAR(NPAMAX)
	39	LOGICAL BTEST
	40	C.
	41	C. ------------------------------------------------------------------
	42	*
	43	CALL MZLINT (IXSTOR, '/GCDVLP/', LREF, JVO, LVODV)
	44	*
	45	CALL MZFORM ('VODV', '1I 2F 2I -F', IOVODV)
	46	*
	47	* *** Create the volume tree in memory
	48	*
	49	IF (NVOLUM.LT.1) GO TO 990
	50	NUMB(1) = 1
	51	NBGN(1) = 1
	52	IVOL(1) = 1
	53	NLVT = 1
	54	*
	55	10 NLEV = NLVT + 1
	56	NUMB(NLEV) = 0
	57	NBGN(NLEV) = NBGN(NLVT) + NUMB(NLVT)
	58	DO 30 I = 1, NUMB(NLVT)
	59	IVO = IVOL(NBGN(NLVT) + I - 1)
	60	JVO = LQ(JVOLUM-IVO)
	61	NIN = Q(JVO+3)
	62	IF (NIN.GT.0) THEN
	63	DO 20 IN = 1, NIN
	64	JIN = LQ(JVO-IN)
65	IVOT = Q(JIN+2)
66	DO 15 I1 = 1, NUMB(NLEV)
67	IVOS = IVOL(NBGN(NLEV)+I1-1)
68	IF (IVOS.EQ.IVOT) GO TO 20
69	15 CONTINUE
70	NUMB(NLEV) = NUMB(NLEV) + 1
71	I1 = NBGN(NLEV) + NUMB(NLEV) - 1
72	IVOL(I1) = IVOT
73	20 CONTINUE
74	ELSE IF (NIN.LT.0) THEN
75	JDIV = LQ(JVO-1)
76	IVOT = Q(JDIV+2)
77	DO 25 I1 = 1, NUMB(NLEV)
78	IVOS = IVOL(NBGN(NLEV)+I1-1)
79	IF (IVOS.EQ.IVOT) GO TO 30
80	25 CONTINUE
81	NUMB(NLEV) = NUMB(NLEV) + 1
82	I1 = NBGN(NLEV) + NUMB(NLEV) - 1
83	IVOL(I1) = IVOT
84	ENDIF
85	30 CONTINUE
86	*
87	IF (NUMB(NLEV).GT.0) THEN
88	NLVT = NLEV
89	GO TO 10
90	ENDIF
91	*
92	NLEV = 1
93	NLEVS = 1
94	*
95	* *** Loop over volumes in a given level
96	*
97	110 IF (NLEVS.GT.NLVT) GO TO 990
98	IF (NUMB(NLEVS).GT.0) THEN
99	NUMB(NLEVS) = NUMB(NLEVS) - 1
100	IVOM = IVOL(NBGN(NLEVS)+NUMB(NLEVS))
101	ELSE
102	NLEVS = NLEVS + 1
103	GO TO 110
104	ENDIF
105	*
106	* *** Check if current volume should be locally developed
107	*
108	LJVOM(1) = LQ(JVOLUM-IVOM)
109	IF(LQ(LJVOM(1)).GT.0) THEN
110	CALL MZDROP(IXCONS,LQ(LJVOM(1)),'L')
111	ENDIF
112	NIN = Q(LJVOM(1)+3)
113	#if defined(CERNLIB_DEBUGG)
114	WRITE (CHMAIL,2000) IQ(JVOLUM+IVOM),NIN
115	CALL GMAIL (0, 0)
116	2000 FORMAT (' GGDVLP : Volume ',A4,' NIN = ',I3)
117	#endif
118	*
119	* ** Skip it if not a possible source of local development
120	*
121	IF (NIN.EQ.0) GO TO 110
122	IF (LQ(LJVOM(1)).NE.0) GO TO 110
123	IF (BTEST(IQ(LJVOM(1)),1)) GO TO 110
124	CALL GGVCHK (LJVOM(1), 0, NVAR, LVAR)
125	IF (NVAR.NE.0) GO TO 110
126	*
127	* ** Otherwise, analyze contents
128	*
129	IOK = 0
130	IF (NIN.LT.0) GO TO 120
131	*
132	* * Current volume has contents defined by position
133	*
134	DO 119 IN = 1,NIN
135	CALL GGVCHK (LJVOM(1), IN, NVAR, LVAR)
136	IF (NVAR.NE.0) THEN
137	*
138	* In case a content is found with variable parameters,
139	* initialize development
140	*
141	NLINK(1) = NIN
142	ILINK(1) = IN
143	GO TO 200
144	ENDIF
145	119 CONTINUE
146	GO TO 110
147	*
148	* * Current volume is divided
149	*
150	120 CALL GGVCHK (LJVOM(1), 1, NVAR, LVAR)
151	IF (NVAR.EQ.0) GO TO 110
152	*
153	* If cells have variable sizes, initialize development
154	*
155	IOK = 2
156	JDIV = LQ(LJVOM(1)-1)
157	NLINK(1) = Q(JDIV+3)
158	ILINK(1) = 1
159	*
160	200 CALL MZBOOK (IXCONS, LLVODV(1), LJVOM(1), 0, 'VODV',
161	+ NLINK(1), NLINK(1), 1, 2, 1)
162	#if defined(CERNLIB_DEBUGG)
163	WRITE (CHMAIL, 2002) ILINK(1), NLINK(1), NVAR
164	CALL GMAIL (0, 0)
165	2002 FORMAT (' GGDVLP : I, N, NVAR = ',3I5)
166	#endif
167	*
168	* *** Complete development for current content at current level
169	*
170	IF (IOK.EQ.0) GO TO 250
171	IOK = 0
172	IQ(LLVODV(1)+1) = NLINK(1)
173	GO TO 260
174	*
175	210 NIN = Q(LJVOM(NLEV)+3)
176	IF (NIN.LT.0) THEN
177	CALL GGVCHK (LJVOM(NLEV), 1, NVAR, LVAR)
178	ELSE
179	CALL GGVCHK (LJVOM(NLEV), ILINK(NLEV), NVAR, LVAR)
180	ENDIF
181	IF (NVAR.EQ.0) GO TO 290
182	#if defined(CERNLIB_DEBUGG)
183	WRITE (CHMAIL, 2004) NLEV, ILINK(NLEV), NVAR
184	CALL GMAIL (0, 0)
185	2004 FORMAT (' GGDVLP : LEVEL,I,NVAR,NIN = ',4I5)
186	#endif
187	IF (NIN.LT.0) GO TO 260
188	*
189	* ** Compute actual parameters for current content
190	*
191	* * Case with contents obtained by position
192	*
193	250 CALL GGPPAR (LJVOM(NLEV), ILINK(NLEV), NVAR,LVAR, LLVODV(NLEV),
194	+ NPAR, PAR)
195	JIN = LQ(LJVOM(NLEV)-ILINK(NLEV))
196	GO TO 270
197	*
198	* * Case with contents obtained by division
199	*
200	260 CALL GGDPAR (LJVOM(NLEV), ILINK(NLEV), NVAR,LVAR, LLVODV(NLEV),
201	+ NPAR, PAR)
202	JIN = LQ(LJVOM(NLEV)-1)
203	*
204	* ** Initialize next level down
205	*
206	270 IVO = Q(JIN+2)
207	JVO = LQ(JVOLUM-IVO)
208	NIN = Q(JVO+3)
209	IF (NIN.GE.0) THEN
210	IF (NIN.NE.0) IOK = 1
211	NL = NIN
212	ELSE
213	IOK = 2
214	*
215	* * Current content is divided, compute division specifications
216	*
217	CALL GGDSPE (JVO, NPAR, PAR, NL, NDIV, ORIG, STEP)
218	ENDIF
219	*
220	IQ(JVO) = IBSET(IQ(JVO),1)
221	CALL MZBOOK (IXCONS, LVODV, LLVODV(NLEV), -ILINK(NLEV), 'VODV',
222	+ NL, NL, NPAR+5, IOVODV, 3)
223	IF (IOK.EQ.2) THEN
224	IQ(LVODV+1) = NDIV
225	Q(LVODV+2) = ORIG
226	Q(LVODV+3) = STEP
227	#if defined(CERNLIB_DEBUGG)
228	WRITE (CHMAIL, 2006) NDIV, ORIG, STEP
229	CALL GMAIL (0, 0)
230	2006 FORMAT (' GGDVLP : After GGDSPE, NDIV ORIG STEP = ',I4,2F10.4)
231	#endif
232	ENDIF
233	IQ(LVODV+4) = IVO
234	IQ(LVODV+5) = NPAR
235	CALL UCOPY (PAR, Q(LVODV+6), NPAR)
236	#if defined(CERNLIB_DEBUGG)
237	WRITE (CHMAIL, 2008)
238	CALL GMAIL (0, 0)
239	2008 FORMAT (' GGDVLP : Store parameters into development structure')
240	#endif
241	*
242	290 IF (IOK.EQ.0) THEN
243	IF (ILINK(NLEV).EQ.NLINK(NLEV)) THEN
244	*
245	* Go one level up
246	*
247	IF (NLEV.EQ.1) GO TO 110
248	NLEV = NLEV -1
249	GO TO 290
250	ENDIF
251	*
252	* Analyze next content
253	*
254	ILINK(NLEV) = ILINK(NLEV) +1
255	GO TO 210
256	ENDIF
257	*
258	* A new level has been initialized, start analyzing it
259	*
260	NLEV = NLEV +1
261	LJVOM(NLEV) = JVO
262	LLVODV(NLEV) = LVODV
263	ILINK(NLEV) = 1
264	NLINK(NLEV) = NL
265	IOK = 0
266	GO TO 210
267	*
268	990 DO 991 IVO = 1, NVOLUM
269	JVO = LQ(JVOLUM-IVO)
270	IF (BTEST(IQ(JVO),1)) THEN
271	IF (LQ(JVO).GT.0) THEN
272	CALL MZDROP (IXCONS, LQ(JVO), ' ')
273	WRITE (CHMAIL, 1001) IQ(JVOLUM+IVO)
274	ENDIF
275	ENDIF
276	991 CONTINUE
277	LREF(1) = 0
278	*
279	1001 FORMAT (' GGDVLP : Unnecessary development at volume ',A4)
280	* END GGDVLP
281	END