*-- Author : Stephen J. Maxfield
SUBROUTINE FPOKER
**: FPOKER 40000 SM. New routine for calibration checking.
**----------------------------------------------------------------------
*KEEP,BCS.
INTEGER NHROW,NHCOL,NHLEN
PARAMETER (NHROW = 2, NHCOL = 1, NHLEN=2)
INTEGER NBOSIW
PARAMETER (NBOSIW=1000000)
INTEGER IW(NBOSIW)
REAL RW(NBOSIW)
COMMON /BCS/ IW
EQUIVALENCE (RW(1),IW(1))
SAVE /BCS/
*KEEP,BOSMDL.
C ------BOSMDL
LOGICAL BEGJOB,ENDRUN,BEGRUN,REVENT,ENDJOB,OTHDAT
COMMON/BOSMDL/BEGJOB,ENDRUN,BEGRUN,REVENT,ENDJOB,OTHDAT,
+ LCCRUN,NCCRUN,NEVENT,
+ IHA,IBS,IDB,IDATEL,LUP,ISN,JSN
SAVE /BOSMDL/
C ------
*KEEP,FRDIMS.
PARAMETER (MAXHTS=200)
PARAMETER (NUMWPL=36)
PARAMETER (MAXTRK=200)
PARAMETER (MXTTRK=900)
PARAMETER (MAXTR3=200)
PARAMETER (MAXHPW=2)
PARAMETER (MAXDIG=2000)
PARAMETER (NUMRWR=1727)
PARAMETER (NUMPWR=1151)
*KEEP,FH1WORK.
COMMON/FGMIOS/
* Planar geometry
+ ZPP(140),C(140),S(140),ITYPE(140),WZERO(140),WSPACE,
*
* Radial geometry
+ ZP(36),PHW(36),WS(36)
*
COMMON/H1WORK/
* Radial data...
+ WW(MAXHTS,36),DRI(MAXHTS,36),RM(MAXHTS,36),
+ NDP(36), NW(MAXHTS,36), DWS(MAXHTS,36),
*
* Planar Data
+ NDPW(NUMWPL),DW(MAXHTS,NUMWPL),
+ DRIW(MAXHTS,NUMWPL),NDW(MAXHTS,NUMWPL),
+ WWP(MAXHTS,NUMWPL),
+ IPHOLE(MAXHTS,NUMWPL),
*
* Pointers into DIGI bank for IOS labelled hits
+ IPFRRE(MAXHTS,36),IPFRPE(MAXHTS,36),NFRRE,NFRPE,
+ IRPIOS(MAXDIG,2), IPPIOS(MAXDIG,2),
*
* Track segment data
+ NTRAKS(3),IRPT(12,MAXTRK,3),SDRFT(12,MAXTRK,3),
*
* Fit data
+ PCOSL(MAXTRK,3),PSINL(MAXTRK,3),PHZL(MAXTRK,3),
+ DPCOSL(MAXTRK,3),DPSINL(MAXTRK,3),
+ DPHZL(MAXTRK,3),CHSQ(MAXTRK,3),RZI(MAXTRK,3),
+ RPCOSG(MAXTRK),RPSING(MAXTRK),
+ PHZG(MAXTRK),CC(3,MAXTRK),ZIG(MAXTRK),
+ IRADG(36,MAXTRK),PHIG(36,MAXTRK),
+ IG,SDRADG(36,MAXTRK),
+ R1,Z1,RFIT(MAXTRK,3),
+ CHG(MAXTRK),
+ PPA(MAXTRK,3), ZZA(MAXTRK,3),
+ GPA(MAXTRK,3),GZA(MAXTRK,3)
*
*
*KEEP,FDIFLG.
COMMON/LDIAG/IDIAG,IDIAG2,MAXPRT,IDOHIS,PMCUT
*KEND.
COMMON/FPKSTA/ITOTAN,IRUNLA
* COMMONs for planar found tracks
COMMON/FTPPBK/NPP,IPP(36,100),CHPP(100),LP(3,100)
COMMON/FTPPBS/SPP(36,100)
COMMON/FPPFIT/PSSS(100),PISS(100),RSSS(100),RISS(100)
* Pointers to radials associated with planar tracks
COMMON/FTRRBK/IRR(36,MAXTRK),SRR(36,MAXTRK),LRR(3,MAXTRK)
* Tan of 1/2 wedge angle...
PARAMETER (TANWED=0.065543)
* Binning parameters for histograms...
PARAMETER (DPMAX=5.0)
PARAMETER (NBIN=200)
PARAMETER (NBLOR=40)
PARAMETER (BINTOD=2.0*DPMAX/NBIN)
PARAMETER (BINLOR=2.0*DPMAX/NBLOR)
PARAMETER (MXSIDE=1)
LOGICAL FIRST/.TRUE./
DATA RMIN/25.0/
DATA RMAX/99.0/
DATA RMAXL/55.0/
* Statement functions for TABLE access...
*KEEP,STFUNCT.
* index of element before row number IROW
INDR(IND,IROW)=IND+2+IW(IND+1)*(IROW-1)
* index of L'th element of row number IROW
INDCR(IND,L,IROW)=INDR(IND,IROW) + L
* L'th integer element of the IROW'th row of bank with index IND
IBTAB(IND,L,IROW)=IW(INDCR(IND,L,IROW))
* L'th real element of the IROW'th row of bank with index IND
RBTAB(IND,L,IROW)=RW(INDCR(IND,L,IROW))
*KEND.
IF(FIRST)THEN
* Book LOOK histograms
FIRST = .FALSE.
ITOTAN = 0
ITOTHT = 0
* Histograms for t-to-d...
DO KBIN = 1, NBIN
DLO = -DPMAX + (KBIN-1) * BINTOD
DHI = DLO + BINTOD
DO KSIDE = 1, MXSIDE
KHIS1 = KBIN + KSIDE*2000
KHIS2 = KBIN + KSIDE*2000 + 1000
CALL BHS(KHIS1, 0, 200, -DPMAX, DPMAX)
CALL BHS(KHIS2, 0, 20, DLO, DHI)
ENDDO
ENDDO
* Histograms for Lorentz angle...
DO KBIN = 1, NBLOR
DLO = -DPMAX + (KBIN-1) * BINLOR
DHI = DLO + BINLOR
KHIS3 = KBIN + 10000
KHIS4 = KBIN + 11000
CALL BHS(KHIS3, 0, 100, -50., 50.)
CALL BHS(KHIS4, 0, 20, DLO, DHI)
ENDDO
ENDIF
ITOTAN = ITOTAN + 1
IRUNLA = NCCRUN
* NPP is number of planar-based tracks...
IF (NPP.EQ.0)RETURN
* Hit data...
INFRLC = MLINK(IW,'FRLC',0)
IF(INFRLC .EQ. 0) RETURN
* Auxiliary hit data...
INFAUX = MLINK(IW,'FAUX',0)
IF(INFAUX .EQ. 0) RETURN
* Loop over planar-based tracks...
DO 700 I=1,NPP
* Which PLANAR supermodules have the hits on the track. Actually
* always have a full segments worth (9-12 hits) or none at all
* so this is overkill!
IP1=0
IP2=0
IP3=0
DO 720 IP=1,36
J=IPP(IP,I)
IF(J.EQ.0)GOTO720
IF(IP.GE.01.AND.IP.LE.12)IP1=1
IF(IP.GE.13.AND.IP.LE.24)IP2=1
IF(IP.GE.25.AND.IP.LE.36)IP3=1
720 CONTINUE
* Loop over the radial hits on this track. Only mods 0 and 1
DO 710 IP=1,24
* Radial hit on this track?
J=IRR(IP,I)
IF(J.EQ.0)GOTO710
* Accept 'sandwich' configurations only...
IF( ( (IP.LE.12).AND.(IP1*IP2.NE.0) ) .OR.
+ ( (IP.GT.12).AND.(IP2*IP3.NE.0) ) ) THEN
* Get Phi and R at this wire plane from Phi-z R-z fit parameters.
PHI = PSSS(I)*ZP(IP)+PISS(I)
RAD = RSSS(I)*ZP(IP)+RISS(I)
* Limit radius range.
IF(RAD.GE.RMIN .AND. RAD .LT. RMAX) THEN
* Predicted drift...corrected for stagger.
DRP = RAD * SIN(PHI-WW(J,IP)) - DWS(J,IP)
* Predicted radius along wire direction (if no Lorenz angle)
RRP = RAD * COS(PHI-WW(J,IP))
* Get max allowed drift (Position of cathode plane less a
* 3mm tolerance)...
DRMAX = SQRT(RAD**2 - DRP**2) * TANWED - 0.3
* ...and cut out region near cathode.
IF(ABS(DRP) .LE. DRMAX) THEN
* Drift time, corrected for T0 and radius and pre-scaled
* by approx from F0R8.
KDIG = IPFRRE( J,IP)
DTSCA = RBTAB(INFAUX, 1, KDIG) * SRR(IP,I)
* ...and radius of hit at wire from Charge division
RRM = RBTAB(INFRLC, 4, KDIG)
* (Predicted radius at wire if no Lorentz angle) - (measured
* radius)
DRR = RRP - RRM
* ...slope of DRR vs. predicted drift is tan(alpha).
* Fill histograms of slices in predicted drift.
KBIN = 1 + IFIX( (DRP + DPMAX) / BINTOD)
KBINL = 1 + IFIX( (DRP + DPMAX) / BINLOR)
IF (KBIN.GE.1 .AND.KBIN.LE.NBIN) THEN
ITOTHT = ITOTHT + 1
CALL SHS(2000+KBIN, 0, DTSCA)
CALL SHS(3000+KBIN, 0, DRP)
ENDIF
IF (KBINL.GE.1 .AND. KBINL.LE.NBLOR) THEN
CALL SHS(10000+KBINL, 0, DRR)
CALL SHS(11000+KBINL, 0, DRP)
ENDIF
ENDIF
ENDIF
ENDIF
*---------------
710 CONTINUE
* ...end loop over radial hits
700 CONTINUE
* ...end loop over planar based tracks.
* Write(6,*) ' Fpoker hits', ITOTHT
RETURN
END
*