*********************************************************************** * SUBROUTINE GUKINE * * last modified on: 13/09/2007 by R. Holzmann * restructured on: 20/1/2000 by R. Schicker * track info added to kine ntuple: 6/3/98 by R.Holzmann *********************************************************************** implicit none #include "geant321/gckine.inc" #include "geant321/gcflag.inc" #include "trig.inc" #include "geaevent.inc" #include "user.inc" #include "pmc.inc" #include "kinetups.inc" #include "geatarget.inc" /* #ifdef GEANT_REF #include "gurefp.inc" #include "guref.inc" #endif */ integer nvtx, i, igen, ireq real ubuf(3), xvert(3), beta(4), dphi *--------------------------------------- * initialization for each event *--------------------------------------- c if (irich.ge.1) call richinit c if (imdc.ge.1) call mdcinit c if (ishow.ge.1) call showinit c if (itof.ge.1) call tofinit c if (irpc.ge.1) call rpcinit c if (iwall.ge.1) call wallinit if(ltrig.eq.1) call trigclear #ifdef GEANT_REF if (ireft.ne.0) then call refev goto 99 else #endif *-------------------------------------------- * kine header *-------------------------------------------- eventid = idevt ! from common /CGFLAG/ runid = idrun ebeam = beampar(3) ! beam energy in AMeV beta(1) = 0.0 beta(2) = 0.0 beta(3) = -sqrt(ebeam/(ebeam+2*931.5)) ! beta(lab vs. CM) beta(4) = 1./sqrt(1.-beta(1)**2-beta(2)**2-beta(3)**2) ! gamma(CM) bpar = 0.0 ! impact parameter in fm phi_event = 0.0 *-------------------------------------------- * make vertex and particles *-------------------------------------------- call makevertex(xvert) call gsvert(xvert,0,0,ubuf,0,nvtx) ! make primary vertex ntrk = 0 ! zero nb of tracks (also, when no kinetup) if(pmcf.eq.1 .and. NEvFiles.gt.0) call filegen(nvtx,xvert,beta) ! get event from file(s) if(pmck.eq.1) call kinegen(nvtx,xvert) ! get event from Cint via passEvent() dphi = 0. if(ikine.eq.-1) then ! shoot into all 6 sectors ireq = 6 else ireq = ikine endif if(ireq.gt.0) then do i=1,ireq if (ikine.eq.-1) dphi = (i-1)*60. call varangle(nvtx,xvert,dphi) ! one-shot controlled by KINE enddo endif if(pmc1(1).ne.0.0) then ! get event from generator #1 do i=1,30 pmc0(i) = pmc1(i) end do call callgen(1,nvtx,xvert) end if if(pmc2(2).gt.0.0) then ! get event from generator #2 do i=1,30 pmc0(i) = pmc2(i) end do call callgen(2,nvtx,xvert) end if if(pmc3(2).gt.0.0) then ! get event from generator #3 do i=1,30 pmc0(i) = pmc3(i) end do call callgen(3,nvtx,xvert) end if if(pmc4(2).gt.0.0) then ! get event from generator #4 do i=1,30 pmc0(i) = pmc4(i) end do call callgen(4,nvtx,xvert) end if if(pmc5(2).gt.0.0) then ! get event from generator #5 do i=1,30 pmc0(i) = pmc5(i) end do call callgen(5,nvtx,xvert) end if if(pmc6(2).gt.0.0) then ! get event from generator #6 do i=1,30 pmc0(i) = pmc6(i) end do call callgen(6,nvtx,xvert) end if if(pmc7(2).gt.0.0) then ! get event from generator #7 do i=1,30 pmc0(i) = pmc7(i) end do call callgen(7,nvtx,xvert) end if if(pmc8(2).gt.0.0) then ! get event from generator #8 do i=1,30 pmc0(i) = pmc8(i) end do call callgen(8,nvtx,xvert) end if if(pmc9(2).gt.0.0) then ! get event from generator #9 do i=1,29 pmc0(i) = pmc3(i+1) end do igen = ifix(pmc3(1)+0.01) call callgen(igen,nvtx,xvert) end if #ifdef GEANT_REF endif #endif 99 continue if(idevt.lt.100 .or. mod(idevt,100).eq.0) then if(idevt.eq.1) then write(6,*) 'Run: ', idrun,' Event: ',idevt else write(6,*) 'Event: ',idevt endif endif return end c------------------------------------------------------------------------------ subroutine copykine(itrack,id,p,vert,medium,mech, + weight,uval,ge1,ge2,ge3) c c copy particle into kine common block /kinetups/ c implicit none integer itrack, id, medium, mech real p(3), vert(3), weight, ge1, ge2, ge3 real uval #include "kinetups.inc" #include "user.inc" integer i, med med = medium if (med.eq.0) call gmedia(vert,med) ! get target medium from GEANT ntrk = ntrk + 1 do i=1,3 tvert(i,ntrk) = lunit*vert(i) ! vertex in mm (or cm) pmom(i,ntrk) = 1000.0*p(i) ! momenta in MeV/c enddo track(ntrk) = itrack ! track number prevtrack(ntrk) = 0 ! no parent track partid(ntrk) = id ! particle id mechanism(ntrk) = 1000*med+mech ! creation info gen1(ntrk) = ge1 ! source id gen2(ntrk) = ge2 ! parent id gen3(ntrk) = ge3 ! parent index wghtp(ntrk) = weight ! associated weight userval(ntrk) = uval ! copy user value return end c---------------------------------------------------------------------------- subroutine passevent(e,b,ph,np,id,ids,idp,ixp,px,py,pz, + vx,vy,vz,vt,w) c c this function is called from ROOT to copy an event into common KINEGEN c integer*4 np, id(1), ids(1), idp(1), ixp(1), i real*4 e, b, ph, px(1), py(1), pz(1), w(1) real*4 vx(1), vy(1), vz(1), vt(1) #include "kinegenc.inc" eb = e ! beam energy in GeV/u bp = b ! impact parameter in fm phiev = ph ! event angle in deg. ngen = np if(ngen.gt.maxin) then write(6,*) ' NPART = ',ngen,' (> 1000). Event truncated!' ngen = maxin end if c write(6,*) ngen do i=1,ngen c write(6,*) id(i),ids(i),idp(i),ixp(i),px(i),py(i),pz(i),w(i) idgen(i) = id(i) ! particle id idsrc(i) = ids(i) ! parent id idpar(i) = idp(i) ! Pluto parent index (to discriminate pairs) ixpar(i) = ixp(i) pxgen(i) = px(i) ! momentum pygen(i) = py(i) pzgen(i) = pz(i) vxgen(i) = vx(i) ! vertex + time vygen(i) = vy(i) vzgen(i) = vz(i) vtgen(i) = vt(i) wgen(i) = w(i) enddo return end c---------------------------------------------------------------------------- subroutine cmtolab(beta,p,ipart) c c transform 3-momentum from CM to lab c real beta(4), p(3), pcm(4), plab(4), mass integer ipart character*20 cdum1 integer idu2 real du3,du4,du5,du6 pcm(1) = p(1) pcm(2) = p(2) pcm(3) = p(3) call gfpart(ipart,cdum1,idu2,mass,du3,du4,du5,du6) ! get mass pcm(4) = sqrt(p(1)**2 + p(2)**2 + p(3)**2 + mass**2) call gloren(beta,pcm,plab) ! transform p from CM to lab p(1) = plab(1) p(2) = plab(2) p(3) = plab(3) return end c----------------------------------------------------------------------------