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

Go to the source code of this file.

Functions/Subroutines

subroutine cl2ttbl (h1, h2, cosz1, cosz2, step, lengtb, htb, costb, thicktb, maxsize, tblsize)
 
real *8 function clen2thickt (z, cosz, leng)
 
subroutine csmll2t (h, cosz, s, t)
 
subroutine cz2t (z, cosz, loca, st, icon)
 
real *8 function ct2lt (z, cosz, t)
 

Function/Subroutine Documentation

◆ cl2ttbl()

subroutine cl2ttbl ( real*8  h1,
real*8  h2,
real*8  cosz1,
real*8  cosz2,
real*8  step,
real*8, dimension(maxsize)  lengtb,
real*8, dimension(maxsize)  htb,
real*8, dimension(maxsize)  costb,
real*8, dimension(maxsize)  thicktb,
integer  maxsize,
integer  tblsize 
)

Definition at line 8 of file cl2tTbl.f.

Referenced by cinitracking().

8 !
9  implicit none
10 #include "Zearth.h"
11 ! this program makes a table of slant air thickenss from h1 to h2
12 ! with a given zenith angle. The table is made at 0 (= at h1),
13 ! step, 2*step, ... along the path
14  real*8 h1 ! input. higher vertical height in m
15  real*8 h2 ! input. lower vertical height in m
16 ! h1=30d3, h2=-0.1d3 would be standard.
17  real*8 cosz1 ! input. cos of zenith angle at h1
18  real*8 cosz2 ! input. cos of zeniht angle at h2
19  real*8 step ! input. step of the length from h1 to h2
20  integer maxsize ! input. max usable size of lengtb, and thicktb
21  real*8 lengtb(maxsize) ! outpu. lengtb(i) = (i-1)*step
22  real*8 thicktb(maxsize) ! output. thicktb(i) = air thickness
23  real*8 htb(maxsize)
24  real*8 costb(maxsize)
25 ! along the path at lengtb(i).
26  integer tblsize ! output . actual size of the tables made.
27 
28 
29  real*8 clen2thickex
30  real*8 cost, sumt, z
31  real*8 temp, cnewcos, cnewh
32 
33  integer i
34 
35 ! step
36 ! //////////
37 ! write(*,*) ' h1=',h1,' h2=',h2, ' cosz=',cosz,
38 ! * ' step=',step, ' maxsize=',maxsize
39 ! //////////
40 
41  cost= cosz1
42  sumt = 0.
43  lengtb(1) = 0.
44  thicktb(1) = 0.
45  htb(1) = h1
46  z = h1
47 
48  do i = 2, maxsize
49  lengtb(i) = lengtb(i-1) + step
50  thicktb(i) = thicktb(i-1) + clen2thickex(z, cost, step, 8)
51 ! //////////
52 ! write(*, *) lengtb(i), thicktb(i), z, cost
53 !///////////////
54  temp= max(cosz2, cnewcos(z+eradius, cost, step))
55  z = cnewh(z+eradius, cost, step) - eradius
56  htb(i) = z
57  cost = temp
58  costb(i) = cost
59  if(z .le. h2) then
60  tblsize = i
61  goto 100
62  endif
63  enddo
64  tblsize = maxsize
65  100 continue
66 ! ///////////
67 ! write(*,*) ' max thick=', thicktb(tblsize),lengtb(tblsize),
68 ! * ' size=', tblsize
69 ! ///////////////
nodes z
nodes i
real *8 function clen2thickex(z, cosz, leng, n)
Definition: clen2thick.f:131
real *8 function cnewcos(H, cost, L)
Definition: catmosutil.f:70
real *8 function cnewh(H, cost, L)
Definition: catmosutil.f:98
Here is the caller graph for this function:

◆ clen2thickt()

real*8 function clen2thickt ( real*8  z,
real*8  cosz,
real*8  leng 
)

Definition at line 73 of file cl2tTbl.f.

References cnewcossin(), csmll2t(), and cz2t().

73 !
74 ! z: real*8. input. vertical height in m.
75 ! cosz: real*8. input. cos of zenith angle at z.
76 ! leng: real*8. input. length along cosz direction.
77 ! function value. thickness of air in kg/m2. for leng
78  implicit none
79 #include "Zearth.h"
80 #include "Zatmos.h"
81  real*8 z, cosz, leng
82  real*8 z2, cos2, sin2
83  real*8 r1, r2, st1, st2, dt
84  integer loca, icon
85 
86 ! get height at leng ahead: z2
87  r1 = z + eradius
88  call cnewcossin(r1, cosz, leng, r2, cos2, sin2)
89  z2 = r2- eradius
90 ! get slant thickness, st1, at z
91  if(z .eq. zsave) then
92  st1 = thicksave
93  else
94  call cz2t(z, cosz, loca, st1, icon)
95  if(icon .ne. 0) then
96  write(*, *) ' error: in clen2thickT; z=', z,
97  * ' cosz=',cosz, ' leng=', leng
98  stop 9999
99  endif
100  endif
101 
102  if(leng .lt. lenstep) then
103 ! this approx is better but somewhat
104 ! inconsistent with table method. why ??
105  call csmll2t(z, cosz, leng, dt)
106  st2 = st1 + dt
107  write(*, *) ' small approx dt=', dt, ' for leng=',leng
108 !
109  else
110 ! get slant thickness, st2, for z2
111  call cz2t(z2, cos2, loca, st2, icon)
112  if(icon .ne. 0) then
113  write(*, *)' error in clen2thickT; z=', z,
114  * ' cosz=', cosz, ' leng=', leng, ' z2=', z2
115  stop 9999
116  endif
117  dt = st2 - st1
118 !
119 ! write(*, *) ' no small appx; dt=',dt
120 !
121  endif
122  clen2thickt = dt
123  zsave = z2
124  thicksave = st2
nodes z
integer leng
Definition: interface2.h:1
subroutine cnewcossin(h1, cos1, leng, h2, cos2, sin2)
Definition: catmosutil.f:112
real *8 function clen2thickt(z, cosz, leng)
Definition: cl2tTbl.f:73
subroutine cz2t(z, cosz, loca, st, icon)
Definition: cl2tTbl.f:194
subroutine csmll2t(h, cosz, s, t)
Definition: cl2tTbl.f:130
Here is the call graph for this function:

◆ csmll2t()

subroutine csmll2t ( real*8  h,
real*8  cosz,
real*8  s,
real*8  t 
)

Definition at line 130 of file cl2tTbl.f.

References d, and d0.

Referenced by clen2thickt(), and cz2t().

130  implicit none
131 #include "Zearth.h"
132 #include "Zatmos.h"
133  real*8 h ! input. hight in m
134  real*8 cosz ! input. cos of zenith angle at h.
135  real*8 s ! input. small length in m along cosz from h.
136  real*8 t ! output. thickness of air for s. <0 if s < 0
137 !
138  real*8 cs, sn2, ss, sold, eps
139 ! real*8 f1, f2, f3, rho, rho1, rho2, rho3, r
140 ! real*8 f1, f2, f3, rho, rho1, rho2, r
141  real*8 f1, f2, rho, rho1, rho2, r
142  integer i
143 ! real*8 cvh2den, cvh2denp, cvh2den2p, cvh2den3p
144  real*8 cvh2den, cvh2denp, cvh2den2p
145  data eps/1.d-6/
146 
147 ! f1(ss) = ss*(-cs/2.d0 + ss*sn2/r *(1.d0/6.d0 +
148 ! * ss* cs/8.d0/r))
149  f1(ss) = ss*(-cs/2.d0 + ss*sn2/r/6.d0)
150 
151  f2(ss) = ss**2* cs*(cs/3.d0 - ss*sn2/4.d0/r)
152 ! f3(ss) = -(ss*cs)**3/4.d0
153 !
154  r = eradius + h
155  cs = cosz
156  sn2 = 1.d0- cs**2
157  rho = cvh2den(h)
158  rho1 = cvh2denp(h)
159  rho2 = cvh2den2p(h)
160 ! rho3 = cvh2den3p(h)
161 ! t = s*(rho + rho1*f1(s) + rho2*f2(s) + rho3*f3(s))
162  t = s*(rho + rho1*f1(s) + rho2*f2(s) )
163  return
164 ! ---------------------------
165 ! get length s for thickenss t at height h along cosz
166 ! |t| should be small so that s be < ~ 100 m.
167  entry csmlt2l(h, cosz, t, s)
168 !
169  r = eradius + h
170  cs = cosz
171  sn2 = 1.d0- cs**2
172 
173  rho = cvh2den(h)
174  rho1 = cvh2denp(h)
175  rho2 = cvh2den2p(h)
176 ! rho3 = cvh2den3p(h)
177  sold = t/rho
178  do i = 1, 6
179  s =t/ ( rho + rho1*f1(sold) + rho2 *f2(sold)
180  * )
181 ! * + rho3*f3(sold) )
182  if( abs(s) .lt. 1.d0 .and. abs(s-sold) .lt. eps) then
183  goto 10
184  elseif(abs( (s-sold)/s ) .lt. eps) then
185  goto 10
186  endif
187  sold = s
188  enddo
189  10 continue
real *8 function cvh2denp(z)
Definition: ciniSegAtoms.f:201
*Zfirst p fm *Zfirst p Zfirst p Zfirst p *Zfirst p *Zfirst pos xyz r
Definition: ZavoidUnionMap.h:1
nodes i
block data cblkEvhnp ! currently usable models data RegMdls ad *special data *Cekaon d0
Definition: cblkEvhnp.h:5
real *8 function cvh2den2p(z)
Definition: ciniSegAtoms.f:251
dE dx *! Nuc Int sampling table d
Definition: cblkMuInt.h:130
real *8 function cvh2den(z)
Definition: ciniSegAtoms.f:54
dE dx *! Nuc Int sampling table h
Definition: cblkMuInt.h:130
nodes t
Here is the caller graph for this function:

◆ ct2lt()

real*8 function ct2lt ( real*8  z,
real*8  cosz,
real*8  t 
)

Definition at line 243 of file cl2tTbl.f.

References cnewcossin(), cz2t(), d0, and kdwhereis().

243  implicit none
244 #include "Zatmos.h"
245 #include "Zearth.h"
246 
247  real*8 z ! input vertical height in m
248  real*8 cosz ! input. cos of zenith angle at z
249  real*8 t ! input. thickness of air in kg/m^2 along cosz
250 !
251  integer loca, icon
252  real*8 st1, st2, r0, r1, r2, rx, cosx, cos2, sin2
253  real*8 s1, s2, dt
254  real*8 clenbetween2h, cvh2den
255 
256  r1 = z + eradius
257 
258 ! get slant thickness st1 from Htop to z
259  if(z .eq. zsave) then
260  st1 = thicksave
261  else
262  call cz2t(z, cosz, loca, st1, icon)
263  if(icon .ne. 0) then
264  write(*,*) ' error in cz2t; z=', z, ' cosz=', cosz
265  stop 999
266  endif
267  endif
268 ! new point slant thickness
269  st2 = st1 + t
270 !
271 ! integral location of z: H(loca+1)<= z < H(loca)
272  call kdwhereis(z, numstep, heighttbl, 1, loca)
273  if(loca .le. 0 .or. loca .ge. numstep) then
274  write(0,*) ' error in ct2lT', ' z=',z, 'cos=',cosz,
275  * ' t = ',t
276  stop 999
277  else
278  r0 = z + eradius
279  rx = heighttbl(loca) + eradius
280  s1 = - clenbetween2h(r0, rx, cosz) ! s1 > 0
281  endif
282 ! get integral point for st2; T(loca) <= st2 < T(loca+1)
283  call kdwhereis(st2, numstep, thicktbl, 1, loca)
284 
285  if(loca .ge. numstep) then
286  ct2lt = 1.d5
287  zsave = heighttbl(numstep)
288  thicksave = thicktbl(numstep)
289  elseif(loca .le. 0.) then
290  write(*,*) ' error in ct2lT; z=',z, ' t=',t, ' st2=',st2
291  stop 9999
292  else
293  if(t/cvh2den(z) .lt. lenstep .and. cosz .lt. 0.22d0) then
294  call csmlt2l(z, cosz, t, ct2lt)
295 ! we don't get ThickSave, Zsave in this case. leave the
296 ! buisiness to the next call
297  else
298  dt = st2 - thicktbl(loca)
299  if(dt .lt. thicktbl(loca+1) - st2) then
300 ! get length for dt
301  call csmlt2l(heighttbl(loca), costbl(loca), dt, s2)
302 ! get height at s2
303  rx = heighttbl(loca) + eradius
304  cosx = costbl(loca)
305  call cnewcossin(rx, cosx, s2, r2, cos2, sin2)
306  else
307  dt = thicktbl(loca+1) - st2
308  call csmlt2l(heighttbl(loca+1), costbl(loca+1),
309  * -dt, s2) ! s2 < 0
310  rx = heighttbl(loca+1) + eradius
311  cosx = costbl(loca+1)
312  call cnewcossin(rx, cosx, s2, r2, cos2, sin2)
313  endif
314  ct2lt = clenbetween2h(r1, r2, cosz)
315  zsave = r2 - eradius
316  thicksave = st2
317  endif
318  endif
nodes z
real *8 function clenbetween2h(h1, h2, cost)
Definition: catmosutil.f:138
subroutine kdwhereis(x, in, a, step, loc)
Definition: kdwhereis.f:27
subroutine cnewcossin(h1, cos1, leng, h2, cos2, sin2)
Definition: catmosutil.f:112
real *8 function ct2lt(z, cosz, t)
Definition: cl2tTbl.f:243
block data cblkEvhnp ! currently usable models data RegMdls ad *special data *Cekaon d0
Definition: cblkEvhnp.h:5
subroutine cz2t(z, cosz, loca, st, icon)
Definition: cl2tTbl.f:194
real *8 function cvh2den(z)
Definition: ciniSegAtoms.f:54
nodes t
Here is the call graph for this function:

◆ cz2t()

subroutine cz2t ( real*8  z,
real*8  cosz,
integer  loca,
real*8  st,
integer  icon 
)

Definition at line 194 of file cl2tTbl.f.

References csmll2t(), and kdwhereis().

Referenced by clen2thickt(), and ct2lt().

194  implicit none
195 
196 #include "Zearth.h"
197 #include "Zatmos.h"
198  real*8 z ! input. vertical height in m
199  real*8 cosz ! input. cos of zenith angle at z.
200  integer loca ! output. loca is such that
201 ! HeightTbl(loca+1) <= z < HeightTbl(loca)
202  real*8 st ! output. slant thikness in kg/m^2 from Htop along
203 ! cosz
204  integer icon ! output. = 0 if normal. =1 if loca is out of range.
205  real*8 clenbetween2h, ds, r1, r2, dt
206 
207 
208 ! get location of nearest integral point of upper height
209  call kdwhereis(z, numstep, heighttbl, 1, loca)
210  if(loca .ge. numstep) then
211  st = thicktbl(numstep)
212  icon = 0
213  elseif(loca .le. 0) then
214  if(z .eq. htop) then
215  loca =1
216  st = 0.
217  icon = 0
218  else
219  write(*,*) ' error in cz2t; z=',z
220  stop 999
221  endif
222  else
223 ! get length from HeightTbl(loca) to z
224  r1 = z + eradius
225  r2 = heighttbl(loca) + eradius ! r1 < r2
226  ds = clenbetween2h(r2, r1, costbl(loca) ) ! ds > 0
227  if(ds .lt. lenstep/2) then
228 ! thickness for ds
229  call csmll2t(heighttbl(loca), costbl(loca), ds, dt)
230  st = thicktbl(loca) + dt
231  else
232  ds = ds- lenstep ! < 0
233  call csmll2t(heighttbl(loca+1), costbl(loca+1), ds, dt) ! dt < 0
234  st = thicktbl(loca+1) + dt
235  endif
236  icon = 0
237  endif
nodes z
real *8 function clenbetween2h(h1, h2, cost)
Definition: catmosutil.f:138
subroutine kdwhereis(x, in, a, step, loc)
Definition: kdwhereis.f:27
subroutine csmll2t(h, cosz, s, t)
Definition: cl2tTbl.f:130
Here is the call graph for this function:
Here is the caller graph for this function: