]> git.uio.no Git - u/mrichter/AliRoot.git/blame - GEANT321/miface/gfmfin.F
git://git.uio.no / u / mrichter / AliRoot.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Bugfix in AliPoints2Memory
[u/mrichter/AliRoot.git] / GEANT321 / miface / gfmfin.F
CommitLineData
fe4da5cc 1*
2* $Id$
3*
4* $Log$
5* Revision 1.1.1.1 1995/10/24 10:21:53 cernlib
6* Geant
7*
8*
9#include "geant321/pilot.h"
10*CMZ : 3.21/02 29/03/94 15.41.47 by S.Giani
11*-- Author :
12 SUBROUTINE GFMFIN
13#include "geant321/gcbank.inc"
14#include "geant321/gccuts.inc"
15#include "geant321/gcjloc.inc"
16#include "geant321/gcflag.inc"
17#include "geant321/gckine.inc"
18#include "geant321/gcking.inc"
19#include "geant321/gcmate.inc"
20#include "geant321/gcphys.inc"
21#include "geant321/gctrak.inc"
22#include "geant321/gsecti.inc"
23#include "geant321/gctmed.inc"
24#include "geant321/gcunit.inc"
25#include "geant321/dimpar.inc"
26
27#if !defined(CERNLIB_SINGLE)
28#include "geant321/finuct.inc"
29#endif
30#include "geant321/finuc.inc"
31 REAL RNDM(1)
32#if !defined(CERNLIB_SINGLE)
33 DOUBLE PRECISION AOCMBM, AMSS , ZTAR, RHO , ZLIN, ZLEL, ZLRAD,
34 +ZUL
35#endif
36 COMMON / FKMAPA / AOCMBM (MXXMDF), AMSS (MXXMDF), ZTAR (MXXMDF),
37 + RHO (MXXMDF), ZLIN (MXXMDF), ZLEL (MXXMDF),
38 + ZLRAD (MXXMDF), ZUL (MXXMDF), MEDIUM (MXXRGN),
39 + MULFLG (MXXMDF),IFCOMP(MXXMDF), MSSNUM (MXXMDF),
40 + NREGS, NMATF, MTBSNM
41#if !defined(CERNLIB_SINGLE)
42#include "geant321/part2t.inc"
43#endif
44#include "geant321/part2.inc"
45#if !defined(CERNLIB_SINGLE)
46#include "geant321/comcont.inc"
47#endif
48#include "geant321/comcon.inc"
49#if !defined(CERNLIB_SINGLE)
50#include "geant321/fheavyt.inc"
51#endif
52#include "geant321/fheavy.inc"
53#include "geant321/paprop.inc"
54#if !defined(CERNLIB_SINGLE)
55#include "geant321/papropt.inc"
56#endif
57#include "geant321/gfkdis.inc"
58#if !defined(CERNLIB_SINGLE)
59 DOUBLE PRECISION POO,EKE,TXI,TYI,TZI,AMM,WE,ONE,PGEANT,DMOD
60#endif
61 PARAMETER (ONE=1)
62 DIMENSION IGTOFL(49),IFLTOG(39),IHVTOG(6),ZSAMP(50)
63 DATA IGTOFL / 0, 0, 0, 0, 0, 0,23,13,14,12, 15,16, 8, 1, 2,19, 0,
64 +17,21,22, 20, 34, 36, 38, 9,18, 31, 32, 33, 35, 37, 39, 17*0/
65
66 DATA IFLTOG /14,15, 3, 2, 4, 4, 1,13,25, 5, 6,10, 8, 9,11,12,18,
67 +26,16,21, 19,20, 7, 7*0, 27, 28, 29, 22, 30, 23, 31, 24, 32/
68 DATA IHVTOG /13,14,45,46,49,47/
69*
70 NP = 0
71 NPHEAV = 0
72*
73* Stopped particles:
74* o Neutral particles are sent to GHSTOP
75* o pi+ and K+/K- are forced to decay
76* o pi-, antiprotons and antineutrons are sent to FLUKA
77* for annihilation (not here but later in this routine)
78 IF (IGF.EQ.2.OR.(GEKIN.EQ.0.0.AND.IPART.EQ.13)) THEN
79 IF (GEKIN.LT.CUTNEU) THEN
80 GEKIN = MAX(GEKIN,1E-14)
81* should kinetic energy be deposited?
82 ISTOP = 2
83 IGF = 0
84 GOTO 110
85 ENDIF
86 CALL GMICAP
87 IGF = 0
88 GOTO 110
89 ELSE IF (GEKIN.EQ.0..AND.
90 + (IPART.EQ.8.OR.IPART.EQ.12.OR.IPART.EQ.11)) THEN
91 CALL GDECAY
92 NMEC=NMEC+1
93 LMEC(NMEC)=5
94 ISTOP=1
95 GOTO 999
96 ENDIF
97*
98 IF (IFINIT(5) .EQ. 0) CALL FLINIT
99 INT=0
100 IJ=IGTOFL(IPART)
101 IF(IJ.EQ.0) GOTO 110
102 NMEC = NMEC + 1
103 EKE = GEKIN
104 TXI = VECT(4)
105 TYI = VECT(5)
106 TZI = VECT(6)
107 DMOD = ONE/SQRT(TXI**2+TYI**2+TZI**2)
108 TXI = TXI*DMOD
109 TYI = TYI*DMOD
110 TZI = TZI*DMOD
111 WE = 1.
112 JMA = LQ(JMATE-NMAT)
113 NCOMP = ABS (Q(JMA+11))
114 AMM = Q(JMA+6)
115 JMIXT = LQ(JMA-5)
116
117* Antiprotons, antineutrons and pi- are sent to
118* eventv for annihilation
119 IF (GEKIN.EQ.0..AND.
120 + (IPART.EQ.15.OR.IPART.EQ.9.OR.IPART.EQ.25)) THEN
121 IF(NCOMP.LE.1) THEN
122 AMSS(1) = Q(JMA+6)
123 ZTAR(1) = Q(JMA+7)
124 MSSNUM(1) = 0
125 RHO(1) = Q(JMA+8)
126 ELSE
127 ZSAMP(1) = 0.
128 DO 10 I=1,NCOMP
129 ZSAMP(I+1) = ZSAMP(I) + Q(JMIXT+NCOMP+I)
130 10 CONTINUE
131 CALL GRNDM(RNDM,1)
132 ZCONT=ZSAMP(NCOMP+1)*RNDM(1)
133 DO 20 I=1,NCOMP
134 IF(ZCONT.LE.ZSAMP(I+1)) GO TO 30
135 20 CONTINUE
136 I = NCOMP
137 30 CONTINUE
138 AMSS(1) = Q(JMIXT+I)
139 MSSNUM(1) = 0
140 ZTAR(1) = Q(JMIXT+NCOMP+I)
141 RHO(1) = Q(JMIXT+2*NCOMP+I)*DENS
142 END IF
143 EKE = 1E-9
144 POO=SQRT(EKE*(EKE+2*AM(IJ)))
145 CALL EVENTV(IJ,POO,EKE,TXI,TYI,TZI,WE,1)
146 GOTO 80
147 ELSE IF (GEKIN.LE.CUTHAD .AND. ITRTYP.EQ.4) THEN
148 DESTEP = DESTEP + GEKIN
149 GEKIN = 0.
150 GETOT = AMASS
151 VECT(7) = 0.
152 ISTOP = 1
153 GO TO 110
154 ENDIF
155*
156 CALL GRNDM(RNDM,1)
157 RNDEVT=RNDM(1)
158 IF ( RNDEVT .GE. SINE/FSIG) THEN
159
160 IF (GEKIN .GT. 0.02) THEN
161 POO=SQRT(EKE*(EKE+2*AM(IJ)))
162 ELSE
163 GO TO 110
164 END IF
165 INT=1
166 LMEC(NMEC)=13
167 IF(NCOMP.LE.1) THEN
168 CALL NUCREL(IJ,POO,EKE,TXI,TYI,TZI,AMM,WE)
169 ELSE
170 CALL GRNDM(RNDM,1)
171 RCONT=ELXNOR*RNDM(1)
172 DO 40 I=1,NCOMP
173 IF(RCONT.LE.CABELX(I)) GO TO 50
174 40 CONTINUE
175 I=NCOMP
176 50 CONTINUE
177 CALL NUCREL(IJ,POO,EKE,TXI,TYI,TZI,ONE*Q(JMIXT+I),WE)
178 END IF
179 ELSE
180 LMEC(NMEC)=20
181 IF (IHADR.EQ.2) THEN
182 ISTOP = 2
183 DESTEP = DESTEP + GETOT
184 GO TO 110
185 ENDIF
186 IF (GEKIN .GT. 0.02) THEN
187 POO=SQRT(EKE*(EKE+2*AM(IJ)))
188 ELSE
189 IF ((IJ.EQ.2 .OR. IJ.EQ.9 .OR. IJ.EQ.14 .OR. IJ.EQ.16)
190 + .AND. GEKIN .GT. 0.0) THEN
191 POO=SQRT(EKE*(EKE+2*AM(IJ)))
192 ELSE
193 NMEC=NMEC-1
194 GO TO 110
195 END IF
196 END IF
197 INT=2
198 IF(NCOMP.LE.1) THEN
199 AMSS(1) = Q(JMA+6)
200 ZTAR(1) = Q(JMA+7)
201 MSSNUM(1) = 0
202 RHO(1) = Q(JMA+8)
203 ELSE
204 CALL GRNDM(RNDM,1)
205 RCONT=ANXNOR*RNDM(1)
206 DO 60 I=1,NCOMP
207 IF(RCONT.LE.CABINX(I)) GO TO 70
208 60 CONTINUE
209 I=NCOMP
210 70 CONTINUE
211 AMSS(1) = Q(JMIXT+I)
212 MSSNUM(1) = 0
213 ZTAR(1) = Q(JMIXT+NCOMP+I)
214 RHO(1) = Q(JMIXT+2*NCOMP+I)*DENS
215 END IF
216 CALL EVENTV(IJ,POO,EKE,TXI,TYI,TZI,WE,1)
217 END IF
218*
219 80 IF(NP.EQ.1.AND.NPHEAV.EQ.0.AND.KPART(1).EQ.IJ) THEN
220 VECT(4)=CXR(1)
221 VECT(5)=CYR(1)
222 VECT(6)=CZR(1)
223 VECT(7)=SQRT(TKI(1)*(TKI(1)+2*AMASS))
224 GETOT=TKI(1)+AMASS
225 GEKIN=TKI(1)
226 ELSE
227 ISTOP=1
228 NSTAK1 = MIN(NP,MXGKIN-NGKINE)
229 IF(NP.GT.NSTAK1) THEN
230 WRITE(CHMAIL,10000) NP-NSTAK1
231 CALL GMAIL(0,0)
232 ENDIF
233 DO 90 K=1,NSTAK1
234 NGKINE = NGKINE + 1
235 IF (KPART(K) .EQ. 24 .OR. KPART(K) .EQ. 25) THEN
236 KPART(K) = 19
237 CALL GRNDM(RNDM,1)
238 IF (RNDM(1) .GT. 0.5) KPART(K) = 12
239 END IF
240 IGEPAR = IFLTOG(KPART(K))
241 JPA = LQ(JPART-IGEPAR)
242 AGEMAS = Q(JPA+7)
243 PGEANT = SQRT(TKI(K)*(TKI(K)+2*AGEMAS))
244 GKIN(1,NGKINE)=CXR(K)*PGEANT
245 GKIN(2,NGKINE)=CYR(K)*PGEANT
246 GKIN(3,NGKINE)=CZR(K)*PGEANT
247 GKIN(4,NGKINE)=TKI(K)+AGEMAS
248 GKIN(5,NGKINE)=IGEPAR
249 TOFD(NGKINE)=0.0
250 GPOS(1,NGKINE) = VECT(1)
251 GPOS(2,NGKINE) = VECT(2)
252 GPOS(3,NGKINE) = VECT(3)
253 90 CONTINUE
254*
255 NSTAK2 = MIN(NPHEAV,MXGKIN-NGKINE)
256 IF(NPHEAV.GT.NSTAK2) THEN
257 WRITE(CHMAIL,10100) NPHEAV-NSTAK2
258 CALL GMAIL(0,0)
259 ENDIF
260 DO 100 K=1,NSTAK2
261 NGKINE = NGKINE + 1
262 IGEPAR = IHVTOG(KHEAVY(K))
263 JPA = LQ(JPART-IGEPAR)
264 AGEMAS = Q(JPA+7)
265 PGEANT = SQRT(TKHEAV(K)*(TKHEAV(K)+2*AGEMAS))
266 GKIN(1,NGKINE)=CXHEAV(K)*PGEANT
267 GKIN(2,NGKINE)=CYHEAV(K)*PGEANT
268 GKIN(3,NGKINE)=CZHEAV(K)*PGEANT
269 GKIN(4,NGKINE)=TKHEAV(K)+AGEMAS
270 GKIN(5,NGKINE)=IGEPAR
271 TOFD(NGKINE)=0.0
272 GPOS(1,NGKINE) = VECT(1)
273 GPOS(2,NGKINE) = VECT(2)
274 GPOS(3,NGKINE) = VECT(3)
275 100 CONTINUE
276*
277 KCASE=NAMEC(12)
278 END IF
279 110 CONTINUE
280 ZINTHA = GARNDM(DUMMY)
281 SLHADR = SLENG
282 STEPHA = 1.0E10
28310000 FORMAT(' **** FLUFIN: Stack overflow, ',I6,' particles lost')
28410100 FORMAT(' **** FLUFIN: Stack overflow, ',I6,
285 +' heavy particles lost')
286 999 END