This commit was generated by cvs2svn to compensate for changes in r2,
[u/mrichter/AliRoot.git] / GEANT321 / miface / gfmfin.F
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
283 10000 FORMAT(' **** FLUFIN: Stack overflow, ',I6,' particles lost')
284 10100 FORMAT(' **** FLUFIN: Stack overflow, ',I6,
285      +' heavy particles lost')
286   999 END