Bugfix in AliPoints2Memory
[u/mrichter/AliRoot.git] / GEANT321 / gheisha / kmabs.F
CommitLineData
fe4da5cc 1*
2* $Id$
3*
4* $Log$
5* Revision 1.1.1.1 1995/10/24 10:20:58 cernlib
6* Geant
7*
8*
9#include "geant321/pilot.h"
10*CMZ : 3.21/02 29/03/94 15.41.38 by S.Giani
11*-- Author :
12 SUBROUTINE KMABS(NOPT)
13C
14C *** CHARGED KAON ABSORPTION BY A NUCLEUS ***
15C *** NVE 04-MAR-1988 CERN GENEVA ***
16C
17C ORIGIN : H.FESEFELDT (09-JULY-1987)
18C
19C PRODUCTION OF A HYPERFRAGMENT WITH SUBSEQUENT DECAY
20C PANOFSKY RATIO (K- P --> LAMBDA PI0/K- P --> LAMBDA GAMMA) = 3/2
21C
22#include "geant321/s_defcom.inc"
23 DIMENSION RNDM(4)
24C
25 CALL COMPO
26 PV(1,1)=0.
27 PV(2,1)=0.
28 PV(3,1)=0.
29 PV(4,1)=RMASS(13)
30 PV(5,1)=RMASS(13)
31 PV(6,1)=-1.
32 PV(7,1)=TOF
33 PV(8,1)=IPART
34 PV(9,1)=0.
35 PV(10,1)=USERW
36 IER(84)=IER(84)+1
37 IF(ATNO2.GT.1.5) GOTO 30
38 CALL GRNDM(RNDM,4)
39 RAN=RNDM(1)
40 TOF1=-12.5*LOG(RAN)
41 TOF1= 20.*TOF1
42 RAN=RNDM(2)
43 ISW=1
44 IF(RAN.LT.0.33) ISW=2
45 NOPT=ISW
46 PV(1,3)=0.
47 PV(2,3)=0.
48 PV(3,3)=0.
49 PV(4,3)=RMASS(18)
50 PV(5,3)=RMASS(18)
51 PV(6,3)=0.
52 PV(7,3)=TOF+TOF1
53 PV(8,3)=18.
54 PV(9,3)=0.
55 PV(10,3)=0.
56 PCM=RMASS(13)+RMASS(14)-RMASS(18)
57 COST=-1.+RNDM(3)*2.
58 SINT=SQRT(ABS(1.-COST*COST))
59 PHI=RNDM(4)*TWPI
60 IF(ISW.EQ.1) GOTO 1
61 PV(1,2)=PCM*COST*SIN(PHI)
62 PV(2,2)=PCM*COST*COS(PHI)
63 PV(3,2)=PCM*SINT
64 PV(4,2)=PCM
65 PV(5,2)=0.
66 PV(6,2)=0.
67 PV(7,2)=TOF+TOF1
68 PV(8,2)=1.
69 PV(9,2)=0.
70 PV(10,2)=0.
71 GOTO 2
72 1 PCM=PCM*PCM-RMASS(8)*RMASS(8)
73 IF(PCM.LE.0.) PCM=0.
74 PCM=SQRT(PCM)
75 PV(1,2)=PCM*COST*SIN(PHI)
76 PV(2,2)=PCM*COST*COS(PHI)
77 PV(3,2)=PCM*SINT
78 PV(4,2)=SQRT(PCM*PCM+RMASS(8)*RMASS(8))
79 PV(5,2)=RMASS(8)
80 PV(6,2)=0.
81 PV(7,2)=TOF+TOF1
82 PV(8,2)=8.
83 PV(9,2)=0.
84 PV(10,2)=0.
85 2 INTCT=INTCT+1.
86 CALL SETCUR(2)
87 NTK=NTK+1
88 CALL SETTRK(3)
89 IF(NPRT(3))
90 *WRITE(NEWBCD,1002) XEND,YEND,ZEND,P,ISW
911002 FORMAT(1H0,'KAON ABSORBTION POSITION',3(2X,F8.2),2X,
92 * 'K MOMENTUM',2X,F8.4,2X,'INT CODE',2X,I2)
93 GO TO 9999
94C**
95C** STAR PRODUCTION FOR PION ABSORPTION IN HEAVY ELEMENTS
96C**
97 30 ENP(1)=0.300
98 ENP(3)=0.150
99 NT=1
100 TEX=ENP(1)
101 BLACK=0.5*LOG(ATNO2)
102 CALL POISSO(BLACK,NBL)
103 IF(NPRT(3))
104 *WRITE(NEWBCD,3003) NBL,TEX
105 IF(NT+NBL.GT.MXGKPV-2) NBL=MXGKPV-2-NT
106 IF(NBL.LE.0) NBL=1
107 EKIN=TEX/NBL
108 EKIN2=0.
109 DO 31 I=1,NBL
110 IF(NT.EQ.MXGKPV-2) GOTO 31
111 CALL GRNDM(RNDM,4)
112 RAN2=RNDM(1)
113 EKIN1=-EKIN*LOG(RAN2)
114 EKIN2=EKIN2+EKIN1
115 IPA1=16
116 PNRAT=1.-ZNO2/ATNO2
117 IF(RNDM(2).GT.PNRAT) IPA1=14
118 NT=NT+1
119 COST=-1.+RNDM(3)*2.
120 SINT=SQRT(ABS(1.-COST*COST))
121 PHI=TWPI*RNDM(4)
122 IPA(NT)=-IPA1
123 PV(5,NT)=ABS(RMASS(IPA1))
124 PV(6,NT)=RCHARG(IPA1)
125 PV(7,NT)=2.
126 PV(4,NT)=EKIN1+PV(5,NT)
127 PP=SQRT(ABS(PV(4,NT)**2-PV(5,NT)**2))
128 PV(1,NT)=PP*SINT*SIN(PHI)
129 PV(2,NT)=PP*SINT*COS(PHI)
130 PV(3,NT)=PP*COST
131 IF(EKIN2.GT.TEX) GOTO 33
132 31 CONTINUE
133 33 TEX=ENP(3)
134 BLACK=0.50*LOG(ATNO2)
135 CALL POISSO(BLACK,NBL)
136 IF(NT+NBL.GT.MXGKPV-2) NBL=MXGKPV-2-NT
137 IF(NBL.LE.0) NBL=1
138 EKIN=TEX/NBL
139 EKIN2=0.
140 IF(NPRT(3))
141 *WRITE(NEWBCD,3004) NBL,TEX
142 DO 32 I=1,NBL
143 IF(NT.EQ.MXGKPV-2) GOTO 32
144 CALL GRNDM(RNDM,4)
145 RAN2=RNDM(1)
146 EKIN1=-EKIN*LOG(RAN2)
147 EKIN2=EKIN2+EKIN1
148 NT=NT+1
149 COST=-1.+RNDM(2)*2.
150 SINT=SQRT(ABS(1.-COST*COST))
151 PHI=TWPI*RNDM(3)
152 RAN=RNDM(4)
153 IPA(NT)=-30
154 IF(RAN.GT.0.60) IPA(NT)=-31
155 IF(RAN.GT.0.90) IPA(NT)=-32
156 PV(5,NT)=(ABS(IPA(NT))-28)*RMASS(14)
157 PV(6,NT)=1.
158 IF(IPA(NT).EQ.-32) PV(6,NT)=2.
159 PV(7,NT)=2.
160 PV(4,NT)=PV(5,NT)+EKIN1
161 PP=SQRT(ABS(PV(4,NT)**2-PV(5,NT)**2))
162 PV(1,NT)=PP*SINT*SIN(PHI)
163 PV(2,NT)=PP*SINT*COS(PHI)
164 PV(3,NT)=PP*COST
165 IF(EKIN2.GT.TEX) GOTO 40
166 32 CONTINUE
167C**
168C** STORE ON EVENT COMMON
169C**
170 40 CALL GRNDM(RNDM,1)
171 RAN=RNDM(1)
172 TOF1=-12.5*LOG(RAN)
173 TOF1=20.*TOF1
174 DO 41 I=2,NT
175 IF(PV(7,I).LT.0.) PV(5,I)=-PV(5,I)
176 PV(7,I)=TOF+TOF1
177 PV(8,I)=ABS(IPA(I))
178 PV(9,I)=0.
179 41 PV(10,I)=0.
180 INTCT=INTCT+1.
181 CALL SETCUR(2)
182 NTK=NTK+1
183 IF(NT.EQ.2) GO TO 9999
184 DO 50 I=3,NT
185 IF(NTOT.LT.NSIZE/12) GOTO 43
186 GO TO 9999
187 43 CALL SETTRK(I)
188 50 CONTINUE
189C
190 3003 FORMAT(1H ,I3,' BLACK TRACK PARTICLES PRODUCED WITH TOTAL KINETIC
191 * ENERGY OF ',F8.3,' GEV')
192 3004 FORMAT(1H ,I5,' HEAVY FRAGMENTS WITH TOTAL ENERGY OF',F8.4,' GEV')
193C
194 9999 CONTINUE
195 END