************************************************************************ * * subroutine kinedigi * * * pack kinematics information into KINE ntuple * * * * last modified on: 13/08/99 by R. Holzmann * ************************************************************************ implicit none #include "kinetups.inc" #include "user.inc" #include "geantdef.h" integer i, j if(iroot.eq.0) then call hcdir('//PAWC/KINE',' ') call hfntb(idkinetup,'EVENT') ! fill 1st block of kine ntuple call hfntb(idkinetup,'TRACKS') ! fill 2nd block call hf1(idkinehisto,float(ntrk),1.0) do i=1,ntrk call hf1(idkinehisto+1,float(partid(i)),1.0) call hf1(idkinehisto+2,float(mechanism(i)/1000),1.0) if((mechanism(i)-1000*(mechanism(i)/1000)).eq.0) then ! primary particle call hf2(idkinehisto+3,tvert(1,i),tvert(2,i),1.0) call hf1(idkinehisto+4,tvert(3,i),1.0) endif enddo call hcdir('//PAWC',' ') else i = 0 #ifdef WITHROOT c write(6,*) ' *************** NTRK=', ntrk c do i=1,ntrk c write(6,*) track(i), partid(i), (pmom(j,i),j=1,3) c end do c write(6,*) ' ***************' call fillkine ! file KINE branches of ROOT tree #endif endif call kineout ! print out KINE information return end subroutine checktrk(trk,caller) ! check if track number exists implicit none #include "kinetups.inc" integer trk, i, j, maxj character*10 caller do i=1,ntrk if(trk.eq.track(i)) return end do write(6,*) 'track=',trk,' from ', caller,' not found in KINETUPS' write(6,*) 'ntrk=', ntrk do i=1,ntrk/10+1 maxj = 10 if(i.eq.ntrk/10+1) maxj = ntrk-10*(ntrk/10) write(6,*) (track(10*(i-1)+j),j=1,maxj) end do return end