COSMOS v7.655  COSMOSv7655
(AirShowerMC)
cpimuPolari.f File Reference

Go to the source code of this file.

Functions/Subroutines

subroutine cpimupolari (pion, muon, polari)
 
subroutine ckmupolari (kaon, muon, polari)
 
subroutine csampneuekl3 (f)
 
subroutine csampmuekl3 (f)
 
subroutine cmupolatlabk (jpa, muon, kaon, p)
 

Function/Subroutine Documentation

◆ ckmupolari()

subroutine ckmupolari ( type(ptcl kaon,
type(ptcl muon,
real*8  polari 
)

Definition at line 58 of file cpimuPolari.f.

References d0, maskc, masmu, and parameter().

Referenced by ckmudecay().

58 ! k----->mu+nuew decay. polarization of mu at lab.
59 !
60 ! kaon: /ptcl/. input. charge and energy is used.
61 ! muon: /ptcl/. input. enegy is used.
62 ! polari: real*8. output. muon polarizaiton.
63  implicit none
64 !---- include '../../../Zptcl.h'
65 #include "Zptcl.h"
66 !---- include '../../../Zmass.h'
67 #include "Zmass.h"
68  type(ptcl):: kaon, muon
69  real*8 polari
70 
71  real*8 masmu2, est, pst
72 
73  parameter(masmu2=masmu**2, est=(maskc**2+ masmu2)/2/maskc,
74  * pst=(maskc**2-masmu2)/2/maskc)
75 !
76  real*8 g, pmu
77 !
78  g = kaon%fm%p(4)/maskc
79  pmu=sqrt(muon%fm%p(4)**2- masmu2)
80  polari = (muon%fm%p(4)*est - g * masmu2)/pmu/pst
81  if(kaon%charge .gt. 0) then
82  polari = -polari
83  endif
84  if(abs(polari) .gt. 1.) then
85  polari = sign(1.d0, polari)
86  endif
integer npitbl real *nx parameter(n=101, npitbl=46, nx=n-1) real *8 uconst
masmu
Definition: Zmass.h:5
maskc
Definition: Zmass.h:5
block data cblkEvhnp ! currently usable models data RegMdls ad *special data *Cekaon d0
Definition: cblkEvhnp.h:5
dE dx *! Nuc Int sampling table g
Definition: cblkMuInt.h:130
Definition: Zptcl.h:75
Here is the call graph for this function:
Here is the caller graph for this function:

◆ cmupolatlabk()

subroutine cmupolatlabk ( integer  jpa,
type(ptcl muon,
type(ptcl kaon,
real*8  p 
)

Definition at line 200 of file cpimuPolari.f.

References d0, kintp3(), and maskc.

Referenced by ckmuneupidcy().

200  implicit none
201 !---- include '../../../Zmass.h'
202 #include "Zmass.h"
203 !---- include '../../../Zptcl.h'
204 #include "Zptcl.h"
205  type(ptcl):: muon, kaon
206  integer jpa
207  real*8 p
208 ! jpa: intege. input. -1 for k- k0 bar
209 ! 1 for k+ k0
210 ! muon: /ptcl/ input. muon energy in lab is used
211 ! kaon: /ptcl/ input. kaon energy in lab is used.
212 ! p: real*8. output. longitudianl polarization of muon
213 ! k0==> mu+ neu + pi-
214 ! k+==> mu+ neu + pi0
215 ! k0bar==>mu-+neu+pi+
216 ! k-==>mu- + neu+pi0
217 ! gzai=-.35 is assumed.
218  real*8 pa( 7), pb(18)
219  real*8 x
220 ! table is for k0 or k+ see n.p vol22 p553
221 ! pa: p of lab for 40*muon.e/ek*mk=0.8 to 2.0 step .2
222  data pa/-.74,-.74, -.735, -.72, -.70, -.64, -.61/
223 ! pb: same for 2.0 to 18 step 1
224  data pb/-.61, -.40, -.22, -.08, 0.03, .12, .19, .263,.31,
225  * .365,.435, .48,.54, .58, .63, .675,.72,.78/
226 !
227 
228 
229  x=muon%fm%p(4)/kaon%fm%p(4)*40.*maskc
230  if(x .gt. 19.) then
231 ! very high energy same as cms
232  call cmupolatk(jpa, p)
233  elseif(x .lt. .8) then
234 ! very low energy same as cms with oppsit sign
235  call cmupolatk(jpa, p)
236  p=-p
237  elseif(x .lt. 2.) then
238  call kintp3(pa, 1, 7, 0.8d0, .2d0, x, p)
239  else
240  call kintp3(pb, 1, 18, 2.d0, 1.d0, x, p)
241  endif
242  if(jpa .lt. 0) then
243  p=-p
244  endif
********************block data cblkHeavy ********************integer j data *HeavyG2symbol p
Definition: cblkHeavy.h:7
maskc
Definition: Zmass.h:5
block data cblkEvhnp ! currently usable models data RegMdls ad *special data *Cekaon d0
Definition: cblkEvhnp.h:5
subroutine kintp3(f, intv, n, x1, h, x, ans)
Definition: kintp3.f:19
Definition: Zptcl.h:75
! structure defining a particle at production ! Basic idea of what is to be contained in ! the particle structue is that dynamical ones should be included those derivable from the particle code ! is not included ******************************************************type fmom momentum sequence union map real e endmap map real * x
Definition: Zptcl.h:21
Here is the call graph for this function:
Here is the caller graph for this function:

◆ cpimupolari()

subroutine cpimupolari ( type(ptcl pion,
type(ptcl muon,
real*8  polari 
)

Definition at line 2 of file cpimuPolari.f.

References d0, masmu, maspic, and parameter().

Referenced by cpimudecay().

2 ! pion: /ptcl/. input. one pion data. charge and energy are used.
3 ! muon: /ptcl/. input. muon from the pion. energy is used.
4 ! polari: real*8. output. polarization of muon in lab frame along
5 ! its momentum.
6 !
7 ! polarization of mu at lab is obtained for pi--->mu decay.
8 ! *** note ***
9 ! For mu-, polari is mostly positive hence decay eletron
10 ! goes opposit side of mu and neutrino goes same
11 ! side (use csampNeueEMu and
12 ! (1+P cos)dcos for neue;
13 ! csNeumuEMu and
14 ! (1+ XPcos)dcos for neumu;
15 ! X=(1-2f)/(3-2f)
16 ! for energy and angle sampling, use porali as it is)
17 ! For mu+, polari is mostly negative but positron goes
18 ! the opposit side of mu and hence
19 ! neutrinos goes like mu- case so that use csampNeumuCos etc
20 ! by reversing the sign of polarization).
21 
22  implicit none
23 !---- include '../../../Zptcl.h'
24 #include "Zptcl.h"
25 !---- include '../../../Zmass.h'
26 #include "Zmass.h"
27  type(ptcl):: pion
28  type(ptcl):: muon
29  real*8 polari
30 !
31  real*8 masmu2, est, pst
32  parameter(masmu2 = masmu**2, est=(maspic**2+ masmu2)/2/maspic,
33  * pst=(maspic**2-masmu2)/2/maspic)
34 !
35  real*8 g, pmu
36 
37  g=pion%fm%p(4)/maspic
38  pmu = muon%fm%p(4)**2- masmu2
39  if(pmu .lt. 0.) then
40 !//////////////////
41 ! some of stopping pi result in pmu< 0 (Ppi
42 ! write(0,*) ' pmu =',pmu, muon.fm.p(4), muon.mass
43 ! call checkstat("in cpimuPolari")
44 !///////////////
45  pmu =0.
46  endif
47 
48  pmu=sqrt(pmu)
49  polari=(muon%fm%p(4) * est - g * masmu2)/pmu/pst
50  if(muon%charge .gt. 0) then
51  polari = -polari
52  endif
53  if(abs(polari) .gt. 1.) then
54  polari = sign(1.d0, polari)
55  endif
integer npitbl real *nx parameter(n=101, npitbl=46, nx=n-1) real *8 uconst
masmu
Definition: Zmass.h:5
block data cblkEvhnp ! currently usable models data RegMdls ad *special data *Cekaon d0
Definition: cblkEvhnp.h:5
dE dx *! Nuc Int sampling table g
Definition: cblkMuInt.h:130
Definition: Zptcl.h:75
maspic
Definition: Zmass.h:5
Here is the call graph for this function:
Here is the caller graph for this function:

◆ csampmuekl3()

subroutine csampmuekl3 ( real *8  f)

Definition at line 137 of file cpimuPolari.f.

References maskc, masmu, parameter(), and rndc().

Referenced by ckmuneupidcy().

137  implicit none
138 !---- include '../../../Zmass.h'
139 #include "Zmass.h"
140  real *8 f, p
141 ! muon energy sampling table
142  integer jpa, i
143  real*8 alfa, a2, gz, gzs, gz2, u, ff
144  integer l
145  real*8 tmp, pp
146  save ff
147 
148  parameter(alfa=masmu/maskc,
149  * a2=alfa**2,
150  * gz=-.35, gzs=gz**2, gz2=2.*gz)
151 
152 !
153  real*8 fb(101)
154  data (fb(i),i= 1, 72)/
155  1 0.2140, 0.2232, 0.2285, 0.2329, 0.2368, 0.2404, 0.2438, 0.2470,
156  2 0.2500, 0.2529, 0.2557, 0.2584, 0.2610, 0.2635, 0.2660, 0.2684,
157  3 0.2708, 0.2731, 0.2754, 0.2777, 0.2799, 0.2820, 0.2842, 0.2863,
158  4 0.2884, 0.2905, 0.2925, 0.2945, 0.2965, 0.2985, 0.3005, 0.3024,
159  5 0.3044, 0.3063, 0.3082, 0.3101, 0.3120, 0.3139, 0.3157, 0.3176,
160  6 0.3195, 0.3213, 0.3232, 0.3250, 0.3268, 0.3287, 0.3305, 0.3323,
161  7 0.3341, 0.3359, 0.3378, 0.3396, 0.3414, 0.3432, 0.3451, 0.3469,
162  8 0.3487, 0.3505, 0.3524, 0.3542, 0.3561, 0.3579, 0.3598, 0.3617,
163  9 0.3635, 0.3654, 0.3673, 0.3692, 0.3712, 0.3731, 0.3751, 0.3770/
164  data (fb(i),i= 73, 101)/
165  1 0.3790, 0.3810, 0.3831, 0.3851, 0.3872, 0.3893, 0.3915, 0.3936,
166  2 0.3959, 0.3981, 0.4004, 0.4027, 0.4051, 0.4076, 0.4101, 0.4127,
167  3 0.4154, 0.4182, 0.4211, 0.4241, 0.4273, 0.4306, 0.4342, 0.4381,
168  4 0.4425, 0.4474, 0.4533, 0.4611, 0.4861/
169 
170  call rndc(u)
171  l=u*100.+1
172  f = (fb(l+1)-fb(l))*100.*(u-(l-1)/100.) + fb(l)
173  ff = f
174  return
175 ! **************************
176  entry cmupolatk(jpa, p)
177 ! **************************
178 ! this must be called after csampMuEKl3
179 ! jpa: -1 for k- and k0
180 ! +1 for k+ and k0bar
181 ! p: real*8. output
182 ! this is for k at rest; and for k- and k0
183 !
184  tmp=ff**2-a2
185  if(tmp .le. 0.) then
186  pp=0.
187  else
188  pp=sqrt(tmp)* ( -4*(1.-2*ff)+ (gzs+gz2-3)*a2) /
189  * (4*ff*(1.-2*ff) + a2* (5*ff-a2+ gz*(4-6.*ff+2*a2) +
190  * gzs*(ff-a2) ) )
191  endif
192  if(jpa .lt. 0) then
193  p=pp
194  else
195  p=-pp
196  endif
integer npitbl real *nx parameter(n=101, npitbl=46, nx=n-1) real *8 uconst
nodes i
subroutine rndc(u)
Definition: rnd.f:91
masmu
Definition: Zmass.h:5
********************block data cblkHeavy ********************integer j data *HeavyG2symbol p
Definition: cblkHeavy.h:7
maskc
Definition: Zmass.h:5
dE dx *! Nuc Int sampling table f
Definition: cblkMuInt.h:130
Here is the call graph for this function:
Here is the caller graph for this function:

◆ csampneuekl3()

subroutine csampneuekl3 ( real*8  f)

Definition at line 98 of file cpimuPolari.f.

References e, maskc, maspic, parameter(), and rndc().

Referenced by ckmuneupidcy(), and ckpieneudecay().

98  implicit none
99 !---- include '../../../Zmass.h'
100 #include "Zmass.h"
101 
102  integer i
103  real*8 f
104  real*8 mpmk2, snorm, f1, u
105  integer l
106  parameter( snorm=2.43e-2,
107  * mpmk2=(maspic/maskc)**2,
108  * f1=1.7678*snorm/(1.-mpmk2) )
109 
110 ! f=e/mk (=0 to (1-(mass_pi/mass_k)**2))/2)
111 ! neutrino energy sampling table
112  real*8 fn(101)
113  data (fn(i),i= 1, 72)/
114  1 0.0000, 0.0618, 0.0789, 0.0911, 0.1010, 0.1094, 0.1168, 0.1236,
115  2 0.1300, 0.1356, 0.1412, 0.1462, 0.1512, 0.1558, 0.1603, 0.1645,
116  3 0.1688, 0.1727, 0.1766, 0.1805, 0.1841, 0.1877, 0.1912, 0.1946,
117  4 0.1980, 0.2013, 0.2045, 0.2077, 0.2109, 0.2139, 0.2170, 0.2200,
118  5 0.2229, 0.2258, 0.2288, 0.2316, 0.2344, 0.2372, 0.2400, 0.2427,
119  6 0.2454, 0.2482, 0.2508, 0.2535, 0.2561, 0.2588, 0.2614, 0.2640,
120  7 0.2666, 0.2692, 0.2717, 0.2743, 0.2768, 0.2794, 0.2819, 0.2845,
121  8 0.2870, 0.2895, 0.2921, 0.2946, 0.2971, 0.2997, 0.3022, 0.3048,
122  9 0.3073, 0.3099, 0.3124, 0.3150, 0.3176, 0.3202, 0.3228, 0.3255/
123  data (fn(i),i= 73, 101)/
124  1 0.3281, 0.3308, 0.3335, 0.3362, 0.3389, 0.3417, 0.3446, 0.3474,
125  2 0.3503, 0.3533, 0.3562, 0.3592, 0.3624, 0.3656, 0.3688, 0.3721,
126  3 0.3756, 0.3791, 0.3829, 0.3867, 0.3907, 0.3951, 0.3995, 0.4046,
127  4 0.4098, 0.4162, 0.4236, 0.4335, 0.4632/
128  call rndc(u)
129  if(u .lt. .007) then
130  f= (u*f1)**.4
131  else
132  l=u*100.+1
133  f=(fn(l+1)-fn(l))*100.*(u-(l-1)/100.) + fn(l)
134  endif
integer npitbl real *nx parameter(n=101, npitbl=46, nx=n-1) real *8 uconst
dE dx *! Nuc Int sampling table e
Definition: cblkMuInt.h:130
nodes i
subroutine rndc(u)
Definition: rnd.f:91
maskc
Definition: Zmass.h:5
maspic
Definition: Zmass.h:5
dE dx *! Nuc Int sampling table f
Definition: cblkMuInt.h:130
Here is the call graph for this function:
Here is the caller graph for this function: