5 * Revision 1.3 1997/06/20 18:32:55 japost
6 * A summary of the problem buf fix and its original report:
8 * ------------------------------------------------------------------------------
9 * From: Shawn McKee - (313) 764-4395 <mckee@pooh.physics.lsa.umich.edu>
10 * Subject: RE: Problem with FLUKA interface
11 * Date: Thu, 12 Jun 97 18:09:31 METDST
14 * I have seen this error with FLUKA. I traced it to
15 * the following statement:
17 * IF (RNDEVT .GE. SINE/FSIG) THEN
19 * Apparently FSIG (for this event) was not initialized
20 * properly (it is 0.0). My fix was to insert a check
21 * on FSIG in the FLUFIN routine source.
23 * ------------------------------------------------------------------------------
24 * From: pniemine@estwm0.wm.estec.esa.nl
25 * Subject: Problem with FLUKA interface - cern.heplib #5667
26 * Date: Thu, 12 Jun 97 17:21:14 METDST
28 * In trying to run a GEANT program with FLUKA interface in our VMS-AXP (Alpha)
29 * cluster, I get the following error message (originating from FLUFIN) once
30 * a hadronic interaction is to be simulated:
32 * arithmetic trap, floating/decimal divide by zero
33 * ------------------------------------------------------------------------------
35 * Revision 1.2 1996/02/27 14:12:57 ravndal
36 * Correction for overstopped antiprotons
38 * Revision 1.1.1.1 1995/10/24 10:19:53 cernlib
42 #include "geant321/pilot.h"
43 *CMZ : 3.21/02 19/05/94 13.35.12 by S.Ravndal
46 #include "geant321/gcbank.inc"
47 #include "geant321/gccuts.inc"
48 #include "geant321/gcjloc.inc"
49 #include "geant321/gcflag.inc"
50 #include "geant321/gckine.inc"
51 #include "geant321/gcking.inc"
52 #include "geant321/gcmate.inc"
53 #include "geant321/gcphys.inc"
54 #include "geant321/gctrak.inc"
55 #include "geant321/gsecti.inc"
56 #include "geant321/gctmed.inc"
57 #include "geant321/gcunit.inc"
58 #include "geant321/dimpar.inc"
60 #if !defined(CERNLIB_SINGLE)
61 #include "geant321/finuct.inc"
63 #include "geant321/finuc.inc"
65 #if !defined(CERNLIB_SINGLE)
66 DOUBLE PRECISION AOCMBM, AMSS , ZTAR, RHO , ZLIN, ZLEL, ZLRAD,
69 COMMON / FKMAPA / AOCMBM (MXXMDF), AMSS (MXXMDF), ZTAR (MXXMDF),
70 + RHO (MXXMDF), ZLIN (MXXMDF), ZLEL (MXXMDF),
71 + ZLRAD (MXXMDF), ZUL (MXXMDF), MEDIUM (MXXRGN),
72 + MULFLG (MXXMDF),IFCOMP(MXXMDF), MSSNUM (MXXMDF),
73 + NREGS, NMATF, MTBSNM
74 #if !defined(CERNLIB_SINGLE)
75 #include "geant321/part2t.inc"
77 #include "geant321/part2.inc"
78 #if !defined(CERNLIB_SINGLE)
79 #include "geant321/comcont.inc"
81 #include "geant321/comcon.inc"
82 #if !defined(CERNLIB_SINGLE)
83 #include "geant321/fheavyt.inc"
85 #include "geant321/fheavy.inc"
86 #include "geant321/paprop.inc"
87 #if !defined(CERNLIB_SINGLE)
88 #include "geant321/papropt.inc"
90 #include "geant321/gfkdis.inc"
91 #if !defined(CERNLIB_SINGLE)
92 DOUBLE PRECISION POO,EKE,TXI,TYI,TZI,AMM,WE,ONE,PGEANT,DMOD
95 DIMENSION IGTOFL(49),IFLTOG(39),IHVTOG(6),ZSAMP(50)
96 DATA IGTOFL / 0, 0, 0, 0, 0, 0,23,13,14,12, 15,16, 8, 1, 2,19, 0,
97 +17,21,22, 20, 34, 36, 38, 9,18, 31, 32, 33, 35, 37, 39, 17*0/
99 DATA IFLTOG /14,15, 3, 2, 4, 4, 1,13,25, 5, 6,10, 8, 9,11,12,18,
100 +26,16,21, 19,20, 7, 7*0, 27, 28, 29, 22, 30, 23, 31, 24, 32/
101 DATA IHVTOG /13,14,45,46,49,47/
107 * o Neutral particles are sent to GHSTOP
108 * o pi+ and K+/K- are forced to decay
109 * o pi-, antiprotons and antineutrons are sent to FLUKA
110 * for annihilation (not here but later in this routine)
112 + (GEKIN.EQ.0..AND.ITRTYP.EQ.3.AND.IPART.NE.25)) THEN
116 ELSE IF (GEKIN.EQ.0..AND.
117 + (IPART.EQ.8.OR.IPART.EQ.12.OR.IPART.EQ.11)) THEN
125 IF (IFINIT(5) .EQ. 0) CALL FLINIT
134 DMOD = ONE/SQRT(TXI**2+TYI**2+TZI**2)
140 NCOMP = ABS (Q(JMA+11))
144 * Antiprotons, antineutrons and pi- are sent to
145 * eventv for annihilation
147 + (IPART.EQ.15.OR.IPART.EQ.9.OR.IPART.EQ.25)) THEN
156 ZSAMP(I+1) = ZSAMP(I) + Q(JMIXT+NCOMP+I)
159 ZCONT=ZSAMP(NCOMP+1)*RNDM(1)
161 IF(ZCONT.LE.ZSAMP(I+1)) GO TO 30
167 ZTAR(1) = Q(JMIXT+NCOMP+I)
168 RHO(1) = Q(JMIXT+2*NCOMP+I)*DENS
171 POO=SQRT(EKE*(EKE+2*AM(IJ)))
172 CALL EVENTV(IJ,POO,EKE,TXI,TYI,TZI,WE,1)
176 ELSE IF (GEKIN.LE.CUTHAD .AND. ITRTYP.EQ.4) THEN
177 DESTEP = DESTEP + GEKIN
194 IF ( RNDEVT .GE. SRAT) THEN
195 IF (GEKIN .GT. 0.02) THEN
196 POO=SQRT(EKE*(EKE+2*AM(IJ)))
203 CALL NUCREL(IJ,POO,EKE,TXI,TYI,TZI,AMM,WE)
208 IF(RCONT.LE.CABELX(I)) GO TO 50
212 CALL NUCREL(IJ,POO,EKE,TXI,TYI,TZI,ONE*Q(JMIXT+I),WE)
218 DESTEP = DESTEP + GETOT
221 IF (GEKIN .GT. 0.02) THEN
222 POO=SQRT(EKE*(EKE+2*AM(IJ)))
224 IF ((IJ.EQ.2 .OR. IJ.EQ.9 .OR. IJ.EQ.14 .OR. IJ.EQ.16)
225 + .AND. GEKIN .GT. 0.0) THEN
226 POO=SQRT(EKE*(EKE+2*AM(IJ)))
242 IF(RCONT.LE.CABINX(I)) GO TO 70
248 ZTAR(1) = Q(JMIXT+NCOMP+I)
249 RHO(1) = Q(JMIXT+2*NCOMP+I)*DENS
251 CALL EVENTV(IJ,POO,EKE,TXI,TYI,TZI,WE,1)
254 80 IF(NP.EQ.1.AND.NPHEAV.EQ.0.AND.KPART(1).EQ.IJ) THEN
258 VECT(7)=SQRT(TKI(1)*(TKI(1)+2*AMASS))
263 NSTAK1 = MIN(NP,MXGKIN-NGKINE)
264 IF(NP.GT.NSTAK1) THEN
265 WRITE(CHMAIL,10000) NP-NSTAK1
270 IF (KPART(K) .EQ. 24 .OR. KPART(K) .EQ. 25) THEN
273 IF (RNDM(1) .GT. 0.5) KPART(K) = 12
275 IGEPAR = IFLTOG(KPART(K))
276 JPA = LQ(JPART-IGEPAR)
278 PGEANT = SQRT(TKI(K)*(TKI(K)+2*AGEMAS))
279 GKIN(1,NGKINE)=CXR(K)*PGEANT
280 GKIN(2,NGKINE)=CYR(K)*PGEANT
281 GKIN(3,NGKINE)=CZR(K)*PGEANT
282 GKIN(4,NGKINE)=TKI(K)+AGEMAS
283 GKIN(5,NGKINE)=IGEPAR
285 GPOS(1,NGKINE) = VECT(1)
286 GPOS(2,NGKINE) = VECT(2)
287 GPOS(3,NGKINE) = VECT(3)
290 NSTAK2 = MIN(NPHEAV,MXGKIN-NGKINE)
291 IF(NPHEAV.GT.NSTAK2) THEN
292 WRITE(CHMAIL,10100) NPHEAV-NSTAK2
297 IGEPAR = IHVTOG(KHEAVY(K))
298 JPA = LQ(JPART-IGEPAR)
300 PGEANT = SQRT(TKHEAV(K)*(TKHEAV(K)+2*AGEMAS))
301 GKIN(1,NGKINE)=CXHEAV(K)*PGEANT
302 GKIN(2,NGKINE)=CYHEAV(K)*PGEANT
303 GKIN(3,NGKINE)=CZHEAV(K)*PGEANT
304 GKIN(4,NGKINE)=TKHEAV(K)+AGEMAS
305 GKIN(5,NGKINE)=IGEPAR
307 GPOS(1,NGKINE) = VECT(1)
308 GPOS(2,NGKINE) = VECT(2)
309 GPOS(3,NGKINE) = VECT(3)
315 ZINTHA = GARNDM(DUMMY)
318 10000 FORMAT(' **** FLUFIN: Stack overflow, ',I6,' particles lost')
319 10100 FORMAT(' **** FLUFIN: Stack overflow, ',I6,
320 +' heavy particles lost')