*-- Author : Stephen Burke
SUBROUTINE FTQUIC(NPCT,NRCT)
*-----------------------------------------Updates 07/09/93-------
**: FTQUIC 40000 SB. New deck to give a guess at no. of tracks.
*-----------------------------------------Updates----------------
***************************************************************
* *
* Quick pattern recognition in the forward tracker *
* *
* Input: *
* MINR - minimum number of hits to form a radial segment *
* *
* Output: *
* NPCT - number of candidate tracks in planar supermodules *
* NRCT - number of candidate tracks in radial supermodules *
* *
* NPCT and NRCT are arrays (0:2) indexed by supermodule no. *
* *
***************************************************************
*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 ------
*KEND.
CHARACTER*8 VERSQQ
DIMENSION NPPOSS(0:8),NPCT(0:2),NRCT(0:2)
*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))
*KEEP,FTFUNCT.
* Statement functions for RADIAL Chamber data access.
* Using Channel Number J
* Module, Wedge-pair and Z-plane numbers...
IRMOD(J) = J/288
IRWDP(J) = (J-IRMOD(J)*288)/12
IRZPL(J) = J-IRMOD(J)*288-IRWDP(J)*12
* Statement function for obtaining WEDGE numbers(0-47) of
* wires at plus and minus ends of Cell numbers
IRWPL(J) = (IRWDP(J)/2)*4 + (MOD(IRWDP(J),2))
IRWMI(J) = MOD(IRWPL(J) + 34,48)
* Statement function for obtaining IOS wire number (1-36)
IRIOSW(J) = IRMOD(J)*12 + IRZPL(J) + 1
* Statement functions for PLANAR Chamber data access.
* Using Channel Number J
* Module, orientation, W-cell and Z-plane numbers...
IPMOD(J) = J/384
IPORI(J) = (J-IPMOD(J)*384)/128
IPWCL(J) = (J-IPMOD(J)*384-IPORI(J)*128)/4
IPZPL(J) = (J-IPMOD(J)*384-IPORI(J)*128-IPWCL(J)*4)
* IPSMD in range 0:8 Planar module number.
IPSMD(J) = IPMOD(J)*3 + IPORI(J)
*
* IOS wire number (runs from 0 to 36)
IPIOSW(J) = IPSMD(J)*4 + IPZPL(J) + 1
* SB plane numbers (1-72) from cell number
IPSBW(J) = 24*IPMOD(J) + 4*IPORI(J) + IPZPL(J) + 1
IRSBW(J) = 24*IRMOD(J) + IRZPL(J) + 13
* Module, orientation, wire and (typical) cell number from plane
* number in the range 1-72 (planars, radials and combined)
IPMSB(J) = (J - 1)/24
IPOSB(J) = (J - 24*IPMSB(J) - 1)/4
IPZSB(J) = J - 24*IPMSB(J) - 4*IPOSB(J) - 1
IPCLSB(J) = 384*IPMSB(J) + 128*IPOSB(J) + IPZSB(J)
IRMSB(J) = (J - 1)/24
IRZSB(J) = J - 24*IRMSB(J) - 13
IRCLSB(J) = 288*IRMSB(J) + IRZSB(J)
IRADSB(J) = (J - 24*((J-1)/24) - 1)/12
ICELSB(J) = IRADSB(J)*IRCLSB(J) + (1 - IRADSB(J))*IPCLSB(J)
*KEND.
***************************************************************
* Module steering by MODULS
*KEEP,VERSQQ.
VERSQQ = ' 8.07/02'
IVERSQ = 80702
*KEND.
CALL MODULS('FTQUIC',IVERSQ,'FRREFRPE')
* Get right bank versions for MC events...
CALL FSETMC
IF(BEGRUN) THEN
* Rebook B16 input bank formats for the farm
CALL BKFMT('FRRE','B16')
CALL BKFMT('FRPE','B16')
CALL SETREC
CALL FPTINT
END IF
IF (REVENT) THEN
CALL FPLOCO
INFPHC = NLINK('FPHC',0)
IF (INFPHC.GT.0) THEN
NFPHC = IW(INFPHC+2)
CALL VZERO(NPPOSS(0),9)
DO 200 JCELL=0,NFPHC-1,4
NMIN1 = 999
NMIN2 = 999
DO 100 JWIRE=1,4
NHIT = IBTAB(INFPHC,1,JCELL+JWIRE)
IF (NHIT.LT.NMIN2) THEN
NMIN1 = NMIN2
NMIN2 = NHIT
ELSEIF (NHIT.LT.NMIN1) THEN
NMIN1 = NHIT
ENDIF
100 CONTINUE
IF (NMIN1.EQ.999) NMIN1 = NMIN2
IMOD = IPSMD(JCELL)
NPPOSS(IMOD) = NPPOSS(IMOD) + NMIN1
200 CONTINUE
NPCT(0) = MIN(NPPOSS(0),NPPOSS(1),NPPOSS(2))
NPCT(1) = MIN(NPPOSS(3),NPPOSS(4),NPPOSS(5))
NPCT(2) = MIN(NPPOSS(6),NPPOSS(7),NPPOSS(8))
ENDIF
CALL FRLOCO
INFRHC = NLINK('FRHC',0)
IF (INFRHC.GT.0) THEN
NFRHC = IW(INFRHC+2)
CALL VZERO(NRCT(0),3)
DO 400 JCELL=0,NFRHC-1,12
NMAX1 = 0
NMAX2 = 0
DO 300 JWIRE=1,12
NHIT = IBTAB(INFRHC,1,JCELL+JWIRE)
IF (NHIT.GT.NMAX2) THEN
NMAX1 = NMAX2
NMAX2 = NHIT
ELSEIF (NHIT.GT.NMAX1) THEN
NMAX1 = NHIT
ENDIF
300 CONTINUE
IF (NMAX1.EQ.0) NMAX1 = NMAX2
IMOD = IRMOD(JCELL)
NRCT(IMOD) = NRCT(IMOD) + NMAX1
400 CONTINUE
ENDIF
* Clean up
C CALL BGARB(IW)
C CALL WGARB(IW)
ENDIF
CALL FRSTMC
CALL MODULF
RETURN
END
*