]> git.uio.no Git - u/mrichter/AliRoot.git/blame - GEANT321/ggeom/ggppar.F
git://git.uio.no / u / mrichter / AliRoot.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Allow any Cherenkov-like particle to be transported
[u/mrichter/AliRoot.git] / GEANT321 / ggeom / ggppar.F
CommitLineData
fe4da5cc 1*
2* $Id$
3*
4* $Log$
5* Revision 1.1.1.1 1995/10/24 10:20:50 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*FCA : 05/01/99 10:04:28 by Federico Carminati
12* Added the possibility to put TRD1's in TRD1's with
13* negative parameters
14*-- Author :
15 SUBROUTINE GGPPAR (JVOM, IN, NVAR, LVAR, LVOM, NPAR, PAR)
16C.
17C. ******************************************************************
18C. * *
19C. * SUBR. GGPPAR (JVOM,IN,NVAR,LVAR,LVOM,NPAR*,PAR*) *
20C. * *
21C. * Computes the actual parameters for the INth content inside *
22C. * the mother volume at address JVOM *
23C. * Returns them in NPAR, PAR *
24C. * *
25C. * Called by : GGDVLP *
26C. * Authors : F.Bruyant, S.Banerjee *
27C. * (original algorithms from A.McPherson) *
28C. * *
29C. ******************************************************************
30C.
31#include "geant321/gcbank.inc"
32#include "geant321/gcflag.inc"
33#include "geant321/gcunit.inc"
34C.
35 PARAMETER (NPAMAX=50)
36C.
37 DIMENSION LVAR(*), PAR(*)
38 DIMENSION DXYZ(3), PARM(NPAMAX)
39 DIMENSION IOPT(12,12)
40 SAVE IOPT
41C.
42 DATA IOPT / 1 ,1 ,1 ,1 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,
43 + 0 ,1 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,
44 + 0 ,0 ,1 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,
45 + 0 ,0 ,0 ,1 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,
46 + 0 ,0 ,0 ,0 ,1 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,
47 + 0 ,0 ,0 ,0 ,0 ,1 ,0 ,0 ,0 ,0 ,0 ,0 ,
48 + 0 ,0 ,0 ,0 ,0 ,0 ,1 ,0 ,0 ,0 ,0 ,0 ,
49 + 0 ,0 ,0 ,0 ,0 ,0 ,0 ,1 ,0 ,0 ,0 ,0 ,
50 + 0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,1 ,0 ,0 ,0 ,
51 + 0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,1 ,0 ,0 ,
52 + 0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,1 ,0 ,
53 + 0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,1 /
54C.
55C. ------------------------------------------------------------------
56*
57* *** Check request
58*
59 JIN = LQ(JVOM-IN)
60*
61 IVO = Q(JIN+2)
62 JVO = LQ(JVOLUM-IVO)
63 NPAR = Q(JVO+5)
64 IF (NPAR.EQ.0) THEN
65 NPAR = Q(JIN+9)
66 CALL UCOPY (Q(JIN+10), PAR, NPAR)
67 IF (NVAR.LT.0) GO TO 999
68 ELSE
69 CALL UCOPY (Q(JVO+7), PAR, NPAR)
70 ENDIF
71 IROT = Q(JIN+4)
72 IF (IROT.NE.0) THEN
73 WRITE (CHMAIL, 10300)
74 CALL GMAIL (0, 0)
75 IEORUN = 1
76 ENDIF
77*
78 ISH = Q(JVO+2)
79 ISHM = Q(JVOM+2)
80 IF(ISH.GT.12.OR.ISHM.GT.12.OR.IOPT(ISHM, ISH).EQ.0) THEN
81 WRITE (CHMAIL, 10400) ISH, ISHM
82 CALL GMAIL (0, 0)
83 IEORUN = 1
84 ENDIF
85*
86* *** Prepares parameters for mother, in PARM, for content, in PAR
87* and the translation DXYZ (position of content inside mother)
88*
89 IF (LQ(JVOM).EQ.LVOM) THEN
90*
91* Case when current volume is source of local development
92*
93 NPARM = Q(JVOM+5)
94 CALL UCOPY (Q(JVOM+7), PARM, NPARM)
95 ELSE
96*
97* Other cases
98*
99 NPARM = IQ(LVOM+5)
100 CALL UCOPY (Q(LVOM+6), PARM, NPARM)
101 ENDIF
102*
103 DXYZ(1) = Q(JIN+5)
104 DXYZ(2) = Q(JIN+6)
105 DXYZ(3) = Q(JIN+7)
106*
107* *** Compute the actual parameters
108*
109 IF (ISH.EQ.1) THEN
110*
111* BOX
112*
113 IF (ISHM.EQ.1) THEN
114* in BOX
115 DO 10 I = 1,NVAR
116 IAX = LVAR(I)
117 PAR(IAX) = PARM(IAX) -ABS(DXYZ(IAX))
118 IF (PAR(IAX).LT.0.) THEN
119 WRITE (CHMAIL, 10500) ISH, ISHM, IAX
120 CALL GMAIL (0, 0)
121 IEORUN = 1
122 ENDIF
123 10 CONTINUE
124 ELSE IF (ISHM.EQ.2) THEN
125* in TRD1
126 DO 20 I = 1,NVAR
127 IAX = LVAR(I)
128 IF (IAX.EQ.1) THEN
129 DZ = PAR(3)
130 IF (DZ.LT.0.) DZ = PARM(4)
131 DXDZ = 0.5*(PARM(2)-PARM(1))/PARM(4)
132 DXME = 0.5*(PARM(2)+PARM(1)) +DXDZ*DXYZ(3)
133 DX = DXME -ABS(DXDZ*DZ)
134 PAR(IAX) = DX -ABS(DXYZ(1))
135 IF (PAR(IAX).LT.0.) THEN
136 WRITE (CHMAIL, 10500) ISH, ISHM, IAX
137 CALL GMAIL (0, 0)
138 IEORUN = 1
139 ENDIF
140 ELSE
141 PAR(IAX) = PARM(IAX+1) -ABS(DXYZ(IAX))
142 IF (IAX.EQ.3) THEN
143 DXDZ = 0.5*(PARM(2)-PARM(1))/PARM(4)
144 DX0 = 0.5*(PARM(2)+PARM(1)) -ABS(DXYZ(1))
145 DZ = (DX0 -PAR(1))/ABS(DXDZ)
146 IF (DZ.LT.0.) THEN
147 WRITE (CHMAIL, 10600) ISH, ISHM, IAX, DZ
148 CALL GMAIL (0, 0)
149 IEORUN = 1
150 ELSE
151 IF (PAR(3).GT.DZ) PAR(3) = DZ
152 ENDIF
153 ENDIF
154 ENDIF
155 20 CONTINUE
156 ELSE IF (ISHM.EQ.3) THEN
157* in TRD2
158 DO 30 I = 1,NVAR
159 IAX = LVAR(I)
160 IF (IAX .LT. 3) THEN
161 DZ = PAR(3)
162 IP = 2*IAX -1
163 IF (DZ .LT. 0.) DZ = PARM(5)
164 DXDZ = 0.5*(PARM(IP+1) - PARM(IP))/PARM(5)
165 DXME = 0.5*(PARM(IP+1) + PARM(IP)) + DXDZ*DXYZ(3)
166 DX = DXME - ABS(DXDZ*DZ)
167 PAR(IAX) = DX - ABS(DXYZ(IAX))
168 ELSE
169 PAR(3) = PARM(5) - ABS(DXYZ(3))
170 DXDZ = 0.5*(PARM(2) - PARM(1))/PARM(5)
171 DX0 = 0.5*(PARM(2) + PARM(1)) - ABS(DXYZ(1))
172 DZ = (DX0 - PAR(1))/ABS(DXDZ)
173 IF (DZ.LT.0.0) THEN
174 WRITE (CHMAIL, 10600) ISH, ISHM, IAX, DZ
175 CALL GMAIL (0, 0)
176 IEORUN = 1
177 ELSE
178 IF (PAR(IAX).GT.DZ) PAR(IAX) = DZ
179 ENDIF
180 DXDZ = 0.5*(PARM(4) - PARM(3))/PARM(5)
181 DX0 = 0.5*(PARM(4) + PARM(3)) - ABS(DXYZ(2))
182 DZ = (DX0 - PAR(2))/ABS(DXDZ)
183 IF (DZ.LT.0.0) THEN
184 WRITE (CHMAIL, 10600) ISH, ISHM, IAX, DZ
185 CALL GMAIL (0, 0)
186 IEORUN = 1
187 ELSE
188 IF (PAR(IAX).GT.DZ) PAR(IAX) = DZ
189 ENDIF
190 ENDIF
191 30 CONTINUE
192 ELSE IF (ISHM.EQ.4) THEN
193* in TRAP
194*
195* Case of box in trap. Let's keep it simple: we just deal with
196* the case in which phi=0 or 180. If theta .ne. 0, the position along
197* x-axis, and the angles parm(7) and parm(11) must be 0.
198*
199 IF(ABS(PARM(3)).GT.0.1E-5) THEN
200 WRITE(CHMAIL,10000) IQ(JVOLUM+IVO)
20110000 FORMAT
202 + (' GGPPAR : Cannot use negative parameters for box ',A4)
203 CALL GMAIL(0,0)
204 WRITE(CHMAIL,10100)
20510100 FORMAT(' in a trap if PAR(2) .ne. 0 or 180')
206 CALL GMAIL(0,0)
207 IEORUN=1
208 ELSEIF(PARM(7).NE.PARM(11)) THEN
209 WRITE(CHMAIL,10000) IQ(JVOLUM+IVO)
210 CALL GMAIL(0,0)
211 WRITE(CHMAIL,10200)
21210200 FORMAT(' in a trap if PAR(7) .ne. PAR(11)')
213 CALL GMAIL(0,0)
214 ELSE
215 IVARX=0
216 IVARY=0
217 IVARZ=0
218 DO 40 J=1,NVAR
219 IF(LVAR(J).EQ.1) THEN
220 IVARX=1
221 ELSEIF(LVAR(J).EQ.2) THEN
222 IVARY=1
223 ELSEIF(LVAR(J).EQ.3) THEN
224 IVARZ=1
225 ENDIF
226 40 CONTINUE
227 DZM = PARM(1)
228 IF(IVARZ.EQ.1) THEN
229 PAR(3) = DZM-ABS(DXYZ(3))
230 ENDIF
231 DYDZ=0.5*(PARM(8)-PARM(4))/PARM(1)
232 DYM =0.5*(PARM(8)+PARM(4))
233 DY1 = DYM+(DXYZ(3)+PAR(3))*DYDZ
234 DY2 = DYM+(DXYZ(3)-PAR(3))*DYDZ
235 IF(IVARY.EQ.1) THEN
236 PAR(2) = MIN(DY1,DY2)-ABS(DXYZ(2))
237 ENDIF
238 IF(IVARX.EQ.1) THEN
239 IF(PARM(7).EQ.0.0.AND.ABS(PARM(2)).LT..1E-5) THEN
240 DXDZL = 0.5*(PARM(9)-PARM(5))/PARM(1)
241 DXDZH = 0.5*(PARM(10)-PARM(6))/PARM(1)
242 DXML = 0.5*(PARM(9)+PARM(5))
243 DXMH = 0.5*(PARM(10)+PARM(6))
244 DXL1 = DXML+(DXYZ(3)+PAR(3))*DXDZL
245 DXL2 = DXML+(DXYZ(3)-PAR(3))*DXDZL
246 DXH1 = DXMH+(DXYZ(3)+PAR(3))*DXDZH
247 DXH2 = DXMH+(DXYZ(3)-PAR(3))*DXDZH
248 DXDY1 = 0.5*(DXH1-DXL1)/DY1
249 DXDY2 = 0.5*(DXH2-DXL2)/DY2
250 DXM1 = 0.5*(DXH1+DXL1)
251 DXM2 = 0.5*(DXH2+DXL2)
252 DX1 = DXM1+(DXYZ(2)+PAR(2))*DXDY1
253 DX2 = DXM1+(DXYZ(2)-PAR(2))*DXDY1
254 DX3 = DXM2+(DXYZ(2)+PAR(2))*DXDY2
255 DX4 = DXM2+(DXYZ(2)-PAR(2))*DXDY2
256 PAR(1) = MIN(DX1,DX2,DX3,DX4)-ABS(DXYZ(1))
257* Note; position along x-axis should be 0, when theta .ne. 0:
258 ELSE IF(PARM(7).EQ..0.AND.ABS(PARM(2)).GT..1E-5)THEN
259* the maximum length of the lower (DX2) and upper (DX1) lines along x
260 DXDZ= 0.5*(PARM(9)-PARM(5))/PARM(1)
261 DXM = 0.5*(PARM(9)+PARM(5))
262 DX1 = DXM+(DXYZ(3)+PAR(3))*DXDZ
263 DX2 = DXM+(DXYZ(3)-PAR(3))*DXDZ
264*
265* the shift in the endpoints caused by theta angle compared with
266* the symmetrical case when theta = 0
267 TANTHE = PARM(2)
268 SHFX1 = TANTHE*(DXYZ(3)+PAR(3))
269 SHFX2 = TANTHE*(DXYZ(3)-PAR(3))
270*
271 DX1P = DX1 + SHFX1
272 DX1N = DX1 - SHFX1
273 DX2P = DX2 + SHFX2
274 DX2N = DX2 - SHFX2
275*
276* DXP is the lenght of the box that fits in the positive side
277* DXN is the one in the negative side
278 DXP = MIN(DX1P,DX2P)
279 DXN = MIN(DX1N,DX2N)
280 XPOS = .5*(DXP-DXN)
281 Q(JIN+5) = XPOS
282 PAR(1) = .5*(DXP+DXN)
283 ELSE
284 TANALF = PARM(7)
285 DXDZL = 0.5*(PARM(9)-PARM(5))/PARM(1)
286 DXDZH = 0.5*(PARM(10)-PARM(6))/PARM(1)
287 DXML = 0.5*(PARM(9)+PARM(5))
288 DXMH = 0.5*(PARM(10)+PARM(6))
289 DXL1 = DXML+(DXYZ(3)+PAR(3))*DXDZL
290 DXL2 = DXML+(DXYZ(3)-PAR(3))*DXDZL
291 DXH1 = DXMH+(DXYZ(3)+PAR(3))*DXDZH
292 DXH2 = DXMH+(DXYZ(3)-PAR(3))*DXDZH
293 SHFX1 = TANALF*DY1
294 SHFX2 = TANALF*DY2
295*
296 DXH1P = DXH1+SHFX1
297 DXH1N = DXH1-SHFX1
298 DXL1P = DXL1-SHFX1
299 DXL1N = DXL1+SHFX1
300 DXH2P = DXH2+SHFX2
301 DXH2N = DXH2-SHFX2
302 DXL2P = DXL2-SHFX2
303 DXL2N = DXL2+SHFX2
304*
305 DXDY1P = 0.5*(DXH1P-DXL1P)/DY1
306 DXDY2P = 0.5*(DXH2P-DXL2P)/DY2
307 DXDY1N = 0.5*(DXH1N-DXL1N)/DY1
308 DXDY2N = 0.5*(DXH2N-DXL2N)/DY2
309*
310 DXM1P = 0.5*(DXH1P+DXL1P)
311 DXM2P = 0.5*(DXH2P+DXL2P)
312 DXM1N = 0.5*(DXH1N+DXL1N)
313 DXM2N = 0.5*(DXH2N+DXL2N)
314*
315 DX1P = DXM1P+(DXYZ(2)+PAR(2))*DXDY1P
316 DX2P = DXM1P+(DXYZ(2)-PAR(2))*DXDY1P
317 DX3P = DXM2P+(DXYZ(2)+PAR(2))*DXDY2P
318 DX4P = DXM2P+(DXYZ(2)-PAR(2))*DXDY2P
319 DX1N = DXM1N+(DXYZ(2)+PAR(2))*DXDY1N
320 DX2N = DXM1N+(DXYZ(2)-PAR(2))*DXDY1N
321 DX3N = DXM2N+(DXYZ(2)+PAR(2))*DXDY2N
322 DX4N = DXM2N+(DXYZ(2)-PAR(2))*DXDY2N
323*
324 PAR(1) =MAX(0.,MIN( MIN(DX1P,DX2P,DX3P,DX4P)-
325 + DXYZ(1), MIN(DX1N,DX2N,DX3N,DX4N)+DXYZ(1)))
326 ENDIF
327 ENDIF
328 ENDIF
329 ENDIF
330 ELSE IF (ISH.EQ.2) THEN
331* TRD1
332 IF(ISHM.EQ.ISH) THEN
333* in TRD1
334 IF (PAR(4).EQ.PARM(4)) THEN
335 IZCUT = 0
336 ELSE
337 IZCUT = 1
338 ENDIF
339 DO 51 I = 1,NVAR
340 IAX = LVAR(I)
341 PAR(IAX) = PARM(IAX)
342 IF (IZCUT.EQ.0) GO TO 51
343 IF (IAX.EQ.1) THEN
344 DZ = DXYZ(3) +PARM(4) -PAR(4)
345 DPDZ = 0.5*(PARM(2) -PARM(1))/PARM(4)
346 PAR(IAX) = PARM(1) + DPDZ*DZ
347 ELSE IF (IAX.EQ.2) THEN
348 DZ = DXYZ(3) +PARM(4) +PAR(4)
349 DPDZ = 0.5*(PARM(2) -PARM(1))/PARM(4)
350 PAR(IAX) = PARM(1) + DPDZ*DZ
351 ENDIF
352 51 CONTINUE
353*
354 ENDIF
355*
356 ELSE IF (ISH.EQ.4) THEN
357*
358* TRAP
359*
360 IF (ISHM.EQ.ISH) THEN
361* in TRAP
362 IF (PAR(1).EQ.PARM(1)) THEN
363 IZCUT = 0
364 ELSE
365 IZCUT = 1
366 ENDIF
367 DO 50 I = 1,NVAR
368 IAX = LVAR(I)
369 PAR(IAX) = PARM(IAX)
370 IF (IZCUT.EQ.0) GO TO 50
371 IF (IAX.NE.1.AND.IAX.LE.6) THEN
372 DZ = DXYZ(3) +PARM(1) -PAR(1)
373 DPDZ = 0.5*(PARM(IAX+4) -PARM(IAX))/PARM(1)
374 PAR(IAX) = PARM(IAX) + DPDZ*DZ
375 ELSE IF (IAX.GT.6) THEN
376 DZ = DXYZ(3) +PARM(1) +PAR(1)
377 DPDZ = 0.5*(PARM(IAX) -PARM(IAX-4))/PARM(1)
378 PAR(IAX) = PARM(IAX-4) + DPDZ*DZ
379 ENDIF
380 50 CONTINUE
381 IF (IZCUT.NE.0) THEN
382 HTAH = PARM(8)*PARM(11)
383 HTAL = PARM(4)*PARM(7)
384 ZZ1 = 0.5*(DXYZ(3) +PARM(1) -PAR(1))/PARM(1)
385 PAR(7) = (HTAL*(1.-ZZ1) + HTAH*ZZ1)/PAR(4)
386 ZZ2 = 0.5*(DXYZ(3) +PARM(1) +PAR(1))/PARM(1)
387 PAR(11)= (HTAL*(1.-ZZ2) + HTAH*ZZ2)/PAR(8)
388 ENDIF
389 IF(IAX.EQ.2.AND.IZCUT.EQ.0) THEN
390 DXDY1 = 0.5*(PARM(6)-PARM(5))/PARM(4)
391 DXDY2 = 0.5*(PARM(10)-PARM(9))/PARM(8)
392 DXM1 = 0.5*(PARM(6)+PARM(5))
393 DXM2 = 0.5*(PARM(10)+PARM(9))
394 DXH1 = DXM1+(DXYZ(2)+PAR(2))*DXDY1
395 DXH2 = DXM2+(DXYZ(2)+PAR(2))*DXDY2
396 DXL1 = DXM1+(DXYZ(2)-PAR(2))*DXDY1
397 DXL2 = DXM2+(DXYZ(2)-PAR(2))*DXDY2
398 PAR(5) = DXL1
399 PAR(6) = DXH1
400 PAR(9) = DXL2
401 PAR(10) = DXH2
402 ENDIF
403 ENDIF
404 CALL GNOTR1 (PAR)
405*
406 ELSE IF (ISH.EQ.5) THEN
407*
408* TUBE
409*
410 IF(ISHM.EQ.ISH) THEN
411 IRMIN = 0
412 IRMAX = 0
413 IDZED = 0
414 DO 60 JVAR=1,NVAR
415 IF(LVAR(JVAR).EQ.1) IRMIN=1
416 IF(LVAR(JVAR).EQ.2) IRMAX=1
417 IF(LVAR(JVAR).EQ.3) IDZED=1
418 60 CONTINUE
419 RPOS = SQRT(DXYZ(1)**2+DXYZ(2)**2)
420 IF(IRMIN.EQ.1) THEN
421*
422* Here we settle the minimum radius.
423*
424 IF(PARM(1).GT.0.) THEN
425 PAR(1) = PARM(1)+RPOS
426 ELSE
427 PAR(1) = 0.
428 ENDIF
429 ENDIF
430 IF(IRMAX.EQ.1) THEN
431*
432* Case in which the max radius is variable.
433*
434 IF(PAR(1).LE.RPOS-PARM(1).AND.PARM(1).GT.0.) THEN
435*
436* This is the case in which the 'hole' in the tube does not
437* intersect the 'hole' in the mother.
438*
439 PAR(2) = MIN(PARM(2)-RPOS,RPOS-PARM(1))
440 ELSEIF(PAR(1).GE.RPOS+PARM(1).OR.PARM(1).EQ.0.) THEN
441*
442* This is the case in which the 'hole' in the tube contains the
443* 'hole' in the mother, or there is no 'hole' in the mother.
444*
445 PAR(2) = PARM(2)-RPOS
446 ELSE
447*
448* And this is the error condition. The inner tube protrudes in the empty
449* space inside the outer one.
450*
451 WRITE(CHMAIL,11100) IQ(JVOLUM+IVO)
452 CALL GMAIL(0,0)
453 IEORUN = 1
454 ENDIF
455 ENDIF
456 IF(IDZED.EQ.1) THEN
457 PAR(3) = PARM(3)-ABS(DXYZ(3))
458 ENDIF
459 IF(PAR(1).GE.PAR(2).OR.PAR(2).GT.PARM(2)
460 + .OR.PAR(3).LE.0.) THEN
461 WRITE(CHMAIL,11000) IQ(JVOLUM+IVO)
462 CALL GMAIL(0, 0)
463 IEORUN = 1
464 ENDIF
465 ELSE
466 WRITE (CHMAIL, 10900) ISH, ISHM
467 CALL GMAIL (0, 0)
468 IEORUN=1
469 ENDIF
470 ELSE IF (ISH.LE.10) THEN
471*
472* TRD1,TRD2,TUBE,TUBS,CONE,CONS,SPHE,PARA
473*
474 IF (ISHM.EQ.ISH) THEN
475* in TRD1,TRD2,TUBE,TUBS,CONE,CONS,SPHE,PARA
476 IF (DXYZ(1).NE.0..OR.DXYZ(2).NE.0..OR.DXYZ(3).NE.0.)
477 + THEN
478 WRITE (CHMAIL, 10700) ISH, ISHM
479 CALL GMAIL (0, 0)
480 IEORUN = 1
481 ELSE
482 DO 70 I= 1, NVAR
483 IAX = LVAR(I)
484 PAR(IAX) = PARM(IAX)
485 70 CONTINUE
486 ENDIF
487 ENDIF
488*
489 ELSE IF (ISH.LE.12) THEN
490*
491* PGON,PCON
492*
493 IF (ISHM.EQ.ISH) THEN
494* in PGON,PCON
495 IF (ISH.EQ.11) THEN
496 IPNZ = 4
497 ELSE
498 IPNZ = 3
499 ENDIF
500 NZ = PAR(IPNZ)
501 NZ1 = PARM(IPNZ)
502 IF (NZ.NE.2 .OR. NZ1.NE.2) THEN
503 WRITE (CHMAIL, 10900) ISH, ISHM
504 CALL GMAIL (0, 0)
505 IEORUN = 1
506 ELSE
507 ZL = PARM(IPNZ+1)
508 ZH = PARM(IPNZ+4)
509 DZ = ZH - ZL
510 TANLOW = (PARM(IPNZ+5)-PARM(IPNZ+2))/DZ
511 TANHIG = (PARM(IPNZ+6)-PARM(IPNZ+3))/DZ
512 Z1 = DXYZ(3) + PAR(IPNZ+1) - PARM(IPNZ+1)
513 Z2 = DXYZ(3) + PAR(IPNZ+4) - PARM(IPNZ+1)
514 PAR(IPNZ+2) = PARM(IPNZ+2) + TANLOW * Z1
515 PAR(IPNZ+3) = PARM(IPNZ+3) + TANHIG * Z1
516 PAR(IPNZ+5) = PARM(IPNZ+2) + TANLOW * Z2
517 PAR(IPNZ+6) = PARM(IPNZ+3) + TANHIG * Z2
518 ENDIF
519 ENDIF
520*
521 ENDIF
522*
52310300 FORMAT (' GGPPAR : Rotations not accepted at the moment')
52410400 FORMAT (' GGPPAR : Shape association not accepted', 2I5)
52510500 FORMAT (' GGPPAR : PAR(IAX) negative, ISH,ISHM,IAX=',3I5)
52610600 FORMAT (' GGPPAR : DZ negative, ISH,ISHM,IAX,DZ=',3I5,G12.4)
52710700 FORMAT (' GGPPAR : Not yet coded for ISH,ISHM=',2I5)
52810800 FORMAT (' GGPPAR : PARM error for ISH,ISHM,IAX=',3I5)
52910900 FORMAT (' GGPPAR : Configuration not accepted, ISH,ISHM=',2I5)
53011000 FORMAT (' GGPPAR : Tube ',A4,' has inconsistent parameters')
53111100 FORMAT (' GGPPAR : Tube ',A4,' protrudes into the inner space ',
532 + 'of the mother')
533* END GGPPAR
534 999 END