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

Go to the source code of this file.

Functions/Subroutines

subroutine chookbgrun
 
subroutine chookbgevent
 
subroutine cbegin1ev (nomore)
 
subroutine chookobs (aTrack, id)
 
subroutine chookenevent
 
subroutine chookenrun
 
subroutine chooktrace
 
subroutine chookeint (never)
 
subroutine chookgint (never)
 
subroutine chooknepint (never)
 
subroutine cgethes (from)
 
subroutine cobshes
 
subroutine c1by1
 
subroutine embedas
 
subroutine cmove_c_stack
 

Function/Subroutine Documentation

◆ c1by1()

subroutine c1by1 ( )

Definition at line 372 of file chookFlesh.f.

References asflag, c, cinitstack(), cmove_c_stack(), embedas(), false, p, and true.

372  implicit none
373 #include "Zprivate.h"
374 #include "Ztrack.h"
375 #include "Ztrackv.h"
376 
377  character*100 msg
378 
379  call cinitstack ! empty the stack
380 
381  if( topofnode ) then
382  read(mdev) nooflowe, p
383  if( p.asflag .eq. -1 .and. observeas
384  * .and. howflesh .ne. 0 ) then
385  call embedas
386  endif
387  nlowcounter = 0
388  if( nooflowe .eq. -1 ) then
389  realend = .true.
390  realbegin = .true.
391  return ! ************
392  endif
393  endif
394 
395  realbegin = .false.
396  realend = .false.
397 
398 
399  if( nlowcounter .eq. nooflowe ) then
400  topofnode =.true.
401  return ! **************
402  endif
403 
404  topofnode = .false.
405 ! still not the end of 1 event
406 
407  read(mdev) c
408 
409  nlowcounter = nlowcounter + 1
410  call cmove_c_stack ! move c into stack
411 
subroutine embedas
Definition: chookFlesh.f:409
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 cinitstack
Definition: cstack.f:76
********************block data cblkHeavy ********************integer j data *HeavyG2symbol p
Definition: cblkHeavy.h:7
*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 *Zfirst Zfirst Zfirst asflag
Definition: ZavoidUnionMap.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 ! knockon is considered Obsolete *PhotoProd false
Definition: cblkElemag.h:7
subroutine cmove_c_stack
Definition: chookFlesh.f:429
dE dx *! Nuc Int sampling table c
Definition: cblkMuInt.h:130
Here is the call graph for this function:

◆ cbegin1ev()

subroutine cbegin1ev ( integer  nomore)

Definition at line 74 of file chookFlesh.f.

References cgethes(), charge, cinitracking(), cmkincident(), cobshes(), code, cqincident(), cresettimer(), e, false, p, r, subcode, and x.

74  implicit none
75 #include "Zprivate.h"
76 #include "Ztrack.h"
77 #include "Ztrackv.h"
78 #include "Ztrackp.h"
79 #include "Zobs.h"
80 #include "Zobsp.h"
81 #include "Zobsv.h"
82 #include "Zcode.h"
83 #include "Zmanager.h"
84 #include "Zmanagerp.h"
85 
86  integer nomore ! output. 0 still there are showers
87  ! 1 no more skeleton showers to be fleshed
88 ! event number, primary
89 
90  type(track)::incident
91  type(track)::zsave
92  type(coord)::angle
93 
94  integer i
95  integer seed(2)
96  integer cumnum, num, jeof, fin
97  read( mdev, end=1000 ) cumnum, num, seedsave, zfirst
98 
99  eventsintherun = eventsintherun + 1
100  eventno = eventno + 1
101 ! get random seed at skelton making; this can work
102 ! if seed file is supplied
103 ! call creadSeed(SeedSave, EventNo, jeof)
104 ! if( jeof .ne. 0 ) goto 1000
105 
106 ! reset the seed.
107  call rnd1r(seedsave)
108 
109 ! next incident; confirmed to be the same one as preserved one
110  call cmkincident(incident, fin)
111 
112  if(fin .ne. 0 ) goto 1000
113  zsave = zfirst ! save; this is reset in next
114  call cinitracking( incident )
115 ! set first interaction pos
116  zfirst = zsave
117  call cresettimer(zfirst)
118 
119  realbegin = .false.
120 
121 ! do your own init for a one event here
122 ! ==========================================================
123  call cqincident( incident, angle)
124  write(*,999)
125  * eventno,
126  * incident.p.code,
127  * incident.p.subcode,
128  * incident.p.charge,
129  * incident.p.fm.e,
130  * -angle.r(1),
131  * -angle.r(2),
132  * -angle.r(3)
133  999 format(i9,3i4,e15.5,3(1x,f12.8))
134 
135 
136 ! ==========================================================
137 !
138 
139  call cgethes(mdev) ! get high energy ptlcs
140  call cobshes ! imitate their observation
141  nomore = 0
142  return
143 
144  1000 continue
145  nomore = 1
subroutine cqincident(incident, AngleAtObs)
Definition: cmkIncident.f:486
dE dx *! Nuc Int sampling table e
Definition: cblkMuInt.h:130
*Zfirst p fm *Zfirst p Zfirst p Zfirst p *Zfirst p *Zfirst pos xyz r
Definition: ZavoidUnionMap.h:1
nodes i
Definition: Ztrack.h:44
real(8), dimension(:,:,:,:), allocatable, save num
Definition: chook.f:40
subroutine cmkincident(incident, fin)
Definition: cmkIncident.f:5
********************block data cblkHeavy ********************integer j data *HeavyG2symbol p
Definition: cblkHeavy.h:7
*Zfirst p fm *Zfirst p Zfirst p code
Definition: ZavoidUnionMap.h:1
subroutine cgethes(from)
Definition: chookFlesh.f:322
subroutine cinitracking(incident)
Definition: ciniTracking.f:2
*Zfirst p fm *Zfirst p Zfirst p Zfirst p *Zfirst p charge
Definition: ZavoidUnionMap.h:1
subroutine cresettimer(aTrack)
Definition: ctracking.f:302
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
Definition: Zcoord.h:43
! structure defining a particle at production ! Basic idea of what is to be contained in ! the particle structue is that dynamical ones should be included those derivable from the particle code ! is not included ******************************************************type fmom momentum sequence union map real e endmap map real * x
Definition: Zptcl.h:21
*Zfirst p fm *Zfirst p Zfirst p Zfirst p subcode
Definition: ZavoidUnionMap.h:1
subroutine cobshes
Definition: chookFlesh.f:335
Here is the call graph for this function:

◆ cgethes()

subroutine cgethes ( integer  from)

Definition at line 327 of file chookFlesh.f.

References o.

327  implicit none
328 #include "Zprivate.h"
329  integer from
330 
331  integer i
332 
333  read(from) np
334  do i = 1, np
335  read(from) o(i)
336  enddo
nodes i
struct ob o[NpMax]
Definition: Zprivate.h:34
integer maxbin nregion c minsave drx2 ! drawing region real maxdep integer maxpos integer from
Definition: Zfit.h:15

◆ chookbgevent()

subroutine chookbgevent ( )

Definition at line 56 of file chookFlesh.f.

References c1by1(), cbegin1ev(), cerrormsg(), and true.

56  implicit none
57 #include "Zprivate.h"
58 
59 
60  integer nomore
61  if( realbegin ) then
62  call cbegin1ev( nomore )
63  if( nomore .eq. 1) then
64  call cerrormsg('all events are fleshed', 1)
65  stop !!!!!!!!!!!!
66  endif
67  topofnode = .true.
68  endif
69  call c1by1
70 
71 
subroutine cerrormsg(msg, needrtn)
Definition: cerrorMsg.f:4
subroutine cbegin1ev(nomore)
Definition: chookFlesh.f:67
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 c1by1
Definition: chookFlesh.f:367
Here is the call graph for this function:

◆ chookbgrun()

subroutine chookbgrun ( )

Definition at line 11 of file chookFlesh.f.

References cgetfname(), cprintobs(), cprintprim(), cquhookc(), cquhooki(), cwriteparam(), and true.

11  implicit none
12 #include "Zmanagerp.h"
13 #include "Zprivate.h"
14 
15  real*8 temp
16  character*100 msg
17  integer klena
18  integer i
19 ! ==================================================
20 
21  integer seed(2)
22 ! ==================================================
23 
24  eventno = 0
25  realbegin = .true.
26  topofnode = .true.
27 
28 ! namelist output
29  call cwriteparam(errorout, 0)
30 ! primary information
31  call cprintprim(errorout)
32 ! observation level information
33  call cprintobs(errorout)
34 
35  call cquhooki(1, mdev) ! get skeleton memo dev #
36  call cquhooki(6, howflesh) ! how to flesh. non zero-->orthodox
37  call cquhookc(1, msg) ! get file name for sekelton memo
38  call cgetfname(msg, mskel) ! add host name etc if needed
39 
40 ! do i = 1, NoOfSites
41 ! write(*, *) ' depth ',
42 ! * sngl(ObsSites(i).pos.depth/10.)
43 ! enddo
44 
45  open(mdev, file=mskel(1:klena(mskel)), form='unformatted',
46  * status='old' )
47 
subroutine cgetfname(fnin, fn)
Definition: copenf.f:275
subroutine cprintobs(io)
Definition: cprintObs.f:2
nodes i
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 cwriteparam(io, force)
Definition: cwriteParam.f:4
real(4), dimension(:), allocatable, save temp
Definition: cNRLAtmos.f:29
integer function klena(cha)
Definition: klena.f:20
subroutine cquhooki(i, iv)
Definition: cqUHookr.f:15
subroutine cquhookc(i, cv)
Definition: cqUHookr.f:28
Here is the call graph for this function:

◆ chookeint()

subroutine chookeint ( integer  never)

Definition at line 302 of file chookFlesh.f.

302  implicit none
303  integer never ! input & output
304  never = 1

◆ chookenevent()

subroutine chookenevent ( )

Definition at line 211 of file chookFlesh.f.

References cfintracking().

211 
212  implicit none
213 #include "Zprivate.h"
214 #include "Ztrack.h"
215 #include "Ztrackv.h"
216 #include "Zobs.h"
217 #include "Zobsp.h"
218 #include "Zobsv.h"
219 
220  integer i
221 
222  if(realend) then
223  call cfintracking
224 ! real end of 1 event; if you need to do some here is
225 ! the place
226 ! ========================================================
227 
228  if(observeas) then
229 ! electron size in B approx.
230  do i = 1, noofassites
231  write(*, *) asobssites(i).age, asobssites(i).esize
232  enddo
233  endif
234 
235 
236 
237 ! ========================================================
238 !
239  else
240 ! there is still low energy skeleton ptcls
241 ! nothing to do here
242  endif
243 
nodes i
subroutine cfintracking
Definition: cfinTracking.f:2
Here is the call graph for this function:

◆ chookenrun()

subroutine chookenrun ( )

Definition at line 251 of file chookFlesh.f.

References cprintstatus().

251  implicit none
252 #include "Zprivate.h"
253 ! =========================================================
254 
255 ! =========================================================
256  call cprintstatus ! if don't like, comment out
subroutine cprintstatus
Definition: cendRun.f:35
Here is the call graph for this function:

◆ chookgint()

subroutine chookgint ( integer  never)

Definition at line 311 of file chookFlesh.f.

311  implicit none
312  integer never ! input & output
313  never = 1

◆ chooknepint()

subroutine chooknepint ( integer  never)

Definition at line 320 of file chookFlesh.f.

320  implicit none
321  integer never ! input & output
322  never = 1

◆ chookobs()

subroutine chookobs ( type(track aTrack,
integer  id 
)

Definition at line 153 of file chookFlesh.f.

References code, kneue, kneumu, and p.

153 !
154 ! Note that every real variable is in double precision so
155 ! that you may output it in sigle precision to save the memory.
156 ! In some cases it is essential to put it in sigle (say,
157 ! for gnuplot).
158 !
159  implicit none
160 #include "Zcode.h"
161 #include "Ztrack.h"
162 #include "Zprivate.h"
163  integer id ! input. 2 ==> reached at an observation level
164 ! 1 ==> aTrack is going out from
165 ! outer boundery.
166 ! 2 ==> reached at an observation level
167 ! 3 ==> reached at inner boundery.
168  type(track)::atrack
169 !
170 ! For id =2, you need not output the z value, because it is always
171 ! 0 (within the computational accuracy).
172 !
173  if(id .eq. 2 .and. atrack.p.code .ne. kneumu .and.
174  * atrack.p.code .ne. kneue) then
175 
176 ! ===================================================
177 
178  if( atrack.p.code .le. 6 .and. atrack.p.code .ne. 3 ) then
179 ! write(*, 959)
180 ! * aTrack.where,
181 ! * aTrack.p.code,
182 ! * aTrack.p.charge,
183 ! * sngl( aTrack.p.fm.p(4) - aTrack.p.mass ),
184 ! * sngl( aTrack.pos.xyz.r(1) ),
185 ! * sngl( aTrack.pos.xyz.r(2) ) ,
186 ! * sngl( aTrack.vec.w.r(1) ),
187 ! * sngl( aTrack.vec.w.r(2) ),
188 ! * sngl( aTrack.vec.w.r(3) ),
189 ! * sngl( aTrack.vec.coszenith )
190 ! 959 format(3i3,f12.3,2f16.6,4(1x,f12.8))
191  endif
192 
193 ! ===================================================
194 
195 ! write(*,'(4i5, g15.4,g15.3)')
196 ! * aTrack.where, aTrack.p.code, aTrack.p.subcode,
197 ! * aTrack.p.charge, sngl( aTrack.t ),
198 ! * sngl( aTrack.p.fm.p(4) - aTrack.p.mass)
199 ! * sngl( aTrack.pos.xyz.r(1) ), sngl( aTrack.pos.xyz.r(2) ),
200 ! * sngl( aTrack.vec.w.r(1) ), sngl(aTrack.vec.w.r(2) ),
201 ! * sngl(aTrack.vec.w.r(3) ),
202 ! * sngl(aTrack.vec.coszenith)
203 
204  endif
Definition: Ztrack.h:44
max ptcl codes in the kneue
Definition: Zcode.h:2
********************block data cblkHeavy ********************integer j data *HeavyG2symbol p
Definition: cblkHeavy.h:7
*Zfirst p fm *Zfirst p Zfirst p code
Definition: ZavoidUnionMap.h:1
max ptcl codes in the kneumu
Definition: Zcode.h:2

◆ chooktrace()

subroutine chooktrace ( )

Definition at line 267 of file chookFlesh.f.

References height.

267  implicit none
268 
269 #include "Ztrack.h"
270 #include "Ztrackv.h"
271 #include "Ztrackp.h"
272 #include "Zobs.h"
273 #include "Zobsv.h"
274 
275  real*4 h1, h2
276 !
277 ! Every time a particle is moved in the atmosphere, this routine is called,
278 ! if trace > 100
279 ! For a one track segment,
280 ! TrackBefMove has track information at the beginning of the segment.
281 ! MoveTrack has track information at the end of the segment.
282 !
283 ! You can know the information a track contains in the
284 ! chookObs routine. (Note however, no conversion of coordinate
285 ! has been done. The values are in the Earth xyz system.)
286 ! Besides quantities explained there, you can use, for a given 'track'
287 !
288 ! atrack.pos.xyz.x, atrack.pos.xyz.y, atrack.pos.xyz.z (x,y.z)
289 ! atrack.pos.radiallen (distance from the center of the earth)
290 ! atrack.pos.depth (vertical depth)
291 ! atrack.pos.height (vertical heigth from sea level)
292 !
293 
294  h1 = trackbefmove.pos.height- obssites(noofsites).pos.height
295  h2 = movedtrack.pos.height - obssites(noofsites).pos.height
296 
*Zfirst p fm *Zfirst p Zfirst p Zfirst p *Zfirst p *Zfirst pos xyz Zfirst pos xyz *Zfirst pos *Zfirst pos Zfirst pos height
Definition: ZavoidUnionMap.h:1

◆ cmove_c_stack()

subroutine cmove_c_stack ( )

Definition at line 435 of file chookFlesh.f.

References asflag, c, charge, code, colheight, cpush(), cresetdirec(), depth, height, mass, p, r, radiallen, subcode, sys, t, wgt, and xyz.

435  implicit none
436 
437 #include "Zprivate.h"
438 #include "Ztrack.h"
439 #include "Zearth.h"
440 
441  type(track)::atrack
442 !
443 ! a child of the current parent is moved to stack
444 ! as a track info.
445 !
446  atrack.pos.xyz.r(1) = p.posx
447  atrack.pos.xyz.r(2) = p.posy
448  atrack.pos.xyz.r(3) = p.posz
449  atrack.pos.depth = p.depth
450  atrack.pos.height = p.height
451  atrack.pos.colheight = p.colheight
452  atrack.t = p.atime
453 
454  atrack.where = p.where
455 
456  atrack.p.code = c.code
457  atrack.p.subcode = c.subcode
458  atrack.p.charge = c.charge
459  atrack.p.fm.p(1) = c.fm(1)
460  atrack.p.fm.p(2) = c.fm(2)
461  atrack.p.fm.p(3) = c.fm(3)
462  atrack.p.fm.p(4) = c.fm(4)
463  atrack.p.mass = c.mass
464 
465 ! --------------- next must be compute here
466 
467  atrack.pos.radiallen = eradius +atrack.pos.height
468  atrack.pos.xyz.sys = 'xyz'
469  atrack.vec.w.sys = 'xyz'
470  atrack.wgt = 1.0
471  if(p.asflag .ne. 0 .and. howflesh .ne. 0 ) then
472 ! asflag= -1 or -2 may happen
473  atrack.asflag = 1
474  else
475 ! parent is made to be unconceivable, so
476 ! don't put flag for AS generation
477  atrack.asflag = 0
478  endif
479 
480 
481 
482 
483  call cresetdirec( atrack ) ! set vec.w and coszenith
484 
485  call cpush(atrack)
*Zfirst p fm *Zfirst p Zfirst p Zfirst p *Zfirst p *Zfirst pos xyz Zfirst pos xyz *Zfirst pos *Zfirst pos depth
Definition: ZavoidUnionMap.h:1
*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 colheight
Definition: ZavoidUnionMap.h:1
*Zfirst p fm *Zfirst p Zfirst p Zfirst p *Zfirst p *Zfirst pos xyz r
Definition: ZavoidUnionMap.h:1
latitude latitude this system is used *****************************************************************! type coord sequence union map real z z in m endmap xyz map real ! latitude in deg is to the north ! longitude in deg is to the east *h ! height in m endmap llh map real ! polar angle ! azimuthal angle *radius ! radial distance endmap sph endunion character *sys ! which system xyz
Definition: Zcoord.h:25
Definition: Ztrack.h:44
*Zfirst p fm *Zfirst p Zfirst p Zfirst p *Zfirst p *Zfirst pos xyz Zfirst pos xyz sys
Definition: ZavoidUnionMap.h:1
subroutine cresetdirec(aTrack)
Definition: cresetDirec.f:5
********************block data cblkHeavy ********************integer j data *HeavyG2symbol p
Definition: cblkHeavy.h:7
*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 *Zfirst Zfirst Zfirst asflag
Definition: ZavoidUnionMap.h:1
*Zfirst p fm *Zfirst p Zfirst p code
Definition: ZavoidUnionMap.h:1
*Zfirst p fm *Zfirst p Zfirst p Zfirst p *Zfirst p *Zfirst pos xyz Zfirst pos xyz *Zfirst pos *Zfirst pos Zfirst pos height
Definition: ZavoidUnionMap.h:1
*Zfirst p fm *Zfirst p Zfirst p Zfirst p *Zfirst p charge
Definition: ZavoidUnionMap.h:1
nodes t
*Zfirst p fm *Zfirst p mass
Definition: ZavoidUnionMap.h:1
subroutine cpush(a)
Definition: cstack.f:4
*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 *Zfirst wgt
Definition: ZavoidUnionMap.h:1
*Zfirst p fm *Zfirst p Zfirst p Zfirst p subcode
Definition: ZavoidUnionMap.h:1
*Zfirst p fm *Zfirst p Zfirst p Zfirst p *Zfirst p *Zfirst pos xyz Zfirst pos xyz *Zfirst pos radiallen
Definition: ZavoidUnionMap.h:1
dE dx *! Nuc Int sampling table c
Definition: cblkMuInt.h:130
Here is the call graph for this function:

◆ cobshes()

subroutine cobshes ( )

Definition at line 340 of file chookFlesh.f.

References charge, chookobs(), code, coszenith, erg, mass, o, p, r, subcode, t, x, xyz, and y.

340  implicit none
341 #include "Zprivate.h"
342 #include "Ztrack.h"
343 !
344 ! memorized high energy showers at the skeleton making
345 ! time is put into the chookObs as if they are really observed
346  type(track)::atrack
347 
348  integer i
349 
350  do i = 1, np
351  atrack.where = o(i).where
352  atrack.p.code = o(i).code
353  atrack.p.subcode = o(i).subcode
354  atrack.p.charge = o(i).charge
355  atrack.t = o(i).atime
356  atrack.p.fm.p(4) = o(i).erg
357  atrack.p.mass = o(i).mass
358  atrack.pos.xyz.r(1) = o(i).x
359  atrack.pos.xyz.r(2) = o(i).y
360  atrack.vec.w.r(1) = o(i).wx
361  atrack.vec.w.r(2) = o(i).wy
362  atrack.vec.w.r(3) = o(i).wz
363  atrack.vec.coszenith = o(i).zenith
364  call chookobs(atrack, 2)
365  enddo
*Zfirst p fm *Zfirst p Zfirst p Zfirst p *Zfirst p *Zfirst pos xyz r
Definition: ZavoidUnionMap.h:1
nodes i
latitude latitude this system is used *****************************************************************! type coord sequence union map real z z in m endmap xyz map real ! latitude in deg is to the north ! longitude in deg is to the east *h ! height in m endmap llh map real ! polar angle ! azimuthal angle *radius ! radial distance endmap sph endunion character *sys ! which system xyz
Definition: Zcoord.h:25
Definition: Ztrack.h:44
********************block data cblkHeavy ********************integer j data *HeavyG2symbol p
Definition: cblkHeavy.h:7
*Zfirst p fm *Zfirst p Zfirst p code
Definition: ZavoidUnionMap.h:1
struct ob o[NpMax]
Definition: Zprivate.h:34
latitude latitude this system is used *****************************************************************! type coord sequence union map real y
Definition: Zcoord.h:25
*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
float erg[maxp]
Definition: Zprivate.h:7
*Zfirst p fm *Zfirst p Zfirst p Zfirst p *Zfirst p charge
Definition: ZavoidUnionMap.h:1
subroutine chookobs(aTrack, id)
Definition: chook.f:59
nodes t
*Zfirst p fm *Zfirst p mass
Definition: ZavoidUnionMap.h:1
! structure defining a particle at production ! Basic idea of what is to be contained in ! the particle structue is that dynamical ones should be included those derivable from the particle code ! is not included ******************************************************type fmom momentum sequence union map real e endmap map real * x
Definition: Zptcl.h:21
*Zfirst p fm *Zfirst p Zfirst p Zfirst p subcode
Definition: ZavoidUnionMap.h:1
Here is the call graph for this function:

◆ embedas()

subroutine embedas ( )

Definition at line 415 of file chookFlesh.f.

References cobas(), coszenith, depth, erg, height, p, radiallen, and wgt.

415  implicit none
416 #include "Zprivate.h"
417 #include "Ztrack.h"
418 #include "Zearth.h"
419 
420  type(track)::el
421 
422  el.pos.depth = p.depth
423  el.vec.coszenith = p.coszenith
424  el.pos.radiallen = p.height + eradius
425  el.pos.height = p.height
426  el.p.fm.p(4) = p.erg
427  el.wgt = 1.0
428  call cobas(el)
*Zfirst p fm *Zfirst p Zfirst p Zfirst p *Zfirst p *Zfirst pos xyz Zfirst pos xyz *Zfirst pos *Zfirst pos depth
Definition: ZavoidUnionMap.h:1
Definition: Ztrack.h:44
********************block data cblkHeavy ********************integer j data *HeavyG2symbol p
Definition: cblkHeavy.h:7
*Zfirst p fm *Zfirst p Zfirst p Zfirst p *Zfirst p *Zfirst pos xyz Zfirst pos xyz *Zfirst pos *Zfirst pos Zfirst pos height
Definition: ZavoidUnionMap.h:1
*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
float erg[maxp]
Definition: Zprivate.h:7
*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 *Zfirst wgt
Definition: ZavoidUnionMap.h:1
subroutine cobas(el)
Definition: cobAS.f:9
*Zfirst p fm *Zfirst p Zfirst p Zfirst p *Zfirst p *Zfirst pos xyz Zfirst pos xyz *Zfirst pos radiallen
Definition: ZavoidUnionMap.h:1
Here is the call graph for this function: