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

Go to the source code of this file.

Functions/Subroutines

subroutine cprlsampp (Eg, prob)
 
subroutine cprlsampe (Eg, Ee)
 

Function/Subroutine Documentation

◆ cprlsampe()

subroutine cprlsampe ( real*8  Eg,
real*8  Ee 
)

Definition at line 23 of file cPrLSamp.f.

References d0, k4ptdi(), and rndc().

Referenced by cpairenergy().

23 ! ************
24 ! samples higher energy pair electron
25  implicit none
26 #include "ZbpCnst.h"
27 #include "ZbpTable.h"
28 
29  real*8 ee, eg
30 
31  real*8 u, ale, us, ans, ex
32 
33  call rndc(u)
34  ale = log10(eg)
35  if(u .gt. pairuminla) then
36 ! region A
37  call k4ptdi(prstla,
38  * pairuszla,
39  * pairesize,
40  * pairuszla,
41  * pairuminla,
42  * pairlegmin,
43  * pairdula,
44  * pairdela, u, ale, ans)
45  ee = (ans*(1.-u) + 0.5d0)*eg
46  else
47 ! region B
48  us = u**0.25d0
49  ex = sqrt(ale - pairlegmin)
50 
51  call k4ptdi(prstlb,
52  * pairuszlb,
53  * pairesize,
54  * pairuszlb,
55  * 0.d0,
56  * 0.d0,
57  * pairdulb,
58  * pairdelb, us, ex, ans)
59  ee = ans* eg
60  endif
ans
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
Definition: cstdatmos0.fNew2.h:82
rndc
subroutine rndc(u)
Definition: rnd.f:91
d0
block data cblkEvhnp ! currently usable models data RegMdls ad *special data *Cekaon d0
Definition: cblkEvhnp.h:5
k4ptdi
subroutine k4ptdi(f, im, jm, iadj, x0, y0, hx, hy, x, y, ans)
Definition: k4ptdi.f:21
Here is the call graph for this function:
Here is the caller graph for this function:

◆ cprlsampp()

subroutine cprlsampp ( real*8  Eg,
real*8  prob 
)

Definition at line 2 of file cPrLSamp.f.

References d, and kintp3().

Referenced by cpairpath().

2  implicit none
3 #include "ZbpCnst.h"
4 #include "ZbpTable.h"
5  real*8 eg
6  real*8 prob ! output probability of Pair / X0
7 
8 
9  real*8 ale
10 
11 
12  if(eg .lt. pairegmin) then
13  prob= 1.d-40
14  else
15  ale=log10(eg)
16  call kintp3(prtxl,
17  * 1, pairtxtl, pairlegmin,
18  * pairdetxl, ale, prob)
19  endif
d
dE dx *! Nuc Int sampling table d
Definition: cblkMuInt.h:130
kintp3
subroutine kintp3(f, intv, n, x1, h, x, ans)
Definition: kintp3.f:19
Here is the call graph for this function:
Here is the caller graph for this function: