geant3/src/uglast.F

0001
0002       SUBROUTINE UGLAST
0003 *
0004 *     Termination routine to print histograms and statistics
0005 *
0006 #include "geant321/gcflag.inc"
0007 #include "geant321/gctrak.inc"
0008 #include "calor.inc"
0009 #include "celoss.inc"
0010 #include "histo.inc"
0011 *
0012       DIMENSION EdepTot(MaxAbs)
0013 *
0014       CHARACTER*20 matnam
0015       CHARACTER*4 unit1, unit2
0016 *
0017       data aMeV /1.e-3/
0018 *
0019 * *** mean energy deposit and track length
0020       PRINT 749
0021       PRINT 750,IEVENT
0022       PRINT 751
0023       fnorm    = 1./IEVENT
0024       do k=1,NbAbsor
0025         call GFMATE (materAbs(k),matnam,dua,duz,dud,dur,dui,udu,idu)
0026         aveEdep  = fnorm*sumEdep(k)
0027         aveEdep2 = fnorm*su2Edep(k)
0028         rmsEdep  = sqrt(abs(aveEdep2-aveEdep**2))
0029         aveTrck  = fnorm*sumTrck(k)
0030         aveTrck2 = fnorm*su2Trck(k)
0031         rmsTrck  = sqrt(abs(aveTrck2-aveTrck**2))
0032 *
0033         CALL GEVKEV (aveEdep,Edmean,unit1)
0034         CALL GEVKEV (rmsEdep,Edrms ,unit2)
0035         PRINT 752,k,matnam,Edmean,unit1,Edrms,unit2,aveTrck,rmsTrck
0036       enddo
0037       PRINT 749
0038 *
0039 * *** Energy flow
0040       Iplmax = NbAbsor*NbLayer + 1
0041       do k=1,Iplmax
0042         fk = k
0043         EnerFlow(k) = EnerFlow(k)*fnorm
0044         EleakLat(k) = EleakLat(k)*fnorm
0045         ih = 2*MaxAbs + 1
0046         if (histo(ih)) call hfill (ih, fk, 0., EnerFlow(k)/aMeV)
0047         ih = 2*MaxAbs + 2
0048         if (histo(ih)) call hfill (ih, fk, 0., EleakLat(k)/aMeV)
0049       enddo
0050 *
0051 * *** Energy deposit from energy flow balance
0052       do k=1,NbAbsor
0053         EdepTot(k)  = 0.
0054       enddo
0055 *
0056       Idmax = NbAbsor*NbLayer
0057       do k=1,Idmax
0058         iAbsor = mod(k,NbAbsor)
0059         if (iAbsor.eq.0) iAbsor = NbAbsor
0060         Ebalance = EnerFlow(k) - EnerFlow(k+1) - EleakLat(k)
0061         EdepTot (iAbsor) = EdepTot (iAbsor) + Ebalance
0062       enddo
0063
0064       PRINT 761
0065       do k=1,NbAbsor
0066         call GFMATE (materAbs(k),matnam,dua,duz,dud,dur,dui,udu,idu)
0067         CALL GEVKEV (abs(EdepTot (k)),Edtot,unit1)
0068         if (EdepTot (k).lt.0.) Edtot = -Edtot
0069         PRINT 762,k,matnam,Edtot,unit1
0070       enddo
0071       PRINT 749
0072 *
0073 *
0074 * *** geant termination
0075       CALL GLAST
0076 *
0077 * *** close HIGZ
0078       CALL HPLEND
0079 *
0080 * *** Save histo
0081       CALL HRPUT(0,fileName,'N')
0082
0083 *
0084 *
0085 * *** formats
0086   749 FORMAT(/, 60(1H-),/)
0087   750 FORMAT(1X,'Nb of events:',I6)
0088   751 FORMAT(1X,'AbsNo  Material',5X,'Energy deposit',14X,'Trck length')
0089   752 FORMAT(I5,3X,A10,F8.3,A4,' +- ',F6.2,A4,F9.3,' cm +- ',F6.2,' cm')
0090   761 FORMAT('  Energy deposition from energy flow balance:',/,/,
0091      &       1X,'AbsNo  Material',5X,'Total Edep')
0092   762 FORMAT(I5,3X,A10,F10.3,A4)
0093 *
0094       END