Geant4  9.6.p02
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
uglast.F
Go to the documentation of this file.
1 
2  SUBROUTINE uglast
3 *
4 * Termination routine to print histograms and statistics
5 *
6 #include "geant321/gcbank.inc"
7 #include "geant321/gcflag.inc"
8 #include "geant321/gckine.inc"
9 #include "pvolum.inc"
10 #include "celoss.inc"
11 *
12  dimension xsel1(nbin),xsel1c(nbin),xser1(nbin),xser1c(nbin),
13  + xsel2(nbin),xsel2c(nbin),xser2(nbin),xser2c(nbin)
14 
15  dimension edist(100),edistc(100)
16 *
17 * *** Normalize and print energy distribution
18  xevent=ievent
19  cnorm = 100./(xevent*pkine(3))
20 *
21 * *** mean total energy deposit by charged and by neutral
22  edepch = cnorm*edepch
23  edepne = cnorm*edepne
24 *
25 * *** longitudinal profile
26  DO 2 i = 1,nltot
27  xsel1(i) = cnorm * sel1(i)
28  xsel2(i) = cnorm*sqrt(abs(xevent*sel2(i) - sel1(i)**2))
29  xsel1c(i) = cnorm * sel1c(i)
30  xsel2c(i) = cnorm*sqrt(abs(xevent*sel2c(i) - sel1c(i)**2))
31  2 CONTINUE
32  CALL hpak(5,xsel2)
33  CALL hpak(7,xsel2c)
34 *
35 * *** radial profile
36  DO 3 i = 1,nrtot
37  xser1(i) = cnorm * ser1(i)
38  xser2(i) = cnorm*sqrt(abs(xevent*ser2(i) - ser1(i)**2))
39  xser1c(i) = cnorm * ser1c(i)
40  xser2c(i) = cnorm*sqrt(abs(xevent*ser2c(i) - ser1c(i)**2))
41  3 CONTINUE
42  CALL hpak( 9,xser2)
43  CALL hpak(11,xser2c)
44 *
45 * *** total track length
46  cnorm = 1./(xevent*x0)
47  xtrch1 = cnorm*strch1
48  xtrch2 = cnorm*sqrt(abs(xevent*strch2 - strch1**2))
49  xtrne1 = cnorm*strne1
50  xtrne2 = cnorm*sqrt(abs(xevent*strne2 - strne1**2))
51 *
52 * *** Print profiles (under condition iswit(2).gt.0)
53 *
54  if (iswit(2).gt.0) then
55  print 749
56  print 750
57  print 751
58  DO 15 i=1,nltot
59  b0 = (i-1)*dlx0
60  b1 = i*dlx0
61  print 754,b0,b1,xsel1(i),xsel2(i),b1,xsel1c(i),xsel2c(i)
62  15 CONTINUE
63 
64  print 760
65  print 751
66  DO 16 i=1,nrtot
67  b0 = (i-1)*drx0
68  b1 = i*drx0
69  print 754,b0,b1,xser1(i),xser2(i),b1,xser1c(i),xser2c(i)
70  16 CONTINUE
71  endif
72 *
73 * *** normalize histo of energy ditribution of contributing particles
74 * and compute cumulative distribution
75  sum = hsum(21)
76  CALL hunpak(21,edist,'HIST',1)
77  edist( 1) = edist(1)*100/sum
78  edistc(1) = edist(1)
79  DO 17 i=2,100
80  edist(i) = edist(i)*100/sum
81  edistc(i) = edistc(i-1) + edist(i)
82  17 CONTINUE
83  CALL hpak(21,edist)
84  CALL hpak(22,edistc)
85 *
86 * *** print summary
87  print 770
88  print 771,xsel1c(nltot),xsel2c(nltot)
89  print 774,edepch
90  print 775,edepne
91  print 772,xtrch1,xtrch2
92  print 773,xtrne1,xtrne2
93  print 749
94 *
95 * *** Save selected histograms
96  CALL hrput(0,'testem2.hbook','N')
97 *
98 * *** terminaison
99  CALL glast
100 *
101 * *** close HIGZ
102  CALL hplend
103 *
104  749 FORMAT(//)
105  750 FORMAT(15x,'LATERAL PROFILE',35x,'CUMULATIVE LATERAL PROFILE'/)
106  751 FORMAT( 8x,'Bin',12x,' Mean ',5x,' rms',
107  * 19x,'Bin', 9x,' Mean ',5x,' rms',/)
108  754 FORMAT( 3x,f5.2,'->',f5.2,' radl: ',f7.2,'% ',f7.2,'%',
109  * 13x, '0->',f5.2,' radl: ',f7.2,'% ',f7.2,'%')
110  760 FORMAT(///,15x,'RADIAL PROFILE',35x,'CUMULATIVE RADIAL PROFILE'/)
111  770 FORMAT(/,30x,'SUMMARY',/)
112  771 FORMAT( 25x,'energy deposit : ',f7.2,' % E0 +- ',f7.2,' % E0')
113  772 FORMAT( 25x,'charged traklen: ',f7.2,' radl +- ',f7.2,' radl')
114  773 FORMAT( 25x,'neutral traklen: ',f7.2,' radl +- ',f7.2,' radl')
115  774 FORMAT( 25x,'edep by charged: ',f7.2,' % E0')
116  775 FORMAT( 25x,'edep by neutral: ',f7.2,' % E0')
117 *
118  END
119