************************************************************************ SUBROUTINE REFDIGI2 implicit none C. * * C. * Routine called at the end of each event for evaluating * C. * transformation matrix for track finding * C. * done with OMEGA tracks (i.e. nref(1)=2) * C. * * C. * * cSEQ,DRPARS,GUREF,GEOM,GUMAT. c c local variables c #include "gurefp.inc" #include "gumat.inc" real hits1(14,50),hits2(14,50),hits3(14,50),hits4(14,50) real xdel(4),ydel(4),dmomp,dmome,dmom real tup(26),vertl(3),pvertl(4),ubuf(3),pabs,the,phi real dc,ds,dx,dy,sumo,dh,dl,diff,diffl,d1,d2,d3 real dpx,dpy,dpz,dpt2,dpt,p1,p2,p3,p4,s1,s2,s3,s4 integer itral1(50),itral2(50),itral3(50),itral4(50) integer numbv1(50),numbv2(50),numbv3(50),numbv4(50) real xpdet(8),xedet(8),xdet(8),dx3,dy3,dx4,dy4 integer nhits1,nhits2,nhits3,nhits4,ihit,j1,j2,ilmax integer numvs(4),idet(4),idet0,ipartl,nvertl,nubuf,js integer nx(4),ny(4),ilx(4),ily(4),k,il1,il2,il3,il4,il,i1,i2 integer nk,nt,kdet data numvs/0,0,0,0/ ilmax=2 kdet=4 do js=1,6 numvs(1)=js do j1=1,50 do j2=1,14 hits1(j2,j1)=0. hits2(j2,j1)=0. hits3(j2,j1)=0. hits4(j2,j1)=0. end do numbv1(j1)=0 numbv2(j1)=0 numbv3(j1)=0 numbv4(j1)=0 itral1(j1)=0 itral2(j1)=0 itral3(j1)=0 itral4(j1)=0 end do nhits1=0 nhits2=0 nhits3=0 nhits4=0 do j1=1,4 nx(j1)=0 ny(j1)=0 ilx(j1)=0 ily(j1)=0 end do call gfhits('DRIF','DW13',1,14,50,0,numvs, 1 itral1,numbv1,hits1,nhits1) call gfhits('DRIF','DW23',1,14,50,0,numvs, 1 itral2,numbv2,hits2,nhits2) call gfhits('DRIF','DW33',1,14,50,0,numvs, 1 itral3,numbv3,hits3,nhits3) call gfhits('DRIF','DW43',1,14,50,0,numvs, 1 itral4,numbv4,hits4,nhits4) do il=1,ilmax do i2=1,4 idet(i2)=0 end do call gfkine(il,vertl,pvertl,ipartl,nvertl,ubuf,nubuf) dmom=sqrt(pvertl(1)**2+pvertl(2)**2+pvertl(3)**2) il1=0 il2=0 il3=0 il4=0 if(nhits1.gt.0)then 101 il1=il1+1 if(itral1(il1).ne.il.and.il1.le.50)go to 101 end if if(nhits2.gt.0)then 102 il2=il2+1 if(itral2(il2).ne.il.and.il2.le.50)go to 102 end if if(nhits3.gt.0)then 103 il3=il3+1 if(itral3(il3).ne.il.and.il3.le.50)go to 103 end if if(nhits4.gt.0)then 104 il4=il4+1 if(itral4(il4).ne.il.and.il4.le.50)go to 104 end if IF(IPARTL.EQ.2)THEN if(il1.gt.0.and.il1.le.50)then idet(1)=1 xpdet(1)=hits1(7,il1) xpdet(2)=hits1(8,il1) xdet(1)=hits1(7,il1) xdet(2)=hits1(8,il1) end if if(il2.gt.0.and.il2.le.50)then idet(2)=1 xpdet(3)=hits2(7,il2) xpdet(4)=hits2(8,il2) xdet(3)=hits2(7,il2) xdet(4)=hits2(8,il2) end if if(il3.gt.0.and.il3.le.50)then idet(3)=1 xpdet(5)=hits3(7,il3) xpdet(6)=hits3(8,il3) xdet(5)=hits3(7,il3) xdet(6)=hits3(8,il3) end if if(il4.gt.0.and.il4.le.50)then idet(4)=1 xpdet(7)=hits4(7,il4) xpdet(8)=hits4(8,il4) xdet(7)=hits4(7,il4) xdet(8)=hits4(8,il4) end if ELSE IF(IPARTL.EQ.3)THEN if(il1.gt.0.and.il1.le.50)then idet(1)=1 xedet(1)=hits1(7,il1) xedet(2)=hits1(8,il1) xdet(1)=hits1(7,il1) xdet(2)=hits1(8,il1) end if if(il2.gt.0.and.il2.le.50)then idet(2)=1 xedet(3)=hits2(7,il2) xedet(4)=hits2(8,il2) xdet(3)=hits2(7,il2) xdet(4)=hits2(8,il2) end if if(il3.gt.0.and.il3.le.50)then idet(3)=1 xedet(5)=hits3(7,il3) xedet(6)=hits3(8,il3) xdet(5)=hits3(7,il3) xdet(6)=hits3(8,il3) end if if(il4.gt.0.and.il4.le.50)then idet(4)=1 xedet(7)=hits4(7,il4) xedet(8)=hits4(8,il4) xdet(7)=hits4(7,il4) xdet(8)=hits4(8,il4) end if END IF idet0=1 do i2=1,4 if(idet(i2).eq.0)idet0=0 end do if(idet0.eq.1)then dy3=xdet(6) dx4=xdet(7) dy4=xdet(8) call drfpad(dx4,dy4,kdet,nt) call drfkik(dy3,dy4,nk) if(nt.gt.0.and.nt.le.npad)then if(nk.gt.0.and.nk.lt.nkik)then if(ipartl.eq.2)then i2=970+nt else if(ipartl.eq.3)then i2=980+nt end if call hf2(i2,dx4,dy4,1.) if(ipartl.eq.2)tmultp(nt,nk)=tmultp(nt,nk)+1 if(ipartl.eq.3)tmulte(nt,nk)=tmulte(nt,nk)+1 if(ipartl.eq.2)tmultp(nt,nkik)=tmultp(nt,nkik)+1 if(ipartl.eq.3)tmulte(nt,nkik)=tmulte(nt,nkik)+1 tmultp(nt,nk)=min(tmultp(nt,nk),ntref) tmulte(nt,nk)=min(tmulte(nt,nk),ntref) tmults(nt,nk)=tmults(nt,nk)+1 tmultp(nt,nkik)=min(tmultp(nt,nkik),ntref) tmulte(nt,nkik)=min(tmulte(nt,nkik),ntref) tmults(nt,nkik)=tmults(nt,nkik)+1 do j1=1,8 if(ipartl.eq.2)then tcentp(j1,nt,nk)=tcentp(j1,nt,nk)+xpdet(j1) detp(j1,tmultp(nt,nk),nt,nk)=xpdet(j1) tcentp(j1,nt,nkik)=tcentp(j1,nt,nkik)+xpdet(j1) detp(j1,tmultp(nt,nkik),nt,nkik)=xpdet(j1) end if if(ipartl.eq.3)then tcente(j1,nt,nk)=tcente(j1,nt,nk)+xedet(j1) dete(j1,tmulte(nt,nk),nt,nk)=xedet(j1) tcente(j1,nt,nkik)=tcente(j1,nt,nkik)+xedet(j1) dete(j1,tmulte(nt,nkik),nt,nkik)=xedet(j1) end if tcents(j1,nt,nk)=tcents(j1,nt,nk)+xdet(j1) tcents(j1,nt,nkik)=tcents(j1,nt,nkik)+xdet(j1) do j2=1,8 if(ipartl.eq.2)tmatp(j1,j2,nt,nk)= 1 tmatp(j1,j2,nt,nk)+xpdet(j1)*xpdet(j2) if(ipartl.eq.3)tmate(j1,j2,nt,nk)= 1 tmate(j1,j2,nt,nk)+xedet(j1)*xedet(j2) tmats(j1,j2,nt,nk)=tmats(j1,j2,nt,nk)+ 1 xdet(j1)*xdet(j2) if(ipartl.eq.2)tmatp(j1,j2,nt,nkik)= 1 tmatp(j1,j2,nt,nkik)+xpdet(j1)*xpdet(j2) if(ipartl.eq.3)tmate(j1,j2,nt,nkik)= 1 tmate(j1,j2,nt,nkik)+xedet(j1)*xedet(j2) tmats(j1,j2,nt,nkik)=tmats(j1,j2,nt,nkik)+ 1 xdet(j1)*xdet(j2) end do end do end if end if end if end do end do return end