COSMOS v7.655  COSMOSv7655
(AirShowerMC)
testkl3.f
Go to the documentation of this file.
1 ! kl3 temporary level=2 date=88.07.27
2 ! k--->pi+mu+neu or pi+e+neu decay, sampling talbe making
3 ! and distribution function.
4 !
5  real*4 kl3, kl3min, kl3max
6  external kl3
7 !@@@@@@@@@@@@@@@@@@@
8  parameter(nnn=1001)
9  dimension fa(nnn), ua(nnn), fax(101)
10  character ttl*70, capx*16,capy*16
11  open(13, file='c2s5001.#gd.data',status='shr',
12  * action='write')
13 !@@@@@@@@@@@@@@@@@@@
14  open(07, file='c2s5001.#h.fort(fbmu)',status='shr',
15  * action='write')
16  fmin=kl3min(f)
17  fm.p(1)=kl3max(f)
18  epsa=1.e-5
19  epsr=1.e-5
20  nmin=20
21  nmax=641
22  call aqe(fmin, fm.p(1), kl3, epsa, epsr, nmin, nmax,
23  * snorm, err, nn, icon)
24  if(icon .ne. 0) then
25  write(*,*) ' icon=',icon
26  endif
27  write(*,*) ' norm=',snorm
28 !
29 !@@@@@@@@@@@@@@@@@@@
30  ttl='energy distribution of mu for kc--->pi0,mu,neu;gzai=-.35'
31  write(13) ttl
32  capx='f=e/mk'
33  capy='prob'
34  write(13) capx, capy
35  do f=fmin, fm.p(1), .01
36  y=kl3(f)
37  write(13) f, y/snorm
38  enddo
39  write(13) 1.e50, 1.e50
40 !
41 !@@@@@@@@@@@@@@@@@@@
42  ttl='samplign function for e of mu for kc--->pi0,mu,neu'
43  write(13) ttl
44  capx='u'
45  capy='f<'
46  write(13) capx, capy
47  write(13) 0., fmin
48  i=1
49  fa(1)=fmin
50  ua(1)=0.
51 !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
52  do f=fmin+.001,fm.p(1), .001
53  call aqe(fmin, f, kl3, epsa, epsr, nmin, nmax,
54  * s, err, nn, icon)
55  if(icon .ne. 0) then
56  write(*,*) ' icon=',icon
57  endif
58  write(13) s/snorm, f
59 ! write(*,*) ' u=',s/snorm, ' f=',f
60  i=i+1
61  fa(i)=f
62  ua(i)=s/snorm
63  enddo
64  write(13) 1., fm.p(1)
65  fa(nnn)=fm.p(1)
66  ua(nnn)=1.
67  write(13) 1.e50, 1.e50
68  ttl='by interpolation'
69  write(13) ttl
70  write(13) capx, capy
71  write(13) 0.,fmin
72  fax(1)=fmin
73  u=0.01
74  do i=2, 100
75  call kfrge(ua, 1, nnn, u, l,icon)
76  f=(fa(l)-fa(l-1))/(ua(l)-ua(l-1)) * (u-ua(l-1))
77  * + fa(l-1)
78  fax(i)=f
79  write(13) u, f
80  u=u+.01
81  enddo
82  fax(101)=fm.p(1)
83  write(13) 1., fm.p(1)
84  write(13) 1.e50, 1.e50
85  call mkdt('fb ', fax, 1, 101, 'f7.4, ', 7, 1)
86  end
87  real function kl3(f)
88 ! see n.p 22(1961)553-578
89 ! ****************************************************************
90 ! put ml=object lepton mass (neu or mu)
91 ! mlp=other lepton mass
92 ! ****************************************************************
93  real*4 mk, ml, mlp, mmu, me, mpimk
94 !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
95  parameter( mk=493.667, mmu=105.66, me=.511,
96  * mpi=134.96, ml=mmu, alfa=ml/mk,
97  * mpimk=mpi/mk, mlp=0, gz=-.35, a2=alfa**2)
98 !
99  t= mpimk**2/ ( 1.-2*f+ a2)
100  kl3= sqrt(f**2-a2)*(1.-t)**2 *( 4* f *(1.-2*f)
101  * + 5*a2*f-a2**2 +gz*a2*(4.-6*f+2*a2)+
102  * gz**2 * a2 * (f-a2) )
103  return
104  entry kl3min(f)
105  kl3=alfa
106  return
107  entry kl3max(f)
108  kl3=(1.+a2-mpimk**2)/2
109  end
parameter
integer npitbl real *nx parameter(n=101, npitbl=46, nx=n-1) real *8 uconst
kfrge
subroutine kfrge(x, intvx, n, c, m, icon)
Definition: kfrge.f:33
e
dE dx *! Nuc Int sampling table e
Definition: cblkMuInt.h:130
i
nodes i
Definition: cstdatmos0.fNew2.h:93
kl3
real function kl3(f)
Definition: testkl3.f:88
p
********************block data cblkHeavy ********************integer j data *HeavyG2symbol p
Definition: cblkHeavy.h:7
y
latitude latitude this system is used *****************************************************************! type coord sequence union map real y
Definition: Zcoord.h:25
nnn
int nnn
Definition: Zprivate.h:15
t
nodes t
Definition: cstdatmos0.fNew2.h:84
f
dE dx *! Nuc Int sampling table f
Definition: cblkMuInt.h:130