COSMOS v7.655  COSMOSv7655
(AirShowerMC)
getST2.f
Go to the documentation of this file.
1 ! This is to compute integral of primaries for a given
2 ! theta, fai.
3 !
4 #include "BlockData/cblkGene.h"
5  implicit none
6 #include "Zglobalc.h"
7 #include "Zmanagerp.h"
8 #include "ZrigCut.h"
9 #include "Zptcl.h"
10 #include "Zobs.h"
11 #include "Zobsp.h"
12 #include "Zprimary.h"
13 #include "Zprimaryc.h"
14 #include "Zprimaryv.h"
15 #include "Zincidentp.h"
16 #ifdef NEXT486
17 #define IMAG_P dimag
18 #else
19 #define IMAG_P imag
20 #endif
21  include 'Zflux.h'
22 
23  integer i
24 
25  real*8 cosmin, cosmax
26  real*8 ans, sum
27  logical deg
28 
29  call creadparam(5)
30  call cbeginrun
31  call cprintprim(errorout)
32  cosmax = imag_p(coszenith)
33  cosmin = real(coszenith)
34  azmmax = imag_p(azimuth) + xaxisfromsouth
35  azmmin = real(Azimuth) + XaxisFromSouth
36 
37  if(cosmax .ne. cosmin .or. ( cosmax .ne. 1.d0 .and.
38  * azmmax .ne. azmmin) ) then
39  write(*,*) ' this progam is to compute integral of'
40  write(*,*) ' primary for a given cos and fai'
41  write(*,*) ' give the same value for upper and lower'
42  write(*,*) ' limit of CosZenith and Azimuth'
43  stop
44  endif
45  if(cosmax .eq. 1.d0) then
46  write(*,*)
47  * ' getST3 with fai=0~2pi may give you a different result',
48  * ' for cos=1'
49  write(*,*)
50  * ' both should give the same result but due to the'
51  write(*,*)
52  * ' table usage, the results are different. '
53  endif
54  if(cutofffile .eq. ' ') then
55  rigc = 0.
56  deg = .false.
57  else
58  rigc = 100.
59  if(zenvalue .eq. 'deg') then
60  deg = .true.
61  else
62  deg = .false.
63  endif
64  endif
65  zen1 = cosmin
66  zen2 = cosmax
67 
68 
69  write(*,*)
70  write(*,*)
71  * ' cos value=',zen1
72  if(zen1 .ne. 1.d0) then
73  write(*,*)
74  * ' fai value=', imag_p(azimuth)
75  endif
76  write(*,*) ' X-axis From South=', xaxisfromsouth, ' deg'
77  write(*,*)
78  if(rigc .eq. 0) then
79  write(*,*) ' No rigidity cut is assumed'
80  write(*,*)
81  * ' primary Int(dI/dE) sum(cumlative);'
82  else
83  write(*,*) ' Rigidity cut is applied'
84  write(*,*)
85  * ' primary Int(dI/dE*RigCut) sum(cumlative);'
86  endif
87  sum = 0.
88  do i = 1, prim%no_of_comps
89  call inteflux(prim%each(i), ans)
90  sum = sum + ans
91  write(*,*)' ', prim%each(i)%symb,' ', sngl(ans),
92  * ' ', sngl(sum)
93  enddo
94 
95  write(*,*)
96  * 'If N primaries are generated in simulation,'
97  write(*,*)' STdOmega= N/sum'
98 
99  end
100 ! ******************
101  subroutine inteflux(comp, ans)
102  implicit none
103 #include "Zglobalc.h"
104 #include "Zptcl.h"
105 #include "Zprimary.h"
106  type(component):: comp
107  real*8 ans
108  include 'Zflux.h'
109 
110  real*8 eps, error, ans2, Eth, e_or_p
111  integer icon
112 
113 
114  integer imax
115  external primdn
116  real*8 primdN
117  type(ptcl)::aptcl
118  integer j
119  data eps/1.d-4/
120 
121 
122 
123  compx = comp
124  imax = comp%no_of_seg
125  if(rigc .eq. 0.) then
126 ! no rigidy cut. integrate segmented power functions
127  call inteprim2(comp, 1, imax, ans)
128  else
129  call cmkptc(comp%code, comp%subcode, comp%charge, aptcl)
130  eth =sqrt( (rigc*comp%charge)**2 + aptcl%mass**2 )
131  call cconv_prim_e2(comp, eth, e_or_p)
132  call kdwhereis(e_or_p, comp%no_of_seg+1, comp%energy, 1, j)
133  if(j .le. imax) then
134 ! energy integral;
135  call kdexpintfb(primdn, comp%energy(1), comp%energy(j+1),
136  * eps, ans, error, icon)
137  ans = ans
138  endif
139 ! add E> comp.energy(j+1)
140  if(j+1 .lt. imax ) then
141  call inteprim2(comp, j+1, imax, ans2)
142  else
143  ans2 = 0.
144  endif
145  ans = ans + ans2
146  endif
147  end
148 
149 ! ****************************
150  real*8 function primdn(eorp)
151  implicit none
152 
153 #include "Zglobalc.h"
154 #include "Zptcl.h"
155 #include "Zprimary.h"
156 ! primary flux at E
157  real*8 eorp
158 
159  include 'Zflux.h'
160 
161 
162 
163  type(ptcl):: aptcl
164  real*8 rig, prob, flux, zeny
165 
166  e = eorp
167 ! E= E_or_P must be converted to rigidity
168  call cconv_prim_e(compx, e, aptcl)
169 
170  rig =sqrt( aptcl%fm%p(4)**2 - aptcl%mass**2)/aptcl%charge
171  if(degree) then
172  zeny = zen1/torad
173  else
174  zeny = zen1
175  endif
176  call crigcut(azmmin, zeny, rig, prob)
177  call cprimflux0(compx, e, flux) ! E = EorP
178 
179  primdn = flux * prob
180  end
181 
182  subroutine chooktrace
183  end
184  subroutine chookceren
185  end
186  subroutine chookcerens
187  end
188  subroutine chookcerene
189  end
190  subroutine chookbgrun
191  end
192 
193 
194 
real zen2
Definition: Zflux.h:1
real *8 function primdn(eorp)
Definition: getST.f:246
real zen1
Definition: Zflux.h:1
dE dx *! Nuc Int sampling table e
Definition: cblkMuInt.h:130
atmos%rho(atmos%nodes) **exp(-(z-atmos%z(atmos%nodes))/Hinf) elseif(z .lt. atmos%z(1)) then ans=atmos%rho(1) **exp((atmos%z(1) -z)/atmos%H(1)) else call kdwhereis(z, atmos%nodes, atmos%z, 1, i) a=atmos%a(i) if(a .ne. 0.d0) then ans=atmos%rho(i) **(1+a *(z-atmos%z(i))/atmos%H(i)) **(-1.0d0-1.d0/a) else ans=*atmos%rho(i) *exp(-(z-atmos%z(i))/atmos%H(i)) endif endif ! zsave=z ! endif cvh2den=ans end ! ---------------------------------- real *8 function cvh2temp(z) implicit none ! vettical height to temperatur(Kelvin) real *8 z ! input. vertical height in m ! output is temperature of the atmospher in Kelvin real *8 ans integer i if(z .gt. atmos%z(atmos%nodes)) then ans=atmos%T(atmos%nodes) elseif(z .lt. atmos%z(1)) then ans=atmos%T(1)+atmos%b(1) *(z - atmos%z(1)) else call kdwhereis(z, atmos%nodes, atmos%z, 1, i) ans=atmos%T(i)+atmos%b(i) *(z-atmos%z(i)) endif cvh2temp=ans end !--------------------------------------------- real *8 function cthick2h(t) implicit none real *8 t ! input. air thickness in kg/m^2 real *8 logt, ans integer i real *8 dod0, fd, a logt=log(t) if(t .ge. atmos%cumd(1)) then ans=atmos%z(1) - *(logt - atmos%logcumd(1)) *atmos%H(1) elseif(t .le. atmos%cumd(atmos%nodes)) then ans=atmos%z(atmos%nodes) - *Hinf *log(t/atmos%cumd(atmos%nodes)) else call kdwhereis(t, atmos%nodes, atmos%cumd, 1, i) ! i is such that X(i) > x >=x(i+1) ans
nodes i
subroutine crigcut(azmin, zen, rig, prob)
Definition: crigCut.f:6
subroutine cconv_prim_e2(comp, E, e_or_p)
Definition: csampPrimary.f:230
subroutine kdwhereis(x, in, a, step, loc)
Definition: kdwhereis.f:27
real * azmmin
Definition: Zflux.h:1
block data cblkElemag data *AnihiE ! Eposi< 1 TeV, anihilation considered *X0/365.667/, ! radiation length of air in kg/m2 *Ecrit/81.e-3/, ! critical energy of air in GeV *MaxComptonE/1./, ! compton is considered below 1 GeV *MaxPhotoE/1.e-3/, ! above this, PhotoElectric effect neg. *MinPhotoProdE/153.e-3/, ! below 153 MeV, no gp --> hadrons ! scattering const not MeV *Knockon true
Definition: cblkElemag.h:7
subroutine cprintprim(out)
Definition: cprintPrim.f:3
subroutine cconv_prim_e(comp, e_or_p, aPtcl)
Definition: csampPrimary.f:128
subroutine chookceren
Definition: det2Exyz.f:63
real rigc
Definition: Zflux.h:1
subroutine creadparam(io)
Definition: creadParam.f:5
subroutine chooktrace
Definition: chook.f:275
block data cblkEvhnp ! currently usable models data RegMdls ad *special data *Cekaon d0
Definition: cblkEvhnp.h:5
subroutine kdexpintfb(func, a, b, eps, ans, error, icon)
Definition: kdexpIntFb.f:10
subroutine chookcerene
Definition: det2Exyz.f:67
dE dx *! Nuc Int sampling table d
Definition: cblkMuInt.h:130
*Zfirst p fm *Zfirst p Zfirst p Zfirst p *Zfirst p *Zfirst pos xyz Zfirst pos xyz *Zfirst pos *Zfirst pos Zfirst pos *Zfirst pos *Zfirst Zfirst vec w *Zfirst vec w Zfirst vec coszenith
Definition: ZavoidUnionMap.h:1
subroutine chookcerens(no, primary, angle)
Definition: ctemplCeren.f:19
subroutine inteprim2(comp, i1, i2, ans)
Definition: intePrim2.f:2
subroutine cprimflux0(comp, e_or_p, flux)
Definition: cprimFlux0.f:2
subroutine inteflux(comp, ans)
Definition: getST.f:150
block data cblkElemag data *AnihiE ! Eposi< 1 TeV, anihilation considered *X0/365.667/, ! radiation length of air in kg/m2 *Ecrit/81.e-3/, ! critical energy of air in GeV *MaxComptonE/1./, ! compton is considered below 1 GeV *MaxPhotoE/1.e-3/, ! above this, PhotoElectric effect neg. *MinPhotoProdE/153.e-3/, ! below 153 MeV, no gp --> hadrons ! scattering const not MeV *Knockon ! knockon is considered Obsolete *PhotoProd false
Definition: cblkElemag.h:7
subroutine cmkptc(code, subcode, charge, p)
Definition: cmkptc.f:15
real azmmax
Definition: Zflux.h:1
Definition: Zptcl.h:75
subroutine cbeginrun
Definition: cbeginRun.f:7
subroutine chookbgrun
Definition: chook.f:15
real zen logical degree
Definition: Zflux.h:1