Bugfix in AliPoints2Memory
[u/mrichter/AliRoot.git] / GEANT321 / fluka / fkdeca.F
CommitLineData
fe4da5cc 1*
2* $Id$
3*
4* $Log$
5* Revision 1.1.1.1 1995/10/24 10:20:06 cernlib
6* Geant
7*
8*
9#include "geant321/pilot.h"
10*CMZ : 3.21/02 29/03/94 15.41.45 by S.Giani
11*-- Author :
12*=== decay ============================================================*
13*
14 SUBROUTINE FKDECA(IHAD,ISTAB)
15
16#include "geant321/dblprc.inc"
17#include "geant321/dimpar.inc"
18#include "geant321/iounit.inc"
19*
20*----------------------------------------------------------------------*
21* Decay89: slight revision by A. Ferrari *
22*----------------------------------------------------------------------*
23*
24#include "geant321/finpar2.inc"
25#include "geant321/metlsp.inc"
26#include "geant321/part.inc"
27#include "geant321/decayc.inc"
28 COMMON /FKDREI/ TEST(12)
29 COMMON /FKGAMR/REDU,AMO,AMM(15)
30 COMMON /FKPRUN/ISYS
31 REAL RNDM(1)
32C
33C
34 REDU=2.D0
35 DO 801 I=1,IHAD
36 ITS(I) = NREF(I)
37 PLS(I) = SQRT(PXF(I)**2 + PYF(I)**2 + PZF(I)**2)
38 IF (PLS(I) .NE. 0.D0) THEN
39 CXS(I) = PXF(I)/PLS(I)
40 CYS(I) = PYF(I)/PLS(I)
41 CZS(I) = PZF(I)/PLS(I)
42 END IF
43 ELS(I) = HEF(I)
44 801 CONTINUE
45 IST = IHAD
46 IR = 0
47 200 CONTINUE
48C*****TEST STABLE OR UNSTABLE
49C$$$$$ISTAB=1/2/3 MEANS STRONG + WEAK DECAYS / ONLY STRONG DECAYS /
50C*****STRONG DECAYS + WEAK DECAYS FOR CHARMED PARTICLES AND TAU LEPTONS
51 IF(ISTAB.EQ.1) GOTO 793
52 IF(ISTAB.EQ.2) GOTO 737
53 IF(ISTAB.EQ.3) GOTO 738
54 793 IF(ITS(IST).EQ.135.OR.ITS(IST).EQ.136) GOTO 202
55 IF(ITS(IST).GE.1.AND.ITS(IST).LE.7) GOTO 202
56 GOTO 300
57 738 IF(ITS(IST).GE.1.AND.ITS(IST).LE.30) GOTO 202
58 IF(ITS(IST).GE. 97.AND.ITS(IST).LE.103) GOTO 202
59 IF(ITS(IST).EQ.109.OR.ITS(IST).EQ.115) GOTO 202
60 IF(ITS(IST).GE.133.AND.ITS(IST).LE.136) GOTO 202
61 GOTO 300
62 737 IF(ITS(IST).GE. 1.AND.ITS(IST).LE. 30) GOTO 202
63 IF(ITS(IST).GE. 97.AND.ITS(IST).LE.103) GOTO 202
64 IF(ITS(IST).GE.115.AND.ITS(IST).LE.122) GOTO 202
65 IF(ITS(IST).GE.131.AND.ITS(IST).LE.136) GOTO 202
66 IF(ITS(IST).EQ.109) GO TO 202
67 IF(ITS(IST).GE.137.AND.ITS(IST).LE.160) GOTO 202
68 GO TO 300
69 202 IR = IR + 1
70 NREF(IR) = ITS(IST)
71 ITT = ITS(IST)
72 AMF(IR) = AM(ITT)
73 ANF(IR) = ANAME(ITT)
74 ICHF(IR) = ICH(ITT)
75 IBARF(IR) = IBAR(ITT)
76 HEF(IR) = ELS(IST)
77 PXF(IR) = CXS(IST)*PLS(IST)
78 PYF(IR) = CYS(IST)*PLS(IST)
79 PZF(IR) = CZS(IST)*PLS(IST)
80 IST = IST - 1
81 IF(IST .GE. 1) GO TO 200
82 GO TO 500
83 300 IT = ITS(IST)
84 GAM = ELS(IST)/AM(IT)
85 BGAM = PLS(IST)/AM(IT)
86 ECO = AM(IT)
87 KZ1 = K1(IT)
88 310 CONTINUE
89 CALL GRNDM(RNDM,1)
90 VV = RNDM(1) - 1.D-17
91 IIK = KZ1 - 1
92 301 IIK = IIK + 1
93 IF (VV.GT.WT(IIK)) GO TO 301
94C IIK IS THE DECAY CHANNEL
95 IT1 = NZK(IIK,1)
96 IT2 = NZK(IIK,2)
97 IF (IT2-1 .LT. 0) GO TO 110
98 IT3 = NZK(IIK,3)
99C IT1,IT2, IT3 ARE THE PRODUCED PARTICLES FROM IT
100 IF(IT3 .EQ. 0) GO TO 400
101 CALL THREPD(ECO,ECM1,ECM2,ECM3,PCM1,PCM2,PCM3,COD1,COF1,SIF1,COD2,
102 & COF2,SIF2,COD3,COF3,SIF3,AM(IT1),AM(IT2),AM(IT3))
103 GO TO 411
104 400 CALL TWOPAD(ECO,ECM1,ECM2,PCM1,PCM2,COD1,COF1,SIF1,COD2,COF2,SIF2,
105 & AM(IT1),AM(IT2))
106 411 CONTINUE
107 110 CONTINUE
108 ITS(IST) = IT1
109 IF (IT2-1 .LT. 0) GO TO 305
110 ITS(IST+1) = IT2
111 ITS(IST+2) = IT3
112 RX = CXS(IST)
113 RY = CYS(IST)
114 RZ = CZS(IST)
115 CALL TRAFO(GAM,BGAM,RX,RY,RZ,COD1,COF1,SIF1,PCM1,ECM1,
116 & PLS(IST),CXS(IST),CYS(IST),CZS(IST),ELS(IST))
117 IST = IST + 1
118 CALL TRAFO(GAM,BGAM,RX,RY,RZ,COD2,COF2,SIF2,PCM2,ECM2,
119 & PLS(IST),CXS(IST),CYS(IST),CZS(IST),ELS(IST))
120 IF (IT3 .LE. 0) GO TO 305
121 IST = IST + 1
122 CALL TRAFO(GAM,BGAM,RX,RY,RZ,COD3,COF3,SIF3,PCM3,ECM3,
123 & PLS(IST),CXS(IST),CYS(IST),CZS(IST),ELS(IST))
124 305 CONTINUE
125 GO TO 200
126 500 CONTINUE
127 IDAPU = IDMAX3
128 IF(IR .GT. IDMAX3) WRITE(ISYS,928)IDAPU
129 928 FORMAT(' NUMBER OF STAB. FINAL PART. IS GREATER THAN',I5)
130 IHAD = IR
131 RETURN
132 END