5 * Revision 1.1.1.1 1995/10/24 10:20:50 cernlib
9 #include "geant321/pilot.h"
10 *CMZ : 3.21/02 29/03/94 15.41.28 by S.Giani
12 SUBROUTINE GGPPAR (JVOM, IN, NVAR, LVAR, LVOM, NPAR, PAR)
14 C. ******************************************************************
16 C. * SUBR. GGPPAR (JVOM,IN,NVAR,LVAR,LVOM,NPAR*,PAR*) *
18 C. * Computes the actual parameters for the INth content inside *
19 C. * the mother volume at address JVOM *
20 C. * Returns them in NPAR, PAR *
22 C. * Called by : GGDVLP *
23 C. * Authors : F.Bruyant, S.Banerjee *
24 C. * (original algorithms from A.McPherson) *
26 C. ******************************************************************
28 #include "geant321/gcbank.inc"
29 #include "geant321/gcflag.inc"
30 #include "geant321/gcunit.inc"
34 DIMENSION LVAR(*), PAR(*)
35 DIMENSION DXYZ(3), PARM(NPAMAX)
39 DATA IOPT / 1 ,1 ,1 ,1 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,
40 + 0 ,1 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,
41 + 0 ,0 ,1 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,
42 + 0 ,0 ,0 ,1 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,
43 + 0 ,0 ,0 ,0 ,1 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,
44 + 0 ,0 ,0 ,0 ,0 ,1 ,0 ,0 ,0 ,0 ,0 ,0 ,
45 + 0 ,0 ,0 ,0 ,0 ,0 ,1 ,0 ,0 ,0 ,0 ,0 ,
46 + 0 ,0 ,0 ,0 ,0 ,0 ,0 ,1 ,0 ,0 ,0 ,0 ,
47 + 0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,1 ,0 ,0 ,0 ,
48 + 0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,1 ,0 ,0 ,
49 + 0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,1 ,0 ,
50 + 0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,1 /
52 C. ------------------------------------------------------------------
63 CALL UCOPY (Q(JIN+10), PAR, NPAR)
64 IF (NVAR.LT.0) GO TO 999
66 CALL UCOPY (Q(JVO+7), PAR, NPAR)
77 IF(ISH.GT.12.OR.ISHM.GT.12.OR.IOPT(ISHM, ISH).EQ.0) THEN
78 WRITE (CHMAIL, 10400) ISH, ISHM
83 * *** Prepares parameters for mother, in PARM, for content, in PAR
84 * and the translation DXYZ (position of content inside mother)
86 IF (LQ(JVOM).EQ.LVOM) THEN
88 * Case when current volume is source of local development
91 CALL UCOPY (Q(JVOM+7), PARM, NPARM)
97 CALL UCOPY (Q(LVOM+6), PARM, NPARM)
104 * *** Compute the actual parameters
114 PAR(IAX) = PARM(IAX) -ABS(DXYZ(IAX))
115 IF (PAR(IAX).LT.0.) THEN
116 WRITE (CHMAIL, 10500) ISH, ISHM, IAX
121 ELSE IF (ISHM.EQ.2) THEN
127 IF (DZ.LT.0.) DZ = PARM(4)
128 DXDZ = 0.5*(PARM(2)-PARM(1))/PARM(4)
129 DXME = 0.5*(PARM(2)+PARM(1)) +DXDZ*DXYZ(3)
130 DX = DXME -ABS(DXDZ*DZ)
131 PAR(IAX) = DX -ABS(DXYZ(1))
132 IF (PAR(IAX).LT.0.) THEN
133 WRITE (CHMAIL, 10500) ISH, ISHM, IAX
138 PAR(IAX) = PARM(IAX+1) -ABS(DXYZ(IAX))
140 DXDZ = 0.5*(PARM(2)-PARM(1))/PARM(4)
141 DX0 = 0.5*(PARM(2)+PARM(1)) -ABS(DXYZ(1))
142 DZ = (DX0 -PAR(1))/ABS(DXDZ)
144 WRITE (CHMAIL, 10600) ISH, ISHM, IAX, DZ
148 IF (PAR(3).GT.DZ) PAR(3) = DZ
153 ELSE IF (ISHM.EQ.3) THEN
160 IF (DZ .LT. 0.) DZ = PARM(5)
161 DXDZ = 0.5*(PARM(IP+1) - PARM(IP))/PARM(5)
162 DXME = 0.5*(PARM(IP+1) + PARM(IP)) + DXDZ*DXYZ(3)
163 DX = DXME - ABS(DXDZ*DZ)
164 PAR(IAX) = DX - ABS(DXYZ(IAX))
166 PAR(3) = PARM(5) - ABS(DXYZ(3))
167 DXDZ = 0.5*(PARM(2) - PARM(1))/PARM(5)
168 DX0 = 0.5*(PARM(2) + PARM(1)) - ABS(DXYZ(1))
169 DZ = (DX0 - PAR(1))/ABS(DXDZ)
171 WRITE (CHMAIL, 10600) ISH, ISHM, IAX, DZ
175 IF (PAR(IAX).GT.DZ) PAR(IAX) = DZ
177 DXDZ = 0.5*(PARM(4) - PARM(3))/PARM(5)
178 DX0 = 0.5*(PARM(4) + PARM(3)) - ABS(DXYZ(2))
179 DZ = (DX0 - PAR(2))/ABS(DXDZ)
181 WRITE (CHMAIL, 10600) ISH, ISHM, IAX, DZ
185 IF (PAR(IAX).GT.DZ) PAR(IAX) = DZ
189 ELSE IF (ISHM.EQ.4) THEN
192 * Case of box in trap. Let's keep it simple: we just deal with
193 * the case in which phi=0 or 180. If theta .ne. 0, the position along
194 * x-axis, and the angles parm(7) and parm(11) must be 0.
196 IF(ABS(PARM(3)).GT.0.1E-5) THEN
197 WRITE(CHMAIL,10000) IQ(JVOLUM+IVO)
199 + (' GGPPAR : Cannot use negative parameters for box ',A4)
202 10100 FORMAT(' in a trap if PAR(2) .ne. 0 or 180')
205 ELSEIF(PARM(7).NE.PARM(11)) THEN
206 WRITE(CHMAIL,10000) IQ(JVOLUM+IVO)
209 10200 FORMAT(' in a trap if PAR(7) .ne. PAR(11)')
216 IF(LVAR(J).EQ.1) THEN
218 ELSEIF(LVAR(J).EQ.2) THEN
220 ELSEIF(LVAR(J).EQ.3) THEN
226 PAR(3) = DZM-ABS(DXYZ(3))
228 DYDZ=0.5*(PARM(8)-PARM(4))/PARM(1)
229 DYM =0.5*(PARM(8)+PARM(4))
230 DY1 = DYM+(DXYZ(3)+PAR(3))*DYDZ
231 DY2 = DYM+(DXYZ(3)-PAR(3))*DYDZ
233 PAR(2) = MIN(DY1,DY2)-ABS(DXYZ(2))
236 IF(PARM(7).EQ.0.0.AND.ABS(PARM(2)).LT..1E-5) THEN
237 DXDZL = 0.5*(PARM(9)-PARM(5))/PARM(1)
238 DXDZH = 0.5*(PARM(10)-PARM(6))/PARM(1)
239 DXML = 0.5*(PARM(9)+PARM(5))
240 DXMH = 0.5*(PARM(10)+PARM(6))
241 DXL1 = DXML+(DXYZ(3)+PAR(3))*DXDZL
242 DXL2 = DXML+(DXYZ(3)-PAR(3))*DXDZL
243 DXH1 = DXMH+(DXYZ(3)+PAR(3))*DXDZH
244 DXH2 = DXMH+(DXYZ(3)-PAR(3))*DXDZH
245 DXDY1 = 0.5*(DXH1-DXL1)/DY1
246 DXDY2 = 0.5*(DXH2-DXL2)/DY2
247 DXM1 = 0.5*(DXH1+DXL1)
248 DXM2 = 0.5*(DXH2+DXL2)
249 DX1 = DXM1+(DXYZ(2)+PAR(2))*DXDY1
250 DX2 = DXM1+(DXYZ(2)-PAR(2))*DXDY1
251 DX3 = DXM2+(DXYZ(2)+PAR(2))*DXDY2
252 DX4 = DXM2+(DXYZ(2)-PAR(2))*DXDY2
253 PAR(1) = MIN(DX1,DX2,DX3,DX4)-ABS(DXYZ(1))
254 * Note; position along x-axis should be 0, when theta .ne. 0:
255 ELSE IF(PARM(7).EQ..0.AND.ABS(PARM(2)).GT..1E-5)THEN
256 * the maximum length of the lower (DX2) and upper (DX1) lines along x
257 DXDZ= 0.5*(PARM(9)-PARM(5))/PARM(1)
258 DXM = 0.5*(PARM(9)+PARM(5))
259 DX1 = DXM+(DXYZ(3)+PAR(3))*DXDZ
260 DX2 = DXM+(DXYZ(3)-PAR(3))*DXDZ
262 * the shift in the endpoints caused by theta angle compared with
263 * the symmetrical case when theta = 0
265 SHFX1 = TANTHE*(DXYZ(3)+PAR(3))
266 SHFX2 = TANTHE*(DXYZ(3)-PAR(3))
273 * DXP is the lenght of the box that fits in the positive side
274 * DXN is the one in the negative side
279 PAR(1) = .5*(DXP+DXN)
282 DXDZL = 0.5*(PARM(9)-PARM(5))/PARM(1)
283 DXDZH = 0.5*(PARM(10)-PARM(6))/PARM(1)
284 DXML = 0.5*(PARM(9)+PARM(5))
285 DXMH = 0.5*(PARM(10)+PARM(6))
286 DXL1 = DXML+(DXYZ(3)+PAR(3))*DXDZL
287 DXL2 = DXML+(DXYZ(3)-PAR(3))*DXDZL
288 DXH1 = DXMH+(DXYZ(3)+PAR(3))*DXDZH
289 DXH2 = DXMH+(DXYZ(3)-PAR(3))*DXDZH
302 DXDY1P = 0.5*(DXH1P-DXL1P)/DY1
303 DXDY2P = 0.5*(DXH2P-DXL2P)/DY2
304 DXDY1N = 0.5*(DXH1N-DXL1N)/DY1
305 DXDY2N = 0.5*(DXH2N-DXL2N)/DY2
307 DXM1P = 0.5*(DXH1P+DXL1P)
308 DXM2P = 0.5*(DXH2P+DXL2P)
309 DXM1N = 0.5*(DXH1N+DXL1N)
310 DXM2N = 0.5*(DXH2N+DXL2N)
312 DX1P = DXM1P+(DXYZ(2)+PAR(2))*DXDY1P
313 DX2P = DXM1P+(DXYZ(2)-PAR(2))*DXDY1P
314 DX3P = DXM2P+(DXYZ(2)+PAR(2))*DXDY2P
315 DX4P = DXM2P+(DXYZ(2)-PAR(2))*DXDY2P
316 DX1N = DXM1N+(DXYZ(2)+PAR(2))*DXDY1N
317 DX2N = DXM1N+(DXYZ(2)-PAR(2))*DXDY1N
318 DX3N = DXM2N+(DXYZ(2)+PAR(2))*DXDY2N
319 DX4N = DXM2N+(DXYZ(2)-PAR(2))*DXDY2N
321 PAR(1) =MAX(0.,MIN( MIN(DX1P,DX2P,DX3P,DX4P)-
322 + DXYZ(1), MIN(DX1N,DX2N,DX3N,DX4N)+DXYZ(1)))
328 ELSE IF (ISH.EQ.4) THEN
332 IF (ISHM.EQ.ISH) THEN
334 IF (PAR(1).EQ.PARM(1)) THEN
342 IF (IZCUT.EQ.0) GO TO 50
343 IF (IAX.NE.1.AND.IAX.LE.6) THEN
344 DZ = DXYZ(3) +PARM(1) -PAR(1)
345 DPDZ = 0.5*(PARM(IAX+4) -PARM(IAX))/PARM(1)
346 PAR(IAX) = PARM(IAX) + DPDZ*DZ
347 ELSE IF (IAX.GT.6) THEN
348 DZ = DXYZ(3) +PARM(1) +PAR(1)
349 DPDZ = 0.5*(PARM(IAX) -PARM(IAX-4))/PARM(1)
350 PAR(IAX) = PARM(IAX-4) + DPDZ*DZ
354 HTAH = PARM(8)*PARM(11)
355 HTAL = PARM(4)*PARM(7)
356 ZZ1 = 0.5*(DXYZ(3) +PARM(1) -PAR(1))/PARM(1)
357 PAR(7) = (HTAL*(1.-ZZ1) + HTAH*ZZ1)/PAR(4)
358 ZZ2 = 0.5*(DXYZ(3) +PARM(1) +PAR(1))/PARM(1)
359 PAR(11)= (HTAL*(1.-ZZ2) + HTAH*ZZ2)/PAR(8)
361 IF(IAX.EQ.2.AND.IZCUT.EQ.0) THEN
362 DXDY1 = 0.5*(PARM(6)-PARM(5))/PARM(4)
363 DXDY2 = 0.5*(PARM(10)-PARM(9))/PARM(8)
364 DXM1 = 0.5*(PARM(6)+PARM(5))
365 DXM2 = 0.5*(PARM(10)+PARM(9))
366 DXH1 = DXM1+(DXYZ(2)+PAR(2))*DXDY1
367 DXH2 = DXM2+(DXYZ(2)+PAR(2))*DXDY2
368 DXL1 = DXM1+(DXYZ(2)-PAR(2))*DXDY1
369 DXL2 = DXM2+(DXYZ(2)-PAR(2))*DXDY2
378 ELSE IF (ISH.EQ.5) THEN
387 IF(LVAR(JVAR).EQ.1) IRMIN=1
388 IF(LVAR(JVAR).EQ.2) IRMAX=1
389 IF(LVAR(JVAR).EQ.3) IDZED=1
391 RPOS = SQRT(DXYZ(1)**2+DXYZ(2)**2)
394 * Here we settle the minimum radius.
396 IF(PARM(1).GT.0.) THEN
397 PAR(1) = PARM(1)+RPOS
404 * Case in which the max radius is variable.
406 IF(PAR(1).LE.RPOS-PARM(1).AND.PARM(1).GT.0.) THEN
408 * This is the case in which the 'hole' in the tube does not
409 * intersect the 'hole' in the mother.
411 PAR(2) = MIN(PARM(2)-RPOS,RPOS-PARM(1))
412 ELSEIF(PAR(1).GE.RPOS+PARM(1).OR.PARM(1).EQ.0.) THEN
414 * This is the case in which the 'hole' in the tube contains the
415 * 'hole' in the mother, or there is no 'hole' in the mother.
417 PAR(2) = PARM(2)-RPOS
420 * And this is the error condition. The inner tube protrudes in the empty
421 * space inside the outer one.
423 WRITE(CHMAIL,11100) IQ(JVOLUM+IVO)
429 PAR(3) = PARM(3)-ABS(DXYZ(3))
431 IF(PAR(1).GE.PAR(2).OR.PAR(2).GT.PARM(2)
432 + .OR.PAR(3).LE.0.) THEN
433 WRITE(CHMAIL,11000) IQ(JVOLUM+IVO)
438 WRITE (CHMAIL, 10900) ISH, ISHM
442 ELSE IF (ISH.LE.10) THEN
444 * TRD1,TRD2,TUBE,TUBS,CONE,CONS,SPHE,PARA
446 IF (ISHM.EQ.ISH) THEN
447 * in TRD1,TRD2,TUBE,TUBS,CONE,CONS,SPHE,PARA
448 IF (DXYZ(1).NE.0..OR.DXYZ(2).NE.0..OR.DXYZ(3).NE.0.)
450 WRITE (CHMAIL, 10700) ISH, ISHM
461 ELSE IF (ISH.LE.12) THEN
465 IF (ISHM.EQ.ISH) THEN
474 IF (NZ.NE.2 .OR. NZ1.NE.2) THEN
475 WRITE (CHMAIL, 10900) ISH, ISHM
482 TANLOW = (PARM(IPNZ+5)-PARM(IPNZ+2))/DZ
483 TANHIG = (PARM(IPNZ+6)-PARM(IPNZ+3))/DZ
484 Z1 = DXYZ(3) + PAR(IPNZ+1) - PARM(IPNZ+1)
485 Z2 = DXYZ(3) + PAR(IPNZ+4) - PARM(IPNZ+1)
486 PAR(IPNZ+2) = PARM(IPNZ+2) + TANLOW * Z1
487 PAR(IPNZ+3) = PARM(IPNZ+3) + TANHIG * Z1
488 PAR(IPNZ+5) = PARM(IPNZ+2) + TANLOW * Z2
489 PAR(IPNZ+6) = PARM(IPNZ+3) + TANHIG * Z2
495 10300 FORMAT (' GGPPAR : Rotations not accepted at the moment')
496 10400 FORMAT (' GGPPAR : Shape association not accepted', 2I5)
497 10500 FORMAT (' GGPPAR : PAR(IAX) negative, ISH,ISHM,IAX=',3I5)
498 10600 FORMAT (' GGPPAR : DZ negative, ISH,ISHM,IAX,DZ=',3I5,G12.4)
499 10700 FORMAT (' GGPPAR : Not yet coded for ISH,ISHM=',2I5)
500 10800 FORMAT (' GGPPAR : PARM error for ISH,ISHM,IAX=',3I5)
501 10900 FORMAT (' GGPPAR : Configuration not accepted, ISH,ISHM=',2I5)
502 11000 FORMAT (' GGPPAR : Tube ',A4,' has inconsistent parameters')
503 11100 FORMAT (' GGPPAR : Tube ',A4,' protrudes into the inner space ',