uglast.F

Go to the documentation of this file.

 
      SUBROUTINE uglast                                                         
*                                                                               
*     Termination routine to print histograms and statistics                    
*                                                                               
#include "geant321/gcbank.inc"
#include "geant321/gcflag.inc"
#include "geant321/gckine.inc"
#include "pvolum.inc"
#include "celoss.inc"                                                               
*                                                                               
      dimension xsel1(nbin),xsel1c(nbin),xser1(nbin),xser1c(nbin),          
     +          xsel2(nbin),xsel2c(nbin),xser2(nbin),xser2c(nbin)
     
      dimension edist(100),edistc(100)                                                    
*                                                                               
* *** Normalize and print energy distribution                                   
      xevent=ievent                                                             
      cnorm  = 100./(xevent*pkine(3))      
*
* *** mean total energy deposit by charged and by neutral
      edepch = cnorm*edepch
      edepne = cnorm*edepne                                                 
*
* *** longitudinal profile                                                                               
      DO 2 i = 1,nltot                                                          
         xsel1(i) = cnorm * sel1(i)                                           
         xsel2(i) = cnorm*sqrt(abs(xevent*sel2(i) - sel1(i)**2))             
         xsel1c(i) = cnorm * sel1c(i)                                           
         xsel2c(i) = cnorm*sqrt(abs(xevent*sel2c(i) - sel1c(i)**2))
    2 CONTINUE
         CALL hpak(5,xsel2)    
         CALL hpak(7,xsel2c)
*
* *** radial profile                                                                                
      DO 3 i = 1,nrtot                                                          
         xser1(i) = cnorm * ser1(i)                                           
         xser2(i) = cnorm*sqrt(abs(xevent*ser2(i) - ser1(i)**2))             
         xser1c(i) = cnorm * ser1c(i)                                           
         xser2c(i) = cnorm*sqrt(abs(xevent*ser2c(i) - ser1c(i)**2))             
    3 CONTINUE
         CALL hpak( 9,xser2)    
         CALL hpak(11,xser2c)
*
* *** total track length
      cnorm  = 1./(xevent*x0)
      xtrch1 = cnorm*strch1
      xtrch2 = cnorm*sqrt(abs(xevent*strch2 - strch1**2))
      xtrne1 = cnorm*strne1
      xtrne2 = cnorm*sqrt(abs(xevent*strne2 - strne1**2))                                              
*
* *** Print profiles (under condition iswit(2).gt.0)
*
      if (iswit(2).gt.0) then
        print 749
        print 750
        print 751
        DO 15 i=1,nltot
           b0 = (i-1)*dlx0
           b1 = i*dlx0                                                                             
           print 754,b0,b1,xsel1(i),xsel2(i),b1,xsel1c(i),xsel2c(i)                                         
   15   CONTINUE                                                

        print 760
        print 751
        DO 16 i=1,nrtot
           b0 = (i-1)*drx0
           b1 = i*drx0                                                                             
           print 754,b0,b1,xser1(i),xser2(i),b1,xser1c(i),xser2c(i)                                         
   16   CONTINUE
      endif
*
* *** normalize histo of energy ditribution of contributing particles
*     and compute cumulative distribution
      sum = hsum(21)
      CALL hunpak(21,edist,'HIST',1)
         edist( 1) = edist(1)*100/sum
     edistc(1) = edist(1)
      DO 17 i=2,100
         edist(i) = edist(i)*100/sum
     edistc(i) = edistc(i-1) + edist(i)
   17 CONTINUE
      CALL hpak(21,edist)
      CALL hpak(22,edistc)   
*
* *** print summary
      print 770
      print 771,xsel1c(nltot),xsel2c(nltot)
      print 774,edepch
      print 775,edepne
      print 772,xtrch1,xtrch2
      print 773,xtrne1,xtrne2
      print 749   
*                                                                               
* *** Save selected histograms                                                  
      CALL hrput(0,'testem2.hbook','N')
*
* *** terminaison                                                                                
      CALL glast
*
* *** close HIGZ      
      CALL hplend                                                                                                                                                    
*
  749 FORMAT(//)                                                         
  750 FORMAT(15x,'LATERAL PROFILE',35x,'CUMULATIVE LATERAL PROFILE'/)                                               
  751 FORMAT( 8x,'Bin',12x,'  Mean ',5x,'  rms',
     *       19x,'Bin', 9x,'  Mean ',5x,'  rms',/)
  754 FORMAT( 3x,f5.2,'->',f5.2,' radl: ',f7.2,'%    ',f7.2,'%',                              
     *       13x,    '0->',f5.2,' radl: ',f7.2,'%    ',f7.2,'%')                                                 
  760 FORMAT(///,15x,'RADIAL PROFILE',35x,'CUMULATIVE RADIAL PROFILE'/)
  770 FORMAT(/,30x,'SUMMARY',/)
  771 FORMAT(    25x,'energy deposit : ',f7.2,' % E0 +- ',f7.2,' % E0')
  772 FORMAT(    25x,'charged traklen: ',f7.2,' radl +- ',f7.2,' radl')
  773 FORMAT(    25x,'neutral traklen: ',f7.2,' radl +- ',f7.2,' radl')
  774 FORMAT(    25x,'edep by charged: ',f7.2,' % E0')
  775 FORMAT(    25x,'edep by neutral: ',f7.2,' % E0')                                                                            
*
      END