COSMOS v7.655  COSMOSv7655
(AirShowerMC)
Functions/Subroutines
cGetXXsec.f File Reference

Go to the source code of this file.

Functions/Subroutines

subroutine cgetxxsec (Ex, xcomtab, n, m1, m2, xsec, icon)
 
subroutine cxrayp (Exin, m1, m2, p, path)
 

Function/Subroutine Documentation

◆ cgetxxsec()

subroutine cgetxxsec ( real*4  Ex,
real*4, dimension(8, n)  xcomtab,
integer  n,
integer  m1,
integer  m2,
real*4, dimension(8)  xsec,
integer  icon 
)

Definition at line 2 of file cGetXXsec.f.

References kwhereis().

Referenced by cxrayp().

2  implicit none
3 ! give X-ray xsection; 1) coherent scatt
4 ! 2) incoherent (compton) scatt.
5 ! 3) photo-absorption,
6 ! 4) pair prod.by nucl
7 ! 5) pair prod. by atomic elec.
8 ! 6) attn coef. with coh.
9 ! 7) attn coef. without coh.
10  real*4 ex ! input. X-ray energy in GeV. 1keV to 100GeV. if < 1 keV, extrapolation
11  ! will be done
12  integer n ! input. row size of xcomtab. the column is 8
13  real*4 xcomtab(8, n) ! input. x-section table obtained by using
14  ! CreateTab and stored as bgo.xcom etc.
15  ! for Cosmos, the table may be stored as data.
16  ! values are in log. (original 0 --> -100) of the
17  ! following values
18  ! (1,n)=E(GeV), (2,n)=coh. (3,n)=incoh. (4,n)=p.e.
19  ! (5,n)=n.pair (6,n)=e.pair, (7,n)=atten(with coh)
20  ! (8,n)=atten.(without coh)
21  integer m1 ! input. m1-th xsection; see below
22  !
23  integer m2 ! input m1 to m2-th xsections are obtained
24  ! xsectioon is in unit of 1/(g/cm2).
25  real*4 xsec(8) ! output. at least size m. xsec(k) is k-th xsection.
26  integer icon ! output. 0--> ok. 1-->Ex<1keV. extrapolation not guaranteed
27  ! 2--> Ex>100 GeV. values at 100 GeV is given
28  real*4 exl
29  real*4 dx, grad
30  integer i, loc
31 
32  exl = log(ex)
33  if( exl .lt. xcomtab(1, 1) ) then
34  do i = m1, m2
35  xsec(i) = xcomtab(i+1, 1)
36  enddo
37  loc = 1
38  elseif(exl .gt. xcomtab(1,n) ) then
39  do i = m1, m2
40  xsec(i) = xcomtab(i+1, n)
41  enddo
42  loc = n
43  else
44 ! find i(=loc) such that Ei <= Eg < Ei+1 ( i=1, 2, ...n-1)
45  call kwhereis(exl, n, xcomtab, 8, loc)
46 ! if Ex=100, loc = n
47  if( loc .lt. n ) then
48  if( xcomtab(1, loc) .eq. xcomtab(1, loc+1) ) then
49  loc = loc + 1
50  endif
51  endif
52  endif
53  if(loc .lt. n) then
54  dx = xcomtab(1, loc+1)- xcomtab(1, loc)
55  if(dx .eq. 0.) then
56  do i = m1, m2
57  xsec(i) = xcomtab(i+1, loc)
58  enddo
59  else
60  do i = m1, m2
61  grad =(xcomtab(i+1, loc+1)-xcomtab(i+1, loc))/dx
62  if(i .eq. 4 .or. i .eq. 5) then
63  if(xcomtab(i+1, loc+1) .eq. -100.) then
64  xsec(i)= -100.
65  else
66  xsec(i) = grad* (exl- xcomtab(1, loc))
67  * + xcomtab(i+1, loc)
68  endif
69  else
70  xsec(i) = grad * (exl- xcomtab(1, loc))
71  * + xcomtab(i+1, loc)
72  endif
73  enddo
74  endif
75  else
76  do i = m1, m2
77  xsec(i) = xcomtab(i+1, n)
78  enddo
79  endif
80  do i = m1, m2
81  if(xsec(i) .eq. -100) then
82  xsec(i) = 0.
83  else
84  xsec(i) = exp(xsec(i))
85  endif
86  enddo
i
nodes i
Definition: cstdatmos0.fNew2.h:93
dx
integer npitbl real *nx dx real dx
Definition: Zcinippxc.h:10
kwhereis
subroutine kwhereis(x, in, a, step, loc)
Definition: kdwhereis.f:63
n
integer n
Definition: Zcinippxc.h:1
Here is the call graph for this function:
Here is the caller graph for this function:

◆ cxrayp()

subroutine cxrayp ( real*8  Exin,
integer  m1,
integer  m2,
real*8, dimension(m2)  p,
real*8, dimension(m2)  path 
)

Definition at line 89 of file cGetXXsec.f.

References cgetxxsec(), and rndc().

Referenced by csampgintl().

89  implicit none
90 #include "Zelemagp.h"
91 ! similar to Epics's epXrayp but for Air
92  real*8 exin ! input. X/Gamma energy in GeV (mostly keV to MeV). <100.
93 
94 ! m
95  integer m1, m2 ! input. 1~5. 1 --> coh. scatt.
96  ! 2 --> + incoh. scatt.
97  ! 3 --> + p.e
98  ! 4 --> + pair cre. by nuc.
99  ! 5 --> + pari cre. by elec.
100  ! are specified
101  real*8 p(m2) ! output. probability ( number of
102  ! occurence ) of m-th process per r.l
103  real*8 path(m2) ! output. sampled path in r%l for m-th proc
104 !
105  real*4 airxcom(8,82)
106  integer i, j
107  data (( airxcom(i,j), i=1,8), j=1,82)/
108  * -13.8155,0.3104,-4.5688,8.1901,-100.0,-100.0,8.1904,8.1901,
109  * -13.4100,0.2215,-3.8561,7.0817,-100.0,-100.0,7.0825,7.0817,
110  * -13.1224,0.1106,-3.3998,6.2670,-100.0,-100.0,6.2693,6.2672,
111  * -12.7169,-0.1453,-2.8567,5.0851,-100.0,-100.0,5.0907,5.0857,
112  * -12.6514,-0.1991,-2.7818,4.8911,-100.0,-100.0,4.8978,4.8919,
113  * -12.6514,-0.1991,-2.7818,5.0026,-100.0,-100.0,5.0080,5.0026,
114  * -12.4292,-0.4066,-2.5553,4.3545,-100.0,-100.0,4.3640,4.3554,
115  * -12.2061,-0.6486,-2.3721,3.6901,-100.0,-100.0,3.7052,3.6924,
116  * -12.0238,-0.8637,-2.2528,3.1407,-100.0,-100.0,3.1634,3.1454,
117  * -11.7361,-1.2198,-2.1103,2.2630,-100.0,-100.0,2.3056,2.2755,
118  * -11.5129,-1.5010,-2.0280,1.5738,-100.0,-100.0,1.6446,1.6006,
119  * -11.1075,-2.0272,-1.9166,0.3023,-100.0,-100.0,0.4898,0.4055,
120  * -10.8198,-2.4334,-1.8605,-0.6114,-100.0,-100.0,-0.2408,-0.3592,
121  * -10.4143,-3.0724,-1.8171,-1.9146,-100.0,-100.0,-1.0323,-1.1715,
122  * -10.1266,-3.5631,-1.8134,-2.8475,-100.0,-100.0,-1.3883,-1.5091,
123  * -9.9035,-3.9575,-1.8245,-3.5748,-100.0,-100.0,-1.5678,-1.6644,
124  * -9.7212,-4.2874,-1.8414,-4.1708,-100.0,-100.0,-1.6724,-1.7487,
125  * -9.4335,-4.8218,-1.8819,-5.1127,-100.0,-100.0,-1.7934,-1.8433,
126  * -9.2103,-5.2457,-1.9241,-5.8430,-100.0,-100.0,-1.8695,-1.9045,
127  * -8.8049,-6.0306,-2.0219,-7.1625,-100.0,-100.0,-1.9980,-2.0159,
128  * -8.5172,-6.5966,-2.1062,-8.0835,-100.0,-100.0,-2.0931,-2.1037,
129  * -8.1117,-7.3994,-2.2443,-9.3404,-100.0,-100.0,-2.2377,-2.2434,
130  * -7.8240,-7.9720,-2.3528,-10.1845,-100.0,-100.0,-2.3488,-2.3524,
131  * -7.6009,-8.4169,-2.4433,-10.8000,-100.0,-100.0,-2.4406,-2.4431,
132  * -7.4186,-8.7812,-2.5210,-11.2723,-100.0,-100.0,-2.5189,-2.5209,
133  * -7.1309,-9.3557,-2.6502,-11.9547,-100.0,-100.0,-2.6489,-2.6502,
134  * -6.9078,-9.8017,-2.7564,-12.4300,-100.0,-100.0,-2.7555,-2.7564,
135  * -6.8860,-9.8450,-2.7668,-12.4980,-100.0,-100.0,-2.7659,-2.7667,
136  * -6.6846,-10.2477,-2.8680,-12.886,-10.9341,-100.0,-2.8670,-2.8677,
137  * -6.5023,-10.6124,-2.9638,-13.207,-9.2242,-100.0,-2.9615,-2.9619,
138  * -6.2146,-11.1872,-3.1222,-13.674,-7.8435,-100.0,-3.1129,-3.1134,
139  * -6.1928,-11.2308,-3.1350,-13.708,-7.7684,-100.0,-3.1249,-3.1252,
140  * -5.8091,-11.999,-3.3619,-14.261,-6.7935,-11.320,-3.3295,-3.3298,
141  * -5.5215,-12.5734,-3.5432,-14.640,-6.3095,-9.9133,-3.4806,-3.4806,
142  * -5.2983,-13.0198,-3.6901,-14.918,-6.0158,-9.2236,-3.5932,-3.5932,
143  * -5.1160,-13.3844,-3.8135,-15.138,-5.8095,-8.7949,-3.6801,-3.6801,
144  * -4.9618,-13.6924,-3.9201,-15.319,-5.6558,-8.4959,-3.7491,-3.7491,
145  * -4.8283,-13.9597,-4.0141,-15.473,-5.5353,-8.2719,-3.8050,-3.8050,
146  * -4.7105,-14.1953,-4.0984,-15.607,-5.4369,-8.0959,-3.8514,-3.8514,
147  * -4.6052,-14.4061,-4.1747,-15.724,-5.3557,-7.9530,-3.8898,-3.8898,
148  * -4.5099,-14.5968,-4.2447,-15.830,-5.2866,-7.8341,-3.9221,-3.9221,
149  * -4.4228,-14.7708,-4.3088,-15.926,-5.2277,-7.7333,-3.9502,-3.9502,
150  * -4.3428,-14.9309,-4.3685,-16.013,-5.1752,-7.6461,-3.9739,-3.9739,
151  * -4.2687,-15.0792,-4.4237,-16.093,-5.1293,-7.5700,-3.9938,-3.9938,
152  * -4.1997,-15.2171,-4.4759,-16.168,-5.0876,-7.5025,-4.0113,-4.0118,
153  * -4.1352,-15.3461,-4.5245,-16.237,-5.0502,-7.4420,-4.0269,-4.0269,
154  * -4.0174,-15.5816,-4.6146,-16.364,-4.9854,-7.3384,-4.0519,-4.0519,
155  * -3.9120,-15.7924,-4.6958,-16.475,-4.9308,-7.2525,-4.0710,-4.0710,
156  * -3.8167,-15.9827,-4.7695,-16.576,-4.8833,-7.1789,-4.0852,-4.0852,
157  * -3.7297,-16.1570,-4.8375,-16.668,-4.8423,-7.1156,-4.0965,-4.0965,
158  * -3.6497,-16.3173,-4.9002,-16.752,-4.8059,-7.0602,-4.1050,-4.1050,
159  * -3.5756,-16.4655,-4.9583,-16.829,-4.7737,-7.0110,-4.1117,-4.1117,
160  * -3.5066,-16.6033,-5.0130,-16.901,-4.7448,-6.9673,-4.1172,-4.1172,
161  * -3.2189,-17.1788,-5.2429,-17.198,-4.6337,-6.8016,-4.1277,-4.1277,
162  * -2.9957,-17.6250,-5.4239,-17.427,-4.5573,-6.6886,-4.1258,-4.1258,
163  * -2.8134,-17.9895,-5.5728,-17.614,-4.4999,-6.6062,-4.1190,-4.1190,
164  * -2.5257,-18.5654,-5.8101,-17.906,-4.4204,-6.4904,-4.1014,-4.1014,
165  * -2.3026,-19.0113,-5.9963,-18.133,-4.3646,-6.4106,-4.0834,-4.0834,
166  * -1.8971,-19.8223,-6.3356,-18.542,-4.2795,-6.2866,-4.0467,-4.0467,
167  * -1.6094,-20.3983,-6.5792,-18.832,-4.2302,-6.2126,-4.0202,-4.0202,
168  * -1.2040,-21.2089,-6.9233,-19.239,-4.1734,-6.1257,-3.9862,-3.9862,
169  * -0.9163,-21.7840,-7.1676,-19.528,-4.1414,-6.0753,-3.9649,-3.9649,
170  * -0.6931,-22.2306,-7.3569,-19.752,-4.1209,-6.0415,-3.9508,-3.9508,
171  * -0.5108,-22.5954,-7.5116,-19.934,-4.1062,-6.0174,-3.9399,-3.9399,
172  * -0.2231,-23.1705,-7.7592,-20.223,-4.0870,-5.9843,-3.9256,-3.9256,
173  * 0.0,-23.6164,-7.9542,-20.4464,-4.0745,-5.9631,-3.9160,-3.9160,
174  * 0.4055,-24.4275,-8.3134,-20.8519,-4.0565,-5.9313,-3.9016,-3.9016,
175  * 0.6931,-25.0035,-8.5695,-21.1398,-4.0467,-5.9138,-3.8937,-3.8937,
176  * 1.0986,-25.8141,-8.9327,-21.5456,-4.0365,-5.8951,-3.8849,-3.8849,
177  * 1.3863,-26.3892,-9.1915,-21.8334,-4.0308,-5.8839,-3.8800,-3.8800,
178  * 1.6094,-26.8358,-9.3931,-22.0566,-4.0274,-5.8774,-3.8771,-3.8771,
179  * 1.7918,-27.2005,-9.5579,-22.2388,-4.0246,-5.8728,-3.8752,-3.8752,
180  * 2.0794,-27.7757,-9.8190,-22.5269,-4.0218,-5.8664,-3.8723,-3.8723,
181  * 2.3026,-28.2216,-10.0214,-22.750,-4.0196,-5.8625,-3.8704,-3.8704,
182  * 2.7081,-29.0326,-10.3912,-23.155,-4.0168,-5.8573,-3.8680,-3.8680,
183  * 2.9957,-29.6086,-10.6543,-23.443,-4.0152,-5.8541,-3.8666,-3.8666,
184  * 3.4012,-30.4193,-11.0256,-23.848,-4.0135,-5.8514,-3.8651,-3.8651,
185  * 3.6889,-30.9943,-11.2898,-24.136,-4.0129,-5.8493,-3.8642,-3.8642,
186  * 3.9120,-31.4409,-11.4951,-24.359,-4.0124,-5.8482,-3.8637,-3.8637,
187  * 4.0943,-31.8057,-11.6635,-24.542,-4.0118,-5.8475,-3.8637,-3.8637,
188  * 4.3820,-32.3809,-11.9290,-24.830,-4.0113,-5.8468,-3.8632,-3.8632,
189  * 4.6052,-32.8268,-12.1352,-25.052,-4.0113,-5.8462,-3.8628,-3.8628/
190 ! *******************************************
191 ! tested by the following output
192 ! do j = 1, 82
193 ! write(*,'(8f11.4)') (airxcom(i, j), i=1,8)
194 ! enddo
195 ! *******************************************
196  real*8 u
197  integer icon
198  real ex, xsec(7)
199  ex=exin
200  call cgetxxsec(ex, airxcom, 82, m1, m2, xsec, icon)
201 ! xsec(m) is 1/(g/cm2).
202  do i = m1, m2
203  p(i) = xsec(i)*x0*0.1 ! X0 is in kg/m2/r%l; xsec is in /(g/cm2).
204  ! p(i) is 1/r.l (kg/m2=1000 g/10000 cm2= 0.1 g/cm2)
205  if( p(i) .gt. 0. ) then
206  call rndc(u)
207  path(i) = -log(u)/p(i)
208  else
209  path(i) = 1.e35
210  endif
211  enddo
i
nodes i
Definition: cstdatmos0.fNew2.h:93
rndc
subroutine rndc(u)
Definition: rnd.f:91
cgetxxsec
subroutine cgetxxsec(Ex, xcomtab, n, m1, m2, xsec, icon)
Definition: cGetXXsec.f:2
p
********************block data cblkHeavy ********************integer j data *HeavyG2symbol p
Definition: cblkHeavy.h:7
j
********************block data cblkHeavy ********************integer j data *HeavyG2symbol *data *HeavyG2code kiron data j
Definition: cblkHeavy.h:36
Here is the call graph for this function:
Here is the caller graph for this function: