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

Go to the source code of this file.

Functions/Subroutines

subroutine chookbgrun
 
subroutine chookbgevent
 
subroutine chookobs (aTrack, id)
 
subroutine chookenevent
 
subroutine chookenrun
 
subroutine chooktrace
 
subroutine chookeint (never)
 
subroutine chookgint (never)
 
subroutine chooknepint (never)
 
subroutine cmemonode (dev, flag, neporeg)
 
subroutine cmemorize (from, to)
 
subroutine cputhes (to)
 
subroutine cputnodinfo (from, to)
 

Function/Subroutine Documentation

◆ chookbgevent()

subroutine chookbgevent ( )

Definition at line 110 of file chookSkel.f.

References charge, code, cqincident(), csetemin(), depth, e, kgnuc, p, r, subcode, true, and x.

110  implicit none
111 
112 #include "Ztrack.h"
113 #include "Ztrackv.h"
114 #include "Ztrackp.h"
115 #include "Zobs.h"
116 #include "Zobsp.h"
117 #include "Zobsv.h"
118 #include "Zcode.h"
119 #include "Zprivate.h"
120 
121 
122 
123  type(coord )::angle
124 
125 
126  integer eventno
127  integer i, j
128  integer seed(2)
129  real*8 sveaswait, svethin(2), kepn
130 
131  bgevent = .true.
132  np = 0
133  call cqincident( incident, angle)
134  kepn = incident.p.fm.p(4)
135  if( incident.p.code .eq. kgnuc ) then
136  kepn = kepn/ incident.p.subcode
137  endif
138  ethresh = kepn * waitratio
139 
140  sveaswait = easwait ! for safety save
141  svethin(1) = ethin(1) ! //
142  svethin(2) = ethin(2) ! //
143  call csetemin(generate2, keminobs2, cutneg, cuteg)
144  easwait = sveaswait ! restore
145  ethin(1) = svethin(1)
146  ethin(2) = svethin(2)
147 
148  rewind wdev
149 
150 ! ===================================================
151 
152  eventno = eventno + 1
153  do i = 1, noofsites
154  write(*, 1000)
155  * sngl(obssites(i).pos.depth),
156  * eventno,
157  * incident.p.code,
158  * incident.p.subcode,
159  * incident.p.charge,
160  * incident.p.fm.e,
161  * -angle.r(1),
162  * -angle.r(2),
163  * -angle.r(3)
164  1000 format(f10.3,i9,3i4,e15.5,3(1x,f12.8))
165  enddo
166 
167 
168 ! ===================================================
*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
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
max ptcl codes in the kgnuc
Definition: Zcode.h:2
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 csetemin(gen, eminob, emin, emCas)
Definition: ciniTracking.f:242
********************block data cblkHeavy ********************integer j data *HeavyG2symbol p
Definition: cblkHeavy.h:7
********************block data cblkHeavy ********************integer j data *HeavyG2symbol *data *HeavyG2code kiron data j
Definition: cblkHeavy.h:36
*Zfirst p fm *Zfirst p Zfirst p code
Definition: ZavoidUnionMap.h:1
*Zfirst p fm *Zfirst p Zfirst p Zfirst p *Zfirst p charge
Definition: ZavoidUnionMap.h:1
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
Here is the call graph for this function:

◆ chookbgrun()

subroutine chookbgrun ( )

Definition at line 23 of file chookSkel.f.

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

23  implicit none
24 #include "Zmanagerp.h"
25 #include "Ztrack.h"
26 #include "Zprivate.h"
27 
28  character*10 append
29  character*100 msg
30  logical ex, opn
31  integer klena
32 
33 ! namelist output
34  call cwriteparam(errorout, 0)
35 ! primary information
36  call cprintprim(errorout)
37 ! observation level information
38  call cprintobs(errorout)
39 
40 
41  call cquhooki(1, mdev) ! get skeleton memo dev #
42  call cquhooki(2, wdev) ! get working disk dev #
43 
44 
45  call cquhooki(3, ngmin) ! get Nh min
46  call cquhooki(4, nhmin) ! get Ng min
47  call cquhooki(5, where) ! where to check
48 
49  call cquhookr(1, sumegmin) ! sum E min
50  call cquhookr(2, sumehmin)
51 
52 
53 
54  call cquhookc(1, msg) ! get file name for sekelton memo
55  call cgetfname(msg, mskel) ! add host name etc if needed
56  call cquhookc(2, msg) ! get file name for working
57  call cgetfname(msg, wskel) ! add host name etc if neededn
58  call cquhookc(3, append) ! append data, if Mskel already exists
59 
60  write(msg, *) 'Skeleton is judged at obs.pos=', Where
61  call cerrormsg(msg, 1)
62  write(msg, *) ' Ngmin=',ngmin,
63  * ' SumEGmin=',sumegmin/1000.,'TeV'
64  call cerrormsg(msg, 1)
65  write(msg, *) ' Nhmin=',nhmin,
66  * ' SumEHmin=',sumehmin/1000.,'TeV'
67  call cerrormsg(msg, 1)
68 
69 !
70  inquire(file=mskel(1:klena(mskel)), opened=opn, exist=ex)
71  if(opn) then
72  call cerrormsg(mskel, 1)
73  call cerrormsg(' already opened: starange', 0)
74  elseif(ex .and.
75  * append(1:klena(append)) .eq. 'append' ) then
76  open(mdev, file=mskel, form='unformatted',status='old')
77  call cerrormsg('skeleton node info. will be appended', 1)
78 ! skip to the end of file
79  do while( .true. )
80  read(mdev, end=100)
81  enddo
82  else
83  if(ex .and.
84  * append(1:klena(append)) .ne. 'append' ) then
85  call cerrormsg(
86  * 'Old skeleton node info. file exists', 1)
87  call cerrormsg(
88  * 'but node info. will NOT be appended', 1)
89  endif
90  open(mdev, file=mskel(1:klena(mskel)), form='unformatted',
91  * status='unknown')
92  endif
93 
94  100 continue
95 
96  open(wdev, file=wskel(1:klena(wskel)), form='unformatted',
97  * status='unknown' )
98 
99  accepted = 0 ! counter; accepted as skeleton
100 !
subroutine cgetfname(fnin, fn)
Definition: copenf.f:275
subroutine cerrormsg(msg, needrtn)
Definition: cerrorMsg.f:4
subroutine cprintobs(io)
Definition: cprintObs.f:2
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
subroutine cquhookr(i, rv)
Definition: cqUHookr.f:2
integer function klena(cha)
Definition: klena.f:20
subroutine cquhooki(i, iv)
Definition: cqUHookr.f:15
*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 where
Definition: ZavoidUnionMap.h:1
subroutine cquhookc(i, cv)
Definition: cqUHookr.f:28
Here is the call graph for this function:

◆ chookeint()

subroutine chookeint ( integer  never)

Definition at line 389 of file chookSkel.f.

References asflag, cmemonode(), code, kelec, and p.

389  implicit none
390 
391 #include "Ztrack.h"
392 #include "Ztrackv.h"
393 #include "Zcode.h"
394 #include "Zprivate.h"
395 ! #include "Ztrackp.h"
396  integer never ! input & output
397  integer nlow
398 !
399 ! If Job = 'newskel', input "never" may be < 0, and MovedTrack
400 ! may not be an electron.
401 ! never = -1 : MovedTrack K.E becomes < KEminObs due to
402 ! energy loss during traveling.
403 ! never = -2 : The same as above, but the particle crosses an
404 ! observation depth, so the calling point to this
405 ! routine is different from the never = -1 case.
406 ! never = -3 : K.E >= KEminiObs. The ptcl is observed at the
407 ! current deepest Obs. level. but at the flesh time
408 ! the deepest level will be more deep so that
409 ! this must be memorized.
410 !
411 ! For above cases, the product is only MovedTrack and
412 ! no particle is in PWork.
413 ! Otherwise,
414 ! MovedTrack is the electron that made interaction
415 ! Pwork contains produced particles (normally gamma, but mayb e).
416 ! Nproduced has the number of particles in Pwork (normally 1)
417 ! IntInfArray(ProcessNo) contains the type of interaction
418 ! IntInfArray(ProcessNo).process will have one of
419 ! 'brems', 'mscat', 'bscat' 'anihi' or 'mbrem'
420 !
421  if(never .lt. 0) then
422  nproduced = 1
423 ! IBM user must modify next
424  pwork(1) = movedtrack.p
425  endif
426 
427 ! high energy parent at node might be used
428 ! for hybrid AS generation if it is in some
429 ! energy region.
430  if( movedtrack.p.code .eq. kelec ) then
431  if( movedtrack.asflag .eq. 0 ) then
432  if( movedtrack.p.fm.p(4) .lt. ethresh ) then
433  movedtrack.asflag = -1
434  endif
435  endif
436  endif
437 
438  call cmemonode(wdev, never, 2)
439  if(movedtrack.asflag .eq. -1) then
440 ! decendent should not be used to generae A.S
441  movedtrack.asflag = -2
442  endif
443 
444  10 continue
445  never = 0
max ptcl codes in the kelec
Definition: Zcode.h:2
********************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
subroutine cmemonode(dev, flag)
Definition: chookSkel.f:467
Here is the call graph for this function:

◆ chookenevent()

subroutine chookenevent ( )

Definition at line 265 of file chookSkel.f.

References cmemorize(), code, cwriteseed(), erg, kelec, kgnuc, knuc, kpion, o, p, and where.

265 
266  implicit none
267 #include "Ztrack.h"
268 #include "Zcode.h"
269 #include "Ztrackv.h"
270 #include "Zobs.h"
271 #include "Zobsp.h"
272 #include "Zobsv.h"
273 #include "Zmanagerp.h"
274 #include "Zprivate.h"
275 
276  integer i
277  integer seed(2)
278  real sumeg, sumeh
279  logical memorize
280 
281  integer ng, nh
282 
283  ng = 0
284  nh = 0
285 
286  sumeg = 0
287  sumeh =0
288 ! count sum Eg etc
289  do i = 1, np
290  if(o(i).where .eq. where) then
291  if(o(i).code .le. kelec) then
292  ng = ng + 1
293  sumeg = sumeg + o(i).erg
294  elseif( ( o(i).code .ge. kpion .and.
295  * o(i).code .le. knuc )
296  * .or.
297  * o(i).code .eq. kgnuc) then
298  nh = nh + 1
299  sumeh = sumeh + o(i).erg
300  endif
301  endif
302  enddo
303 
304 ! ===================================================
305  memorize =(ng .ge. ngmin .and. sumeg .ge. sumegmin) .or.
306  * ( nh .ge. nhmin .and. sumeh .ge. sumehmin)
307 
308 !/////
309  write(0,*) ' memo=', memorize,
310  * ' ng=',ng, ' seg=',sumeg, ' nh=',nh,' seh=',sumeh
311 !//////
312 
313 
314 ! ===================================================
315  if(memorize) then
316  accepted = accepted + 1
317  call cwriteseed ! SeedFile
318 ! flag for end of 1 event on working disk
319  write(wdev) -1, p
320  call cmemorize(wdev, mdev) ! reocord this event
321  endif
others if is ng
Definition: cblkManager.h:9
nodes i
max ptcl codes in the kgnuc
Definition: Zcode.h:2
subroutine cmemorize(from, to)
Definition: chookSkel.f:599
max ptcl codes in the kelec
Definition: Zcode.h:2
********************block data cblkHeavy ********************integer j data *HeavyG2symbol p
Definition: cblkHeavy.h:7
subroutine cwriteseed
Definition: cwriteSeed.f:15
*Zfirst p fm *Zfirst p Zfirst p code
Definition: ZavoidUnionMap.h:1
********************block data cblkHeavy ********************integer j data *HeavyG2symbol *data *HeavyG2code knuc
Definition: cblkHeavy.h:7
struct ob o[NpMax]
Definition: Zprivate.h:34
float erg[maxp]
Definition: Zprivate.h:7
int nh[nl][nth]
Definition: Zprivate.h:13
*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 where
Definition: ZavoidUnionMap.h:1
max ptcl codes in the kpion
Definition: Zcode.h:2
Here is the call graph for this function:

◆ chookenrun()

subroutine chookenrun ( )

Definition at line 329 of file chookSkel.f.

References cerrormsg(), and cprintstatus().

329  implicit none
330 #include "Ztrack.h"
331 #include "Zprivate.h"
332  character*100 msg
333 ! =========================================
334 
335 
336 ! =========================================
337  call cerrormsg('++++++++++++', 1)
338  write(msg, '(i8, a)') accepted,
339  * ' events are memorized as skeleton'
340  call cerrormsg(msg, 1)
341  call cerrormsg('their seeds are also memorized', 1)
342  call cerrormsg('-----------',1)
343  call cprintstatus ! if don't like, comment out
subroutine cerrormsg(msg, needrtn)
Definition: cerrorMsg.f:4
subroutine cprintstatus
Definition: cendRun.f:35
Here is the call graph for this function:

◆ chookgint()

subroutine chookgint ( integer  never)

Definition at line 452 of file chookSkel.f.

References cmemonode().

452  implicit none
453 
454 #include "Ztrack.h"
455 #include "Ztrackv.h"
456 #include "Zprivate.h"
457 ! #include "Ztrackp.h"
458 
459  integer never ! input & output
460 
461 ! don't make never = 1, if you want to get
462 ! information after a gamma ray made interaction
463 ! if this is made non zero, this routine will never be called.
464 !
465 ! MovedTrack is the gamma that made interaction
466 ! Pwork contains produced particles.
467 ! Nproduced has the number of particles in Pwork
468 ! IntInfArray(ProcessNo) contains the type of interaction
469 ! IntInfArray(ProcessNo).process will have one of
470 ! 'pair', 'comp', 'photoe' 'photop' 'mpair'
471  call cmemonode(wdev, 1, 1)
472  never = 0
subroutine cmemonode(dev, flag)
Definition: chookSkel.f:467
Here is the call graph for this function:

◆ chooknepint()

subroutine chooknepint ( integer  never)

Definition at line 479 of file chookSkel.f.

References cbst1(), cgeqm(), cgetcurrentstackpos(), cirot3vec(), cmemonode(), cmkptc(), code, cyeta(), false, mass, p, process(), and setpcode().

479  implicit none
480 #include "Zmaxdef.h"
481 #include "Zcode.h"
482 #include "Ztrack.h"
483 #include "Ztrackv.h"
484 #include "Ztrackp.h"
485 #include "Zstackv.h"
486 #include "Zprivate.h"
487 
488  integer never ! input & output
489 
490  type(coord):: angle
491  type(ptcl):: aptcl
492  type(ptcl):: tgt, pj
493  real*8 user
494  real*4 usere(2)
495  integer*2 useri(4)
496  equivalence(user, usere(1)), (user, useri(1))
497  real*8 y, eta
498  integer i, icon, codex
499  integer stackpos
500  save
501 
502  if(bgevent) then
503  user=movedtrack.user
504  useri(2) = 0
505  usere(2) = 0.
506  movedtrack.user = user
507  bgevent = .false.
508  endif
509 
510  proc = intinfarray(processno).process
511 
512  incip = movedtrack.p
513  if(proc .eq. "coll") then
514  call cmkptc(6, 0, 1, tgt)
515  tgt.fm.p(1) = 0.
516  tgt.fm.p(2) = 0.
517  tgt.fm.p(3) = 0.
518  tgt.fm.p(4) = tgt.mass
519  pj = incip
520  pjcm = pj
521  call cirot3vec(1, incip, incip, pj)
522  call cgeqm(pj, tgt, cmsptcl, icon)
523  call cbst1(1, cmsptcl, pj, pjcm)
524  endif
525 
526  call cgetcurrentstackpos(stackpos)
527  do i = stackpos-nstacked+1, stackpos
528  user = stack(i).user
529  if(proc .eq. "coll") then
530  aptcl=stack(i).p
531  call cirot3vec(1, incip, aptcl, aptcl)
532  call cbst1(1, cmsptcl, aptcl, aptcl)
533 ! y, eta
534  call cyeta(aptcl, y, eta)
535  useri(2)=useri(2)+1
536  useri(1)=eta*1000.
537 ! xcm; if anti-proton or anti-neutron
538 ! it may be stopped one
539  if(pjcm.fm.p(3) .eq. 0.) then
540  usere(2)= aptcl.fm.p(3)/(cmsptcl.mass/2.)
541  else
542  usere(2)= aptcl.fm.p(3)/pjcm.fm.p(3)
543  endif
544  stack(i).user=user
545  elseif( proc .eq. "decay" .and.
546  * ( incip.code .eq. 4 .or. incip.code .eq. 5)) then
547  call setpcode(incip, usere(2))
548  stack(i).user=user
549  endif
550  enddo
551 ! don't make never = 1, if you want to get
552 ! information after a non-e-g particle made interaction
553 ! if this is made non zero, this routine will never be called.
554 !
555 ! MovedTrack is the particle that made interaction
556 ! Pwork contains produced particles.
557 ! Nproduced has the number of particles in Pwork
558 ! IntInfArray(ProcessNo) contains the type of interaction
559 !
560  if( proc .eq. "coll" ) then
561  call cmemonode(wdev, 1, 4)
562  else
563  call cmemonode(wdev, 1, 3)
564  endif
565 
subroutine cbst1(init, p1, p2, po)
Definition: cbst1.f:54
nodes i
! parameters for Elemag process(-> ---------------------------------------------- real *8 RecoilKineMinE !2 Recoil Kinetic Min Energy above which the recoil(=knock-on process) ! is treated. Below this energy, the effect is included as continuous ! energy loss. Used only if KnockOnRatio $>$ 1. ! If this is 0 or if KnockOnRatio=1, KEminObs(gamma)=KEminObs(elec) is used. ! See also KnockOnRatio. real *8 KnockOnRatio !2 KnockOnRatio *KEminoObs is used instead of RecoilKineMinE if KnockOnRatio $< $1. real *8 X0 !2 Radiation length in kg/m$^2$ for air. Normally the user should not touch this. real *8 Ecrit !2 Critical energy in GeV. \newline ! Employed only when calculating air shower size in the hybrid ! air shower generation. The value would be dependent on the ! experimental purpose. The default value, 81 MeV, is bit too ! small in many applications(The air shower size is overestimated). ! Comparisons of sizes by the hybrid method and by the full Monte ! Carlo tell that \newline ! $N_e$(full 3-D M.C) $< N_e$(hybrid AS with $E_c=81$ MeV) $< N_e$(full 1-D M.C) ! $ {\ \lower-1.2pt\vbox{\hbox{\rlap{$<$}\lower5pt\vbox{\hbox{$\sim$}}}}\ } ! N_e$(hybrid AS with $E_c={76}$ MeV) at around shower maximum. ! Hybrid AS is always essentially 1-D. logical Knockon !2 Obsolete. Don 't use this. See RecoilKineMinE ! and KnockonRatio. real *8 AnihiE !2 If E(positron) $<$ AnihiE, annihilation is considered. real *8 Es !2 Modified scattering constant. 19.3d-3 GeV real *8 MaxComptonE !2 Above this energy, Compton scattering is neglected. real *8 MaxPhotoE !2 Above this energy, photoelectric effect is neglected. real *8 MinPhotoProdE !1 Below this energy, no photo-prod of hadron. See also PhotoProd. logical PhotoProd !1 Switch. if .false., no photo prod. of hadron is considered at all. ! See also MinPhotoProdE, HowPhotoP real *8 Excom1 !2(GeV). If photon energy is<=Excom1, use XCOM data for ! compton/p.e/coherent scattering(must be< 100 GeV). real *8 Excom2 !2(GeV). If photon energy is<=Excom2, use XCOM data for ! pair creation cross-section.(must be< 100 GeV). integer Moliere !2 2$\rightarrow$ use Moliere scat.\newline ! 0$\rightarrow$ use Gaussian scattrign. \newline ! 1$\rightarrow$ use Moli\`ere scattering for non-electrons \newline ! 2$\rightarrow$ use Moli\`ere scattering for all charged ! particles. But treatment is not so rigorous as case of 3. ! \newline ! 3$\rightarrow$ use rigorus Moliere scattering. Diff. from 2 is verysmall. May be some effect in the ! core region. integer ALateCor !2 1$\rightarrow$ angular and lateral correlation is taken into account when Moliere=0 .\newline ! t$\rightarrow$ Use angular-lateral correlation by Gaussian ! approximation. No effect is seen if path length is short. !<-) ---------------------------------------------- common/Zelemagc/RecoilKineMinE
subroutine setpcode(p, code)
Definition: setpcode.f:2
subroutine cgeqm(p1, p2, q, icon)
Definition: cgeqm.f:2
subroutine cirot3vec(init, p1, p2, po)
Definition: crot3vec.f:97
********************block data cblkHeavy ********************integer j data *HeavyG2symbol p
Definition: cblkHeavy.h:7
logical, save user
Definition: cEfield0.f:32
*Zfirst p fm *Zfirst p Zfirst p code
Definition: ZavoidUnionMap.h:1
subroutine cmemonode(dev, flag)
Definition: chookSkel.f:467
latitude latitude this system is used *****************************************************************! type coord sequence union map real y
Definition: Zcoord.h:25
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
Definition: Zptcl.h:75
Definition: Zcoord.h:43
*Zfirst p fm *Zfirst p mass
Definition: ZavoidUnionMap.h:1
subroutine cyeta(p, y, eta)
Definition: cyeta.f:5
subroutine cgetcurrentstackpos(stackpos)
Definition: cstack.f:84
Here is the call graph for this function:

◆ chookobs()

subroutine chookobs ( type(track aTrack,
integer  id 
)

Definition at line 177 of file chookSkel.f.

References cerrormsg(), charge, code, coszenith, erg, getpcode(), kneue, kneumu, mass, ng, nth, o, p, r, subcode, t, x, xyz, and y.

177 !
178 ! Note that every real variable is in double precision so
179 ! that you may output it in sigle precision to save the memory.
180 ! In some cases it is essential to put it in sigle (say,
181 ! for gnuplot).
182 !
183  implicit none
184 #include "Zcode.h"
185 #include "Ztrack.h"
186 #include "Zprivate.h"
187  integer id ! input. 2 ==> reached at an observation level
188 ! 1 ==> aTrack is going out from
189 ! outer boundery.
190 ! 2 ==> reached at an observation level
191 ! 3 ==> reached at inner boundery.
192  type(track):: atrack
193 !
194 ! For id =2, you need not output the z value, because it is always
195 ! 0 (within the computational accuracy).
196 !
197 ! ===================================================
198  common /testcos/sumg, ng(20), nth, eventno
199  real*8 sumg
200  integer ng, nth, eventno
201 
202 ! ===================================================
203  real*8 user
204  real*4 usere(2)
205  integer*2 useri(4)
206  equivalence(user, usere(1)), (user, useri(1))
207 
208  integer codex
209  logical kbitest
210  save
211 
212  if( id .eq. 2 .and. atrack.p.code .ne. kneumu .and.
213  * atrack.p.code .ne. kneue) then
214  np = np + 1
215  if( np .gt. npmax) then
216  call cerrormsg(
217  * '# of particles >NpMax in observation', 0)
218  endif
219  o(np).where = atrack.where
220  o(np).code = atrack.p.code
221  o(np).subcode = atrack.p.subcode
222  o(np).charge = atrack.p.charge
223  o(np).atime = atrack.t
224  o(np).erg = atrack.p.fm.p(4)
225  o(np).mass = atrack.p.mass
226  o(np).x = atrack.pos.xyz.r(1)
227  o(np).y = atrack.pos.xyz.r(2)
228  o(np).wx = atrack.vec.w.r(1)
229  o(np).wy = atrack.vec.w.r(2)
230  o(np).wz = atrack.vec.w.r(3)
231  o(np).zenith = atrack.vec.coszenith
232  o(np).user = atrack.user
233 ! ===================================================
234 ! if( o(Np).code .le. 6 .and. o(Np).code .ne. 3 ) then
235  if(o(np).code .eq. 3) then
236  user=atrack.user
237  call getpcode(usere(2), codex)
238  write(*, 959)
239 ! * o(Np).where,
240 ! * o(Np).code,
241 ! * o(Np).charge,
242  * ( o(np).erg - o(np).mass ),
243 ! * ( o(Np).x ), ( o(Np).y ) ,
244 ! * ( o(Np).wx ),
245 ! * ( o(Np).wy ),
246 ! * ( o(Np).wz ),
247 ! * ( o(Np).zenith ),
248  * useri(1)/1000., useri(2), usere(2), codex
249 
250 ! 959 format(3i3, g14.3,2f16.6,4(1x,f12.8), i3, 1pE11.3)
251  959 format(2g14.3,i7, e11.3, i3)
252  endif
253 
254 ! ===================================================
255  endif
256 ! ===================================================
257 
258 ! ===================================================
subroutine cerrormsg(msg, needrtn)
Definition: cerrorMsg.f:4
others if is ng
Definition: cblkManager.h:9
*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
max ptcl codes in the kneue
Definition: Zcode.h:2
!onst int nth
Definition: Zprivate.h:2
********************block data cblkHeavy ********************integer j data *HeavyG2symbol p
Definition: cblkHeavy.h:7
logical, save user
Definition: cEfield0.f:32
*Zfirst p fm *Zfirst p Zfirst p code
Definition: ZavoidUnionMap.h:1
subroutine getpcode(code, codex)
Definition: setpcode.f:30
struct ob o[NpMax]
Definition: Zprivate.h:34
max ptcl codes in the kneumu
Definition: Zcode.h:2
latitude latitude this system is used *****************************************************************! type coord sequence union map real y
Definition: Zcoord.h:25
logical function kbitest(i, bit)
Definition: kmanbit.f:13
*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
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:

◆ chooktrace()

subroutine chooktrace ( )

Definition at line 354 of file chookSkel.f.

References height.

354  implicit none
355 
356 #include "Ztrack.h"
357 #include "Ztrackv.h"
358 #include "Ztrackp.h"
359 #include "Zobs.h"
360 #include "Zobsv.h"
361 
362  real*4 h1, h2
363 !
364 ! Every time a particle is moved in the atmosphere, this routine is called,
365 ! if trace > 100
366 ! For a one track segment,
367 ! TrackBefMove has track information at the beginning of the segment.
368 ! MoveTrack has track information at the end of the segment.
369 !
370 ! You can know the information a track contains in the
371 ! chookObs routine. (Note however, no conversion of coordinate
372 ! has been done. The values are in the Earth xyz system.)
373 ! Besides quantities explained there, you can use, for a given 'track'
374 !
375 ! atrack.pos.xyz.x, atrack.pos.xyz.y, atrack.pos.xyz.z (x,y.z)
376 ! atrack.pos.radiallen (distance from the center of the earth)
377 ! atrack.pos.depth (vertical depth)
378 ! atrack.pos.height (vertical heigth from sea level)
379 !
380 
381  h1 = trackbefmove.pos.height- obssites(noofsites).pos.height
382  h2 = movedtrack.pos.height - obssites(noofsites).pos.height
383 
*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

◆ cmemonode()

subroutine cmemonode ( integer  dev,
integer  flag,
integer  neporeg 
)

Definition at line 568 of file chookSkel.f.

References asflag, c, cbst1(), charge, cirot3vec(), code, colheight, coszenith, cyeta(), depth, erg, height, kelec, mass, p, r, setpcode(), subcode, t, and xyz.

568  implicit none
569 #include "Zcode.h"
570 #include "Ztrack.h"
571 #include "Ztrackv.h"
572 #include "Ztrackp.h"
573 #include "Zprivate.h"
574 !
575  integer dev ! input. fortran logical dev. number for data write
576  integer flag ! input. If this is -3, high energy particles must
577  ! also be memorized.
578  integer neporeg ! input 1; from g 2 from e; 3 from NEP
579 !
580 !
581 ! memorize nodal information at interaction.
582 !
583 ! \
584 ! \ projectile = MovedTrack
585 ! /|\ produced particles.: Pwork(i), i=1~Nproduced
586 ! / | \
587 !
588 ! From projectile, the track information is extracted
589 ! From produced particles, only those of K.E< KEminObs is
590 ! extracted and information needed for further tracking is
591 ! obtaned and memorized. The position information is common
592 ! to all the children.
593 !
594 ! Track information; pos =
595 ! xyz = r(1~3), sys
596 ! radiallen, depth, height, colheight
597 ! t
598 ! vec =
599 ! w = r(1~3), sys
600 ! coszenith
601 ! wgt
602 ! where
603 ! asflag
604 !
605 ! Among these, we don't memorize
606 ! sys which is always 'xyz'
607 ! radiallen: can be computed from height
608 ! vec; children knows their direction
609 ! wgt: normally not needed, it should be 1 for skeleton making
610 ! So thinsamping must not be used when making skeleton.
611 ! asflag: should be always F, (assume for skeleton making, hybrid
612 ! air shower is not requested)
613 !
614 ! write track info. of projectile
615 !
616  integer i, nlow
617  real*8 ke
618  real*8 y, eta
619  real*8 user
620  real*4 usere(2)
621  integer*2 useri(4)
622  equivalence(user, usere(1)), (user, useri(1))
623  type(ptcl):: aptcl
624  integer codex
625  save
626 
627 !
628 !
629  nlow = 0
630  do i = 1, nproduced
631  ke = pwork(i).fm.p(4) - pwork(i).mass
632  if( ( pwork(i).code .le. kelec .and.
633  * ke .ge. cuteg ) .or.
634  * ( pwork(i).code .gt. kelec .and.
635  * ke .ge. cutneg ) ) then
636 ! count low energy ptcls
637  if(flag .ne. -3) then
638  if( ke .lt. keminobs) then
639  nlow = nlow + 1
640  endif
641  else
642 ! all ptcl must be memorized
643  nlow = nlow + 1
644  endif
645  endif
646  enddo
647 ! next is harmful for B-approx air shower
648 ! because, parent is not memorized and cannot
649 ! generate AS at flesh time at proper positon
650 ! asflag == -1 must apear in flesh
651 ! if(nlow .eq. 0 ) return ! *************
652 ! if there is no return here, the size of skeleton data
653 ! becomes 3.2 times larger
654 
655  if(nlow .eq. 0 .and. movedtrack.asflag .ne. -1) return
656 
657 
658  p.posx = movedtrack.pos.xyz.r(1)
659  p.posy = movedtrack.pos.xyz.r(2)
660  p.posz = movedtrack.pos.xyz.r(3)
661  p.depth = movedtrack.pos.depth
662  p.height = movedtrack.pos.height
663  if( movedtrack.pos.colheight .gt. 1.e36) then
664  p.colheight = 1.e36 ! no col. yet.
665  else
666  p.colheight = movedtrack.pos.colheight
667  endif
668  p.atime = movedtrack.t
669  p.where = movedtrack.where
670  p.coszenith = movedtrack.vec.coszenith
671  p.code = movedtrack.p.code
672  p.erg = movedtrack.p.fm.p(4)
673  p.asflag = movedtrack.asflag
674  p.user = movedtrack.user
675 
676 !c
677 !c * p.posx, p.posy, p.posz, p.depth, p.height,
678 !c * p.colHeight, p.atime, p.where
679 !c
680 ! write particle info
681 ! p(1~4)
682 ! mass
683 ! code
684 ! subcode
685 ! charge
686 !
687 
688 
689  write(dev) nlow, p
690 
691  do i = 1, nproduced
692  ke = pwork(i).fm.p(4) - pwork(i).mass
693  if( ( pwork(i).code .le. kelec .and.
694  * ke .ge. cuteg ) .or.
695  * ( pwork(i).code .gt. kelec .and.
696  * ke .ge. cutneg ) ) then
697  if(flag .eq. -3 .or. ke .lt. keminobs) then
698  c.code = pwork(i).code
699  c.subcode = pwork(i).subcode
700  c.charge = pwork(i).charge
701  c.fm(1) = pwork(i).fm.p(1)
702  c.fm(2) = pwork(i).fm.p(2)
703  c.fm(3) = pwork(i).fm.p(3)
704  c.fm(4) = pwork(i).fm.p(4)
705  c.mass = pwork(i).mass
706  if(neporeg .eq. 4 ) then
707  aptcl = pwork(i)
708  call cirot3vec(1, incip, aptcl, aptcl)
709  call cbst1(1, cmsptcl, aptcl, aptcl)
710  call cyeta(aptcl, y, eta)
711  user=movedtrack.user
712  useri(1)=eta*1000.
713  useri(2) = useri(2) + 1
714 ! xcm
715  if( pjcm.fm.p(3) .eq. 0.) then
716  usere(2)= aptcl.fm.p(3)/(cmsptcl.mass/2.)
717  else
718  usere(2)= aptcl.fm.p(3)/pjcm.fm.p(3)
719  endif
720  c.user = user
721  elseif( proc .eq. "decay" .and.
722  * incip.code .eq. 4 .or. incip.code .eq. 5) then
723 ! set parent ptcl code by using last bit
724  user=movedtrack.user
725  call setpcode( incip, usere(2) )
726  c.user = user
727 !////////////////////
728 ! if(userE(2) .gt. -1. .and.
729 ! * Pwork(i).code .le. 5) then
730 ! write(*,'(a,3i3, 4g11.3)')
731 ! * 'l: ', Pwork(i).code, Pwork(i).subcode,
732 ! * Pwork(i).charge,
733 ! * eta, y, userE(2), Pwork(i).fm.p(4)
734 ! endif
735 !/////////////////
736  else
737  c.user = p.user
738  endif
739  write(dev) c
740  endif
741  endif
742  enddo
*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
subroutine cbst1(init, p1, p2, po)
Definition: cbst1.f:54
*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
nodes i
subroutine setpcode(p, code)
Definition: setpcode.f:2
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
max ptcl codes in the kelec
Definition: Zcode.h:2
subroutine cirot3vec(init, p1, p2, po)
Definition: crot3vec.f:97
********************block data cblkHeavy ********************integer j data *HeavyG2symbol p
Definition: cblkHeavy.h:7
logical, save user
Definition: cEfield0.f:32
*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
integer maxn LabEquivE real * ke(maxn) integer indx(maxn) integer nevent integer outzero
*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
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
nodes t
Definition: Zptcl.h:75
*Zfirst p fm *Zfirst p mass
Definition: ZavoidUnionMap.h:1
subroutine cyeta(p, y, eta)
Definition: cyeta.f:5
*Zfirst p fm *Zfirst p Zfirst p Zfirst p subcode
Definition: ZavoidUnionMap.h:1
dE dx *! Nuc Int sampling table c
Definition: cblkMuInt.h:130
Here is the call graph for this function:

◆ cmemorize()

subroutine cmemorize ( integer  from,
integer  to 
)

Definition at line 747 of file chookSkel.f.

References cputhes(), cputnodinfo(), cqeventno(), cqinirn(), depth, and height.

747  implicit none
748 #include "Ztrack.h"
749 #include "Ztrackv.h"
750 
751  integer from ! working disk file
752  integer to ! permanent disk file where skeleton is sotered
753 
754 
755 
756 
757  integer num, cumnum, irevent(2)
758 ! type(track):: incident
759 ! type(coord):: angle
760 
761 
762  rewind from
763 ! need not memorize, can be generated at flesh
764 ! call cqIncident(incident, angle)
765 
766  call cqeventno(num, cumnum)
767 
768  call cqinirn(irevent) ! seed of the event
769 
770  write(to) cumnum, num, irevent, zfirst
771  call cputhes(to) ! put high energy showers.
772  write(0,*) ' first Z=',zfirst.pos.depth*0.1, ' g/cm2',
773  * zfirst.pos.height, ' m'
774 
775  call cputnodinfo(from, to) ! put nordal info.
776 
*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
subroutine cputhes(to)
Definition: chookSkel.f:630
subroutine cputnodinfo(from, to)
Definition: chookSkel.f:647
real(8), dimension(:,:,:,:), allocatable, save num
Definition: chook.f:40
integer maxbin nregion c minsave drx2 ! drawing region real maxdep integer maxpos integer to
Definition: Zfit.h:15
*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
subroutine cqeventno(num, cumnum)
Definition: cqEventNo.f:3
subroutine cqinirn(ir)
Definition: cwriteSeed.f:4
integer maxbin nregion c minsave drx2 ! drawing region real maxdep integer maxpos integer from
Definition: Zfit.h:15
Here is the call graph for this function:

◆ cputhes()

subroutine cputhes ( integer  to)

Definition at line 780 of file chookSkel.f.

References o.

780  implicit none
781 #include "Ztrack.h"
782 #include "Zprivate.h"
783  integer to
784 !
785 ! write high energy sekeleton data into 'to'
786 !
787  integer i
788 
789  write(to) np
790 
791  do i = 1, np
792  write(to) o(i)
793  enddo
794 
nodes i
integer maxbin nregion c minsave drx2 ! drawing region real maxdep integer maxpos integer to
Definition: Zfit.h:15
struct ob o[NpMax]
Definition: Zprivate.h:34

◆ cputnodinfo()

subroutine cputnodinfo ( integer  from,
integer  to 
)

Definition at line 798 of file chookSkel.f.

References c, and p.

798  implicit none
799 #include "Ztrack.h"
800 #include "Zprivate.h"
801 
802  integer from, to
803 
804  integer i, nlow
805 
806  nlow = 1
807  do while ( nlow .ge. 0 )
808  read(from) nlow, p
809  write(to) nlow, p
810  do i = 1, nlow
811  read(from) c
812  write(to) c
813  enddo
814  enddo
815 
nodes i
********************block data cblkHeavy ********************integer j data *HeavyG2symbol p
Definition: cblkHeavy.h:7
integer maxbin nregion c minsave drx2 ! drawing region real maxdep integer maxpos integer to
Definition: Zfit.h:15
integer maxbin nregion c minsave drx2 ! drawing region real maxdep integer maxpos integer from
Definition: Zfit.h:15
dE dx *! Nuc Int sampling table c
Definition: cblkMuInt.h:130