source: trunk/examples/extended/electromagnetic/TestEm2/geant3/src/uglast.F@ 1036

Last change on this file since 1036 was 807, checked in by garnier, 17 years ago

update
File size: 5.5 KB
Line 
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 (6,XSEL2C)
33*
34* *** radial profile
35 DO 3 I = 1,NRTOT
36 XSER1 (I) = CNORM * SER1 (I)
37 XSER2 (I) = CNORM*SQRT(ABS(XEVENT*SER2 (I) - SER1 (I)**2))
38 XSER1C(I) = CNORM * SER1C(I)
39 XSER2C(I) = CNORM*SQRT(ABS(XEVENT*SER2C(I) - SER1C(I)**2))
40 3 CONTINUE
41 CALL HPAK (9,XSER2C)
42*
43* *** total track length
44 CNORM = 1./(XEVENT*X0)
45 XTRCH1 = CNORM*STRCH1
46 XTRCH2 = CNORM*SQRT(ABS(XEVENT*STRCH2 - STRCH1**2))
47 XTRNE1 = CNORM*STRNE1
48 XTRNE2 = CNORM*SQRT(ABS(XEVENT*STRNE2 - STRNE1**2))
49*
50* *** Print profiles (under condition iswit(2).gt.0)
51*
52 if (iswit(2).gt.0) then
53 PRINT 749
54 PRINT 750
55 PRINT 751
56 DO 15 I=1,NLTOT
57 B0 = (I-1)*DLX0
58 B1 = I*DLX0
59 PRINT 754,B0,B1,XSEL1(I),XSEL2(I),B1,XSEL1C(I),XSEL2C(I)
60 15 CONTINUE
61
62 PRINT 760
63 PRINT 751
64 DO 16 I=1,NRTOT
65 B0 = (I-1)*DRX0
66 B1 = I*DRX0
67 PRINT 754,B0,B1,XSER1(I),XSER2(I),B1,XSER1C(I),XSER2C(I)
68 16 CONTINUE
69 endif
70*
71* *** normalize histo of energy ditribution of contributing particles
72* and compute cumulative distribution
73 SUM = HSUM (21)
74 CALL HUNPAK(21,EDIST,'HIST',1)
75 EDIST( 1) = EDIST(1)*100/SUM
76 EDISTC(1) = EDIST(1)
77 DO 17 I=2,100
78 EDIST (I) = EDIST (I)*100/SUM
79 EDISTC(I) = EDISTC(I-1) + EDIST(I)
80 17 CONTINUE
81 CALL HPAK (21,EDIST)
82 CALL HPAK (22,EDISTC)
83*
84* *** print summary
85 PRINT 770
86 PRINT 771,XSEL1C(NLTOT),XSEL2C(NLTOT)
87 PRINT 774,EDEPCH
88 PRINT 775,EDEPNE
89 PRINT 772,XTRCH1,XTRCH2
90 PRINT 773,XTRNE1,XTRNE2
91 PRINT 749
92*
93* *** Save selected histograms
94 CALL HRPUT(0,'testem2.hbook','N')
95*
96* *** terminaison
97 CALL GLAST
98*
99* *** close HIGZ
100 CALL HPLEND
101*
102 749 FORMAT(//)
103 750 FORMAT(15X,'LATERAL PROFILE',35X,'CUMULATIVE LATERAL PROFILE'/)
104 751 FORMAT( 8X,'Bin',12X,' Mean ',5X,' rms',
105 * 19X,'Bin', 9X,' Mean ',5X,' rms',/)
106 754 FORMAT( 3X,F5.2,'->',F5.2,' radl: ',F7.2,'% ',F7.2,'%',
107 * 13X, '0->',F5.2,' radl: ',F7.2,'% ',F7.2,'%')
108 760 FORMAT(///,15X,'RADIAL PROFILE',35X,'CUMULATIVE RADIAL PROFILE'/)
109 770 FORMAT(/,30X,'SUMMARY',/)
110 771 FORMAT( 25X,'energy deposit : ',F7.2,' % E0 +- ',F7.2,' % E0')
111 772 FORMAT( 25X,'charged traklen: ',F7.2,' radl +- ',F7.2,' radl')
112 773 FORMAT( 25X,'neutral traklen: ',F7.2,' radl +- ',F7.2,' radl')
113 774 FORMAT( 25X,'edep by charged: ',F7.2,' % E0')
114 775 FORMAT( 25X,'edep by neutral: ',F7.2,' % E0')
115*
116 END
117
Note: See TracBrowser for help on using the repository browser.