This commit was generated by cvs2svn to compensate for changes in r2,
[u/mrichter/AliRoot.git] / GEANT321 / fluka / abbrch.F
1 *
2 * $Id$
3 *
4 * $Log$
5 * Revision 1.1.1.1  1995/10/24 10:19:53  cernlib
6 * Geant
7 *
8 *
9 #include "geant321/pilot.h"
10 *CMZ :  3.21/02 29/03/94  15.41.41  by  S.Giani
11 *-- Author :
12 *$ CREATE ABBRCH.FOR
13 *COPY ABBRCH
14 *
15 *=== abbrch ===========================================================*
16 *
17       SUBROUTINE ABBRCH(IT,LL,LA,LT,E0,PGX,PGY,PGZ,KFR1,KFR2,RE,
18      *KR1R,KR2R,KR1L,KR2L,RPX,RPY,RPZ,RPXR,RPYR,RPZR,RPXL,RPYL,RPZL,
19      *RER,REL,IV,B1,B2,KFA1,KFA2,KFA3,KFA4,IOPT,IYY)
20 #include "geant321/dblprc.inc"
21 #include "geant321/dimpar.inc"
22 #include "geant321/iounit.inc"
23       DIMENSION RE(*),KFR1(*),KFR2(*),RPX(*),RPY(*),IV(*)
24       REAL RNDM(6)
25 C*****POSSIBILITY OF THE CUT OFF OF THE RIGHT AND LEFT JET
26 *      CUTBAM=0.2D+00/(2.D+00+0.5D+00*LOG(E0+2.D+00))
27       CUTBAM=0.D0
28       I=IT
29       J=IT-1
30       IVA=1
31       IF (LT.EQ.1) WRITE(LUNOUT,288)IT,LL,LA,LT,E0,PGX,PGY,PGZ,KR1R,
32      *KR2R,KR1L,KR2L,RPZ,RPXR,RPYR,RPZR,RPXL,RPYL,RPZL,RER,REL,B1,B2,
33      *KFA1,KFA2,KFA3,KFA4,IOPT,IYY
34   288 FORMAT(4I5,4E12.4,4I5/11E11.3/6I5/
35      *  ' ABBRCH ,IT,LL,LA,LT,E0,PGX,PGY,PGZ,KR1R,KR2R,
36      *KR1L,KR2L,RPZ,RPXR,RPYR,RPZR,RPXL,RPYL'/' RPZL,RER,REL,B1,B2,
37      *KFA1,KFA2,KFA3,KFA4,IOPT,IYY')
38       RM=0.764D0
39       RMK=0.891D0
40       DM=1.863D0
41       IF(LA.EQ.1)GOTO10
42 C*****CHOICE OF THE CUT OFF ENERGY
43       IF(I.GT.1)GOTO50
44       AM0=1.D0
45       KFAA=KFA1
46       IF(IOPT.EQ.2) KFAA=MAX(KFA2,KFA3)
47       IF(IOPT.EQ.5) KFAA=MAX(KFA3,KFA4)
48       IF (KFAA.GT.6)KFAA=KFAA-6
49       IF(KFAA.EQ.1.OR.KFAA.EQ.2) AM0=RM
50       IF(KFAA.EQ.3) AM0=RMK
51       IF(KFAA.EQ.4) AM0=DM
52       GOTO60
53    50 CONTINUE
54       IF(KFR1(J).EQ.1.OR.KFR1(J).EQ.2)AM0=RM
55       IF(KFR1(J).EQ.7.OR.KFR1(J).EQ.8)AM0=RM
56       IF(KFR1(J).EQ.3.OR.KFR1(J).EQ.9)AM0=RMK
57       IF(KFR1(J).EQ.4.OR.KFR1(J).EQ.10)AM0=DM
58       BM0=0.D0
59       IF(KFR2(J).EQ.3.OR.KFR2(J).EQ.9) BM0=RMK
60       IF(KFR2(J).EQ.4.OR.KFR2(J).EQ.10)BM0=DM
61       IF(AM0.LT.BM0)AM0=BM0
62    60 CONTINUE
63       CALL GRNDM(RNDM,6)
64       X=RNDM(1)
65       IF(I.EQ.1)RX=E0
66       IF(I.GT.1)RX=RE(J)
67       AM=AM0-1.D0/B1*LOG(1.D0-X)
68       IF (RNDM(2).LT.CUTBAM)AM=AM0+0.9D0*RX*RNDM(3)
69       X=RNDM(4)
70       ESA=AM0-1.D0/B2*LOG(1.D0-X)
71       IF (RNDM(5).LT.CUTBAM)ESA=AM0+0.9D0*RX*RNDM(6)
72 *  *** Now: ***
73       PSA=ABS(ESA-AM0)*(ESA+AM0)
74       EAB=SQRT(3.D0*.5D0*PSA+AM**2)
75       IF(RX.GT.EAB)GOTO30
76       IF(IYY.EQ.1.AND.I.EQ.1.AND.IOPT.NE.5) GOTO 30
77    10 CONTINUE
78       LA=1
79       IF(I.EQ.1) GO TO 40
80       IF(LL.EQ.1)GOTO20
81       KR1R=KFR1(J)
82       KR2R=KFR2(J)
83       RER=RE(J)
84       RPXR=-PGX
85       RPYR=-PGY
86       RPZR=-PGZ
87       RE(J)=E0
88       KFR1(J)=KFA2
89       KFR2(J)=0
90       IV(J)=IVA+5
91       IF(IOPT.EQ.5) KFR2(J)=KFA2
92       IF(IOPT.EQ.5) KFR1(J)=KFA1
93       IF(IOPT.EQ.5) IV(J)=7
94       RPX(J)=0.D0
95       RPY(J)=0.D0
96       IF(IOPT.NE.4.OR.KFA1.GT.6) GO TO 1111
97       IV(J)=7
98       KFR1(J)=KFA2
99       KFR2(J)=KFA3
100  1111 CONTINUE
101       PGX=0.D0
102       PGY=0.D0
103       PGZ=0.D0
104       IF(LT.EQ.0)GOTO101
105       WRITE(LUNOUT,2)KR1R,KR2R,RER,RPXR,RPYR,RPZR
106     2 FORMAT(1H0,27HQR1,QR2,RER,RPXR,RPYR,RPZR=,2I3,4F8.4)
107   101 CONTINUE
108       GO TO 30
109    20 CONTINUE
110       KR1L=KFR1(J)
111       KR2L=KFR2(J)
112       REL=RE(J)
113       RPXL=-PGX
114       RPYL=-PGY
115       RPZL=-PGZ
116       IF(IOPT.NE.4.OR.KFA1.LT.6) GO TO 4444
117       IV(J)=2
118       KFR1(J)=KFA2
119       KFR2(J)=KFA3
120       RE(J)=E0
121       RPX(J)=0.D0
122       RPY(J)=0.D0
123       PGX=0.D0
124       PGY=0.D0
125       PGZ=0.D0
126  4444 CONTINUE
127       IF(LT.EQ.0)GO TO 102
128       WRITE(LUNOUT,3)KR1L,KR2L,REL,RPXL,RPYL,RPZL
129     3 FORMAT(1H0,27HQL1,QL2,REL,RPXL,RPYL,RPZL=,2I3,4F8.4)
130   102 CONTINUE
131       GOTO30
132    40 CONTINUE
133       IF(LL.EQ.1)GO TO 70
134       KR1R=KFA1
135       KR2R=0
136       IF(IOPT.EQ.5) KR1R=KFA3
137       IF(IOPT.EQ.5) KR2R=KFA4
138       RER=E0
139       RPXR=0.D0
140       RPYR=0.D0
141       RPZR=0.D0
142       PGX=0.D0
143       PGY=0.D0
144       PGZ=0.D0
145       IF (IOPT.EQ.2)  KR1R=KFA1
146       IF (IOPT.EQ.2)KR2R=KFA2
147       IF(IOPT.NE.4.OR.KFA1.LE.6) GO TO 3333
148  3331 CONTINUE
149       KR1R=KFA2
150       KR2R=KFA3
151  3333 CONTINUE
152       IF(LT.EQ.0)GO TO 103
153       WRITE(LUNOUT,2)KR1R,KR2R,RER,RPXR,RPYR,RPZR
154   103 CONTINUE
155       GO TO 30
156    70 CONTINUE
157       KR1L=KFA2
158       KR2L=0
159       IF(IOPT.EQ.5) KR1L=KFA1
160       IF(IOPT.EQ.5) KR2L=KFA2
161       REL=E0
162       RPXL=0.D0
163       RPYL=0.D0
164       RPZL=0.D0
165       IF(IOPT.EQ.2) KR1L=KFA1
166       IF(IOPT.EQ.2)KR2L=KFA2
167       IF(IOPT.NE.4.OR.KFA1.GT.6) GO TO 2222
168  2221 CONTINUE
169       KR1L=KFA2
170       KR2L=KFA3
171  2222 CONTINUE
172       IF(LT.EQ.0)GO TO 104
173       WRITE(LUNOUT,3)KR1L,KR2L,REL,RPXL,RPYL,RPZL
174   104 CONTINUE
175       GO TO 30
176    30 CONTINUE
177       IF(LT.EQ.0)GO TO 100
178       WRITE(LUNOUT,1)I,LL,LA,AM0,AM,PSA,EAB,RX
179     1 FORMAT(1H0,26HI,LL,LA,AM0,AM,APS,EAB,RX=,3I3,5F8.4)
180   100 CONTINUE
181       RETURN
182       END