COSMOS v7.655  COSMOSv7655
(AirShowerMC)
chookFlesh.f
Go to the documentation of this file.
1 #include "cmain.f"
2 #include "chookHybAS.f"
3 #include "ctemplCeren.f"
4 !
5 ! *************************************** hook for Beginning of a Run
6 ! * At this moment, all (system-level) initialization for this run
7 ! * has been ended. After this routine is executed, the system goes into the
8 ! * event creation loop.
9 ! *
10  subroutine chookbgrun
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 
48  end
49 
50 ! *********************************** hook for Beginning of 1 event
51 ! * All system-level initialization for 1 event generation has been
52 ! * eneded at this moment.
53 ! * After this is executed, event generation starts.
54 ! *
55  subroutine chookbgevent
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 
72  end
73  subroutine cbegin1ev(nomore)
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
146  end
147 
148 ! ************************************ hook for observation
149 ! * One particel information is brought here by the system.
150 ! * All information of the particle is in aTrack
151 ! *
152  subroutine chookobs(aTrack, id)
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
205  end
206 
207 ! *********************************** hook for end of 1 event
208 ! * At this moment, 1 event generation has been ended.
209 ! *
210  subroutine chookenevent
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 
244  end
245 
246 
247 ! ********************************* hook for end of a run
248 ! * all events have been created or time lacks
249 ! *
250  subroutine chookenrun
251  implicit none
252 #include "Zprivate.h"
253 ! =========================================================
254 
255 ! =========================================================
256  call cprintstatus ! if don't like, comment out
257  end
258 ! ********************************* hook for trace
259 ! * This is called only when trace > 100
260 ! * User should manage the trace information here.
261 ! * If you use this, you may need some output for trace
262 ! * at the beginning of 1 event generatio and at the end of 1 event
263 ! * generation so that you can identfy each event.
264 ! *
265 ! *
266  subroutine chooktrace
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 
297  end
298 ! ********************* this is the hook called when
299 ! an electron made an interaction.
300 !
301  subroutine chookeint(never)
302  implicit none
303  integer never ! input & output
304  never = 1
305  end
306 
307 ! ********************* this is the hook called when
308 ! a gamma ray made an interaction.
309 !
310  subroutine chookgint(never)
311  implicit none
312  integer never ! input & output
313  never = 1
314  end
315 
316 ! ********************* this is the hook called when
317 ! non e-g particle made an interaction.
318 !
319  subroutine chooknepint(never)
320  implicit none
321  integer never ! input & output
322  never = 1
323  end
324 
325 
326  subroutine cgethes(from)
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
337  end
338 
339  subroutine cobshes
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
366  end
367 
368 
369 ! process low energy partilces in the skeleton 1 by 1
370 
371  subroutine c1by1
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 
412  end
413 !
414  subroutine embedas
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)
429  end
430 
431 
432 
433 
434  subroutine cmove_c_stack
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)
486  end
subroutine cgetfname(fnin, fn)
Definition: copenf.f:275
*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 cerrormsg(msg, needrtn)
Definition: cerrorMsg.f:4
subroutine cprintobs(io)
Definition: cprintObs.f:2
subroutine cqincident(incident, AngleAtObs)
Definition: cmkIncident.f:486
subroutine chookgint(never)
Definition: chook.f:191
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 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
subroutine embedas
Definition: chookFlesh.f:409
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
subroutine chookenrun
Definition: chook.f:147
Definition: Ztrack.h:44
subroutine chooknepint(never)
Definition: chook.f:219
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 cinitstack
Definition: cstack.f:76
subroutine cprintprim(out)
Definition: cprintPrim.f:3
*Zfirst p fm *Zfirst p Zfirst p Zfirst p *Zfirst p *Zfirst pos xyz Zfirst pos xyz sys
Definition: ZavoidUnionMap.h:1
subroutine cfintracking
Definition: cfinTracking.f:2
max ptcl codes in the kneue
Definition: Zcode.h:2
subroutine cmkincident(incident, fin)
Definition: cmkIncident.f:5
subroutine chookenevent
Definition: chook.f:116
subroutine cwriteparam(io, force)
Definition: cwriteParam.f:4
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
subroutine chooktrace
Definition: chook.f:275
subroutine cgethes(from)
Definition: chookFlesh.f:322
struct ob o[NpMax]
Definition: Zprivate.h:34
max ptcl codes in the kneumu
Definition: Zcode.h:2
*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
subroutine cinitracking(incident)
Definition: ciniTracking.f:2
*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 cresettimer(aTrack)
Definition: ctracking.f:302
subroutine chookobs(aTrack, id)
Definition: chook.f:59
subroutine chookbgevent
Definition: chook.f:39
subroutine cquhooki(i, iv)
Definition: cqUHookr.f:15
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
nodes t
subroutine cquhookc(i, cv)
Definition: cqUHookr.f:28
Definition: Zcoord.h:43
*Zfirst p fm *Zfirst p mass
Definition: ZavoidUnionMap.h:1
subroutine cprintstatus
Definition: cendRun.f:35
subroutine chookbgrun
Definition: chook.f:15
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
subroutine c1by1
Definition: chookFlesh.f:367
subroutine cmove_c_stack
Definition: chookFlesh.f:429
subroutine chookeint(never)
Definition: chook.f:162
! 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 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
subroutine cobshes
Definition: chookFlesh.f:335
dE dx *! Nuc Int sampling table c
Definition: cblkMuInt.h:130