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

Go to the source code of this file.

Functions/Subroutines

program __smashskeltrial.f__
 
subroutine distribute (n)
 
subroutine memoforcpu (n)
 
subroutine issuemsg (n)
 
subroutine sortbyerg
 
subroutine movetrack (f, t)
 

Function/Subroutine Documentation

◆ __smashskeltrial.f__()

program __smashskeltrial.f__ ( )

Definition at line 50 of file smashSkelTrial.f.

References cerrormsg(), copenf(), copenfw2(), cpupw(), distribute(), i, issuemsg(), kgetenv2(), klena(), ksplit(), maxp, memoforcpu(), movetrack(), n, sortbyerg(), and true.

50  type(child):: cc
Definition: Zprivate.h:25
Here is the call graph for this function:

◆ distribute()

subroutine distribute ( integer  n)

Definition at line 306 of file smashSkelTrial.f.

References cerrormsg(), cpupw(), erg, false, idx(), idxlocal(), kqsortd(), ksortinv(), sumergi(), sumergw(), and true.

306  implicit none
307 #include "Ztrack.h"
308  include "../../SkelFlesh/Zprivate.h"
309  include "Zprivate2.h"
310  integer i, k
311  integer n, j
312  logical bigtosmall
313 
314 
315  do i = 1, ncpu
316  sumergi(i)= 0.
317  sumergw(i) = 0.
318  noncpu(i) = 0
319  enddo
320  do i = 1, n
321 ! max energy ptcl for i-th cpu
322  sumergi(i) = erg(idx(i))
323  sumergw(i) = erg(idx(i)) / cpupw(i)
324  noncpu(i) = 1
325  idxlist(1, i) = idx(i)
326  idxlocal(i) = i
327  enddo
328 ! if all cpupw =1, next two not needed
329  call kqsortd(sumergw, idxlocal, n)
330  call ksortinv(idxlocal, n)
331 
332 !///////////
333 ! write(0,*) ' top E=',(sumergi(i), i=1, n)
334 ! write(0,*) ' idx=',(idx(i), i=1, n)
335 !////////
336 ! next explanation is for cpupw = 1
337 ! erg idx sumergi idxlocal nOnCpu idxlist
338 ! 1,1
339 ! 1 9 5 30 1 1 5
340 ! 2 1 3 18 2 1 3
341 ! n 3 18 7 15 3 1 7
342 ! 4 5 8
343 ! 5 30 1
344 ! 6 4 4
345 ! 7 15
346 ! 8 13
347 ! .
348 ! .
349 ! . 6
350 ! ctc . 2
351 !
352 ! after j= 4
353 ! sumergi idxlocal nOnCpu idxlist
354 ! 1 2
355 ! 30 1 1 5
356 ! 18 2 1 3
357 ! 28 3 2 7 8
358 ! after j=5
359 ! sumergi idxlocal nOnCpu idxlist
360 ! 1 2
361 ! 30 1 1 5
362 ! 27 3 2 3 1
363 ! 28 2 2 7 8
364 ! after j=6
365 ! sumergi idxlocal nOnCpu idxlist
366 ! 1 2 3
367 ! 30 1 1 5
368 ! 32 3 3 3 1 4
369 ! 28 2 2 7 8
370 !
371  k = n + 1
372  bigtosmall=.true.
373 
374 
375  do j = n+1, ctc
376  if( bigtosmall ) then
377  k = k - 1
378  if( k .eq. 0 ) then
379  bigtosmall = .false.
380  k = 1
381  endif
382  else
383  k = k + 1
384  if( k .gt. n ) then
385  bigtosmall = .true.
386  k =n
387  endif
388  endif
389 
390  noncpu( k ) = noncpu( k ) + 1
391  if( noncpu( k ) .gt. maxptclpercpu ) then
392  write(msg, *)
393  * '# of ptcls on a cpu', k, ' is ', noncpu( k ) ,
394  * ' exceeded limit=', maxptclpercpu
395  call cerrormsg(msg, 1)
396  call cerrormsg('Enlarge MaxPtclPerCpu in Zprivate2.h',0)
397  endif
398  idxlist( noncpu(k), k ) = idx(j)
399  sumergw(k) = sumergw(k) + erg(idx(j))/cpupw(k)
400  sumergi(k) = sumergi(k) + erg(idx(j))
401  enddo
402 
subroutine cerrormsg(msg, needrtn)
Definition: cerrorMsg.f:4
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
averg real * sumergi(MaxCPU)
averg real MaxCPU integer idx(Maxp)
********************block data cblkHeavy ********************integer j data *HeavyG2symbol *data *HeavyG2code kiron data j
Definition: cblkHeavy.h:36
subroutine kqsortd(A, ORD, N)
Definition: kqsortd.f:23
subroutine ksortinv(idx, n)
Definition: ksortinv.f:2
averg real sumergw(MaxCPU)
averg real MaxCPU integer idxlocal(MaxCPU) integer numba(MaxCPU) integer ctc
float erg[maxp]
Definition: Zprivate.h:7
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
averg real cpupw(MaxCPU) integer nOnCpu(MaxCPU) integer idxlist(MaxPtclPerCpu
integer n
Definition: Zcinippxc.h:1
Here is the call graph for this function:

◆ issuemsg()

subroutine issuemsg ( integer  n)

Definition at line 499 of file smashSkelTrial.f.

References cerrormsg(), cpupw(), and sumergi().

499  implicit none
500 #include "Ztrack.h"
501  include "../../SkelFlesh/Zprivate.h"
502  include "Zprivate2.h"
503 
504  integer n
505  integer i
506 
507  msg = ' cpu# cpuPW Sum E # of ptcls'
508 ! msg = 'cpu# Sum E # of ptcls'
509  call cerrormsg(msg, 1)
510  do i = 1, n
511  write(msg,'(i6, f7.1, g16.7, i9)')
512 ! write(msg,'(i3, g16.7, i9)')
513  * numba(i), cpupw(i), sumergi(i), noncpu(i)
514 ! * i, sumergi(i), nOnCpu(i)
515  call cerrormsg(msg, 1)
516  enddo
subroutine cerrormsg(msg, needrtn)
Definition: cerrorMsg.f:4
nodes i
averg real * sumergi(MaxCPU)
averg real cpupw(MaxCPU) integer nOnCpu(MaxCPU) integer idxlist(MaxPtclPerCpu
integer n
Definition: Zcinippxc.h:1
Here is the call graph for this function:

◆ memoforcpu()

subroutine memoforcpu ( integer  n)

Definition at line 406 of file smashSkelTrial.f.

References rndc().

406  implicit none
407 #include "Ztrack.h"
408  include "../../SkelFlesh/Zprivate.h"
409  include "Zprivate2.h"
410 
411  integer n
412  integer navob, navobc, navobx
413  integer i, j, icon
414  real avob, resob
415  real*8 u
416  integer cpuc
417  type(track)::zfirst ! name is some reason
418 
419 ! we distribute Np observed ptcls (at skeleton making time)
420 ! almost equally to Mcpu cpu (not to Margin);
421 ! If some hosts fails, observed ones will be lost since
422 ! hosts of Margin have no observed ptcls. This may not have
423 ! any dangour since, observed ptcls will be only at the core
424 ! region and we don't need such region for detector simulation
425 ! number of average ptcls
426 
427  avob = np
428  avob = avob/mcpu
429 ! navobx = max(Np/Ncpu, 1)
430  navobx = np/mcpu
431 ! if( Np .eq. 0 ) navobx = 0
432 
433  resob = avob-navobx ! 0<= resob< 1
434 
435  navobc = 0
436 !/////////////////
437  write(0,*) ' navobx=', navobx, ' resob=',resob
438 !///////////
439  cpuc = 0
440  do i = 1, ncpu
441  if(numba(i) .lt. 0 ) then
442  cpuc = cpuc + 1
443  navob = navobx
444  call rndc(u)
445  if( u .lt. resob) then
446  navob = navobx + 1
447  endif
448  if(navobc+navob .gt. np .or. cpuc .eq. mcpu ) then
449  navob = np - navobc
450  endif
451 #if defined (AVOIDFOOL)
452  open(basefn+i, file=skelfile(i), position="append",
453 #else
454  open(basefn+i, file=skelfile(i), access="append",
455 #endif
456  * form="unformatted", iostat=icon)
457  if(icon .eq. 0) then
458 !/////////////
459  write(0,*) ' cpu ',i, ' obs=',navob
460 !//////////////
461  write(basefn+i) navob
462 !
463 
464  do j = navobc +1, navobc+navob
465  write(basefn+i) oo(j)
466  enddo
467  navobc = navobc + navob
468  else
469  write(0,*) ' skelfile=', skelfile(i), " cannot be opened"
470  stop 11111
471  endif
472 
473 ! *** enddo
474 ! *** do i = 1, Ncpu
475 !cc if(i .eq. 1) then
476 ! for the first skeleton, put observed ptcls
477 !c write(basefn+i) Np
478 !c do j = 1, Np
479 !c write(basefn+1) oo(j)
480 !c enddo
481 !c else
482 !c write(basefn+i) 0
483 !c endif
484  write(basefn+i) noncpu(i)
485  do j = 1, noncpu(i)
486 #if defined (AVOIDFOOL)
487  zfirst =ct( idxlist(j, i) )
488  write(basefn+i)
489 #include "ZavoidUnionMap.h"
490 #else
491  write(basefn+i) ct( idxlist(j, i) )
492 #endif
493  enddo
494  close(basefn+i)
495  endif
496  enddo
nodes i
Definition: Ztrack.h:44
subroutine rndc(u)
Definition: rnd.f:91
********************block data cblkHeavy ********************integer j data *HeavyG2symbol *data *HeavyG2code kiron data j
Definition: cblkHeavy.h:36
Definition: Zpos.h:16
integer n
Definition: Zcinippxc.h:1
Here is the call graph for this function:

◆ movetrack()

subroutine movetrack ( type(child f,
type(track t 
)

Definition at line 556 of file smashSkelTrial.f.

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

556  implicit none
557 #include "Ztrack.h"
558 #include "Zearth.h"
559  include "../../SkelFlesh/Zprivate.h"
560  include "Zprivate2.h"
561 
562  type(child):: f
563  type(track):: t
564 
565  t.p.code = f.code
566  t.p.subcode = f.subcode
567  t.p.charge = f.charge
568  t.p.fm.p(1) = f.fm(1)
569  t.p.fm.p(2) = f.fm(2)
570  t.p.fm.p(3) = f.fm(3)
571  t.p.fm.p(4) = f.fm(4)
572  t.p.mass = f.mass
573  t.pos.xyz.r(1) = pp.posx
574  t.pos.xyz.r(2) = pp.posy
575  t.pos.xyz.r(3) = pp.posz
576 
577  t.pos.depth = pp.depth
578  t.pos.height = pp.height
579  t.pos.colheight = pp.colheight
580  t.t = pp.atime
581  t.where = pp.where
582  t.pos.radiallen =
583  * eradius + pp.height
584  t.pos.xyz.sys = 'xyz'
585  t.vec.w.sys = 'xyz'
586  t.wgt = 1.0
587  t.asflag = 0
588 ! t.user = pp.user
589  call cresetdirec( t )
*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
Definition: Zprivate.h:25
nodes t
*Zfirst p fm *Zfirst p mass
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 *Zfirst wgt
Definition: ZavoidUnionMap.h:1
*Zfirst p fm *Zfirst p Zfirst p Zfirst p subcode
Definition: ZavoidUnionMap.h:1
dE dx *! Nuc Int sampling table f
Definition: cblkMuInt.h:130
*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:

◆ sortbyerg()

subroutine sortbyerg ( )

Definition at line 521 of file smashSkelTrial.f.

References cerrormsg(), erg, idx(), kqsortd(), ksortinv(), and p.

521  implicit none
522 #include "Ztrack.h"
523  include "../../SkelFlesh/Zprivate.h"
524  include "Zprivate2.h"
525 
526  integer i
527 
528  averg = 0.
529  do i = 1, ctc
530  erg(i) = ct(i).p.fm.p(4)
531  averg = averg + erg(i)
532  enddo
533  call kqsortd(erg, idx, ctc)
534 ! high to low
535  call ksortinv(idx, ctc)
536  if(ctc .gt. 0.) then
537 ! average total energy on 1 cpu
538  averg = averg/ctc * ncpu
539  else
540  call cerrormsg('no child',1)
541  return
542  endif
543  if( erg(idx(ctc) ) .gt. averg*1.1 ) then
544 ! max energy is too large. issue
545 ! warning
546  write(msg,*) 'WARGNING: max E=', erg(idx(i)),
547  * ' is > average total energy for 1 cpu=',
548  * averg
549  call cerrormsg(msg, 1)
550  endif
subroutine cerrormsg(msg, needrtn)
Definition: cerrorMsg.f:4
nodes i
averg real MaxCPU integer idx(Maxp)
********************block data cblkHeavy ********************integer j data *HeavyG2symbol p
Definition: cblkHeavy.h:7
subroutine kqsortd(A, ORD, N)
Definition: kqsortd.f:23
subroutine ksortinv(idx, n)
Definition: ksortinv.f:2
float erg[maxp]
Definition: Zprivate.h:7
Here is the call graph for this function: