*-- Author : S.J. Maxfield
SUBROUTINE FPUDAT
**: FPUDAT 40000 SM. New definition of dead wire flag.
**----------------------------------------------------------------------
**: FPUDAT 30907 RP. Farm changes.
C------------------------------------------------------------------
*
* Unpack Digitisations from bank FRPE.
* Create intermediate bank FPLC containing local
* coordinates
*
* Store hits in PLANAR H1WORK for Pattern Recognition
*
* Called once per event. Needs previous call to FTCORG
* to create corrected geometry bank FPG1
*
*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,CNSTBF.
INTEGER LW(NBOSIW)
REAL SW(NBOSIW)
EQUIVALENCE (RW(1),IW(1),LW(1),SW(1))
*KEEP,FPPRAM.
C
C--- MAXSEG is maximum number of segments per supermodule
C--- MAXCON is maximum number of amibiguous segments associatable with
C--- one segment
C--- LIMSTO is maximum number of 2 cluster planes intersections to be
C--- stored per supermodule
C--- MSEGLM is maximum number of clusters that can be found before
C--- connectivity considered
C--- MAXCLU is maximum number of clusters that can be found after
C--- forming non-connected set MUST BE 50 IF RUN WITH OLD RCW
C--- (cluster = 3/4 digits found in a straight line in one
C--- 4-wire orientation)
C
PARAMETER (MAXSEG = 200)
PARAMETER (MAXCON = 100)
PARAMETER (LIMSTO = 5000)
PARAMETER (MSEGLM = 150)
PARAMETER (MAXCLU = 50)
C---
*KEEP,FPH1WRK.
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)
LOGICAL DRMASK
COMMON /H1WORK/
C-- *KEEP,FPCSEG.
C---
3 TPNORM(3,9,MAXCLU), PCONST(9,MAXCLU) ,
4 SMLS(4,2,LIMSTO,3) ,
C---
C-- *KEEP,FPDIGI.
5 DRSTO(MSEGLM,4),NDRSTO(4),
6 IDIGST(4,MSEGLM),
7 SEGTAB(MSEGLM,MSEGLM),DRMASK(MSEGLM,4),
8 IDCELL(MSEGLM,4),
9 NSGTAB(MSEGLM),ASGTAB(MSEGLM),
A RESSTO(MSEGLM,4) ,
C---
C-- *KEEP,FPDGI.
B IDGIST(MSEGLM,4),IDGISM(4,9,MAXCLU)
C ,RCHI(MAXSEG,3) ,
C---
C-- *KEEP,FPSTID.
D IDRSTO(MSEGLM,4),IDYUV(4,9,MSEGLM),
E IDYUVS(12,MAXSEG,3),FREQ(MSEGLM+1) ,
C---
C-- *interface to real data
F NDPW(NUMWPL),DW(MAXHTS,NUMWPL),DWG(MAXHTS,NUMWPL),
G DRIWP(MAXHTS,NUMWPL),DRIWM(MAXHTS,NUMWPL),
G DRIW(MAXHTS,NUMWPL),IPHOLE(MAXHTS,NUMWPL),
H IPFRPE(MAXHTS,36), IPPIOS(MAXDIG,2)
C---.
*KEND.
* Max allowable bad hit flag...(To be gotten from bank sometime)
PARAMETER(IFRBAD=128)
PARAMETER(NBN=0)
* Locators for FPG1 bank
PARAMETER(IPDEAD=1)
PARAMETER(IPPPHP=2)
PARAMETER(IPPSTP=3)
* Locators for FPLC bank
PARAMETER(IPPCLN=1)
PARAMETER(IPPDRF=2)
PARAMETER(IPPERD=3)
PARAMETER(IPPERF=4)
PARAMETER(IPPCHG=5)
COMMON/FERROR/ERRDR(MAXHTS, 36), ERRRM(MAXHTS, 36),
+ ERPDR(MAXHTS, 36), IERRF(MAXHTS, 36),
+ IERPF(MAXHTS, 36)
COMMON/FPCHAR/FPCHG(MAXHTS, 36)
LOGICAL FIRST
DATA FIRST/.TRUE./
*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,STFCLW.
* statement functions acting on the BOS COMMON LW
* index of element before row number LWROW
LNDR(LND,LWROW) = LND + 2 + LW(LND+1)*(LWROW-1)
* index of L-th element of row number LWROW
LNDCR(LND,L,LWROW)=LNDR(LND,LWROW)+L
* L-th integer element of the LWROW'th row in bank with index LND
LBTAB(LND,L,LWROW)=LW(LNDCR(LND,L,LWROW))
* L-th real element of the LWROW'th row in bank with index LND
SBTAB(LND,L,LWROW)=SW(LNDCR(LND,L,LWROW))
*
*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.
*-------------------------------------------------------------------
IF(FIRST) THEN
FIRST = .FALSE.
IQFPLC = NAMIND('FPLC')
IQFPG1 = NAMIND('FPG1')
ENDIF
CALL VZERO(NDPW,NUMWPL)
*
IFPLC = IW(IQFPLC)
IFPG1= IW(IQFPG1)
IF(IFPG1.EQ.0) THEN
CALL ERRLOG(118,'S:FPUDAT: FPG1 bank not found')
RETURN
ENDIF
IF(IFPLC.EQ.0) THEN
RETURN
ENDIF
NFPLC = IW(IFPLC+2)
IF(NFPLC.LE.0) THEN
RETURN
ENDIF
* Extract Hits...
NACHIT = 0
DO 300 K= 1, NFPLC
ICLNUM= IBTAB(IFPLC,IPPCLN,K)
IDEAD = LBTAB(IFPG1,IPDEAD,ICLNUM+1)
IF(IDEAD .NE. 1) THEN
DRIFT = RBTAB(IFPLC,IPPDRF,K)
DRIFTP= RBTAB(IFPLC,6,K)
DRIFTM= RBTAB(IFPLC,7,K)
CHARGE= RBTAB(IFPLC,IPPCHG,K)
ERRDRF= RBTAB(IFPLC,IPPERD,K)
ISGNW = IBTAB(IFPLC,IPPERF,K)
IF(ISGNW .LT. IFRBAD) THEN
NACHIT = NACHIT + 1
* IOS wire planes numbered 1-36 through 3 Modules
KWIR = IPIOSW(ICLNUM)
* increment number of hits in this wire plane...
NDPW(KWIR) = NDPW(KWIR) + 1
IF(NDPW(KWIR) .GT. MAXHTS) THEN
CALL ERRLOG(102,'W:FPTPDT: MAX HITS exceeded ')
NDPW(KWIR) = NDPW(KWIR) - 1
ELSE
* W-coordinate of wire...
DW ( NDPW(KWIR), KWIR) = SBTAB(IFPG1,IPPSTP,ICLNUM+1)
DWG( NDPW(KWIR), KWIR) = SBTAB(IFPG1,5,ICLNUM+1)
* Drift in W, Error, flag...
DRIW( NDPW(KWIR), KWIR) = DRIFT
DRIWP( NDPW(KWIR), KWIR) = DRIFTP
DRIWM( NDPW(KWIR), KWIR) = DRIFTM
ERPDR( NDPW(KWIR), KWIR) = ERRDRF
IERPF( NDPW(KWIR), KWIR) = ISGNW
FPCHG( NDPW(KWIR), KWIR) = CHARGE
* W-cell number of this hit...
KWCL = IPWCL(ICLNUM)
*
IF(KWCL.LE.15.AND.KWCL.GE.10)THEN
IPHOLE(NDPW(KWIR),KWIR) = 1
ELSE IF(KWCL.LE.21.AND.KWCL.GE.16)THEN
IPHOLE(NDPW(KWIR),KWIR) = -1
ELSE
IPHOLE(NDPW(KWIR),KWIR) = 0
ENDIF
* relations between IOS labelling and FRRE bank...
IPFRPE(NDPW(KWIR),KWIR) = K
IF(K.LE.MAXDIG) THEN
IPPIOS(K,1) = KWIR
IPPIOS(K,2) = NDPW(KWIR)
ENDIF
ENDIF
ENDIF
ENDIF
300 CONTINUE
RETURN
END
*