*-- Author : I. O. Skillicorn 16/11/92
SUBROUTINE FPLPKP
**: FPLPKP 40000 RP. New debug histos kicked out on the farm!
**: FPLPKP 40000 SM. New debug histos.
**----------------------------------------------------------------------
**: FPLPKP 30907 RP. Farm changes.
**----------------------------------------------------------------------
*
* Routine to organise linking of planar segments
* to form planar-based tracks and to pick up
* radial line-segments
*
*
*MOD SJM. Add section to fill planar drift signs (moved from FTADD)
*MOD SJM. Ensure radial segments only used once!
*
*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,FPTVTX.
COMMON/VERTVV/ZV ,XVV,YVV
**the common/VERTEX/ becomes /VERTVV/ (in analogy to /VERTFF/) on the
** 17/6/91, since it is in conflict with the VERTEX module (g.bernardi)
** (note that all these common names should start by F in this deck...)
*KEEP,FRH3FT.
* Common for RETRAC results (SJM)
COMMON/FRH3FT/ IRN(36,MAXTRK),SDN(36,MAXTRK),
+ IRP(36,MAXTRK),SDP(36,MAXTRK),
+ IG2,IGTTRK(MAXTRK),
+ CHISQ(MAXTRK),NUMDF(MAXTRK),
+ FITX(MAXTRK),FITY(MAXTRK),FITZ(MAXTRK),
+ FITTH(MAXTRK),FITPH(MAXTRK),
+ FITCU(MAXTRK),FTCOV(15,MAXTRK)
*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,FPLSEG.
C---
COMMON /FPLSEG / PW(12,MAXSEG,3) , PWC(12,MAXSEG,3) ,
1 PRCHI(MAXSEG,3) , NFSEG(3) ,
2 XYDXY(4,MAXSEG,3) , EXYDXY(4,4,MAXSEG,3) ,
3 ZSEG(2,MAXSEG,3) ,
4 ASEGIN(MAXSEG,3) , ISEGIN(5,MAXSEG,3) ,
5 MASKSG(MAXSEG,3) , IDGISG(12,MAXSEG,3)
C---
*KEEP,FPTFLG.
COMMON/FPTFLG/IPLAR, NIT, IREZ, LUNFP, NPLMAX
*KEEP,FPTPAR.
COMMON/FPTPAR/PCUT1, PCUT2, PCUT3, CXP, CYP,
+ DRPCT1, DRPCT2, DRPCT3,
+ DRCUT1, DRCUT2, DRCUT3
*KEEP,FDIFLG.
COMMON/LDIAG/IDIAG,IDIAG2,MAXPRT,IDOHIS,PMCUT
*KEND.
* COMMON FOR IOS PLANAR LINK
COMMON/FTPS3/NS(3),SPAR(4,50,3),IPT(12,50,3),IPLA(12,50,3),
1 SGN(12,50,3),YYS(12,50,3),YYF(12,50,3)
COMMON/FTPPBK/NPP,IPP(36,100),CHPP(100),LP(3,100)
COMMON/FPPFIT/PSSS(100),PISS(100),RSSS(100),RISS(100)
COMMON/FPLNK/KTIP(3,50),LPP(3,100)
C COMMON FOR RADIALS ASSOCIATED WITH PLANAR TRACKS
COMMON/FTRRBK/IRR(36,MAXTRK),SRR(36,MAXTRK),LRR(3,MAXTRK)
C PLANAR SEGMENTS ASSOCIATED WITH RADIALS
COMMON /FPSEG1/ ISGG(3,MAXTRK)
COMMON /FLINK3/LNK3(MAXTRK,3)
COMMON/FTRSUS/IRUSED(3,100)
*KEEP,FPSTSG.
COMMON/FPSTSG/ NSTC(9),NFSSEG(3),NFTSEG(3)
C---
*KEND.
COMMON/fsegtp/iseg(100,3)
* Local arrays...
PARAMETER(PI2=6.2831853)
DATA ISTART/0/
* Zero used radial segment array. Note that radial segment may
* have been used already on a radial-based trac. Such ambiguities
* are removed later in FTMERG.
CALL VZERO(IRUSED,300)
call vzero(irr,3*maxtrk)
call vzero(srr,3*maxtrk)
C
C--- Loop over supermodules
C
DO 10 ISM = 1,3
NS(ISM)=0
K=0
KK=0
CDEB WRITE(*,*)' ISM NFSEG ',ISM,NFSEG(ISM)
C
C--- Loop over planar segments. Fill Arrays
C
c number of primary segs
npris=nfseg(ism)-nfsseg(ism)-nftseg(ism)
c number primary +secondary
npriss=npris+nfsseg(ism)
DO 20 IP = 1,NFSEG(ISM)
C
C--- search only the disconnected set
C
IF( MASKSG(IP,ISM) .NE. 0 )GO TO 20
CALL SHS(765,0,FLOAT(ISM))
C
C--- EXTRACT PLANAR SEGMENT
C
K=K+1
KK=KK+1
IF(K.GT.MAXTRK)GOTO20
IF(KK.LE.50)THEN
c set segment flags and note that max number of segments is 50
if(ip.le.npris)iseg(kk,ism)=1
if(ip.gt.npris.and.ip.le.npriss)iseg(kk,ism)=2
if(ip.gt.npriss)iseg(kk,ism)=3
C FILL IOS PARAMETERS FOR LINK
C DY/DZ Y DX/DZ X
SPAR(1,KK,ISM)=XYDXY(4,IP,ISM)
SPAR(2,KK,ISM)=XYDXY(2,IP,ISM)/10.
SPAR(3,KK,ISM)=XYDXY(3,IP,ISM)
SPAR(4,KK,ISM)=XYDXY(1,IP,ISM)/10.
C IOS TO RCWH NUMBER LINK
C WRITE(*,*)' ISM ROB IOS #',ISM,IP,KK
KTIP(ISM,KK)=IP
NS(ISM)=KK
C FILL POINT BANK AND SIGN
FPTS=0.01
DO 100 IW=1,12
IOSP=IDGISG(IW,IP,ISM)
IF(IOSP.NE.0)FPTS=FPTS+1.
IPT(IW,KK,ISM)=IABS(IOSP)
SGN(IW,KK,ISM)= SIGN(1.0, FLOAT(IOSP))
100 CONTINUE
CALL SHS(764,0,FPTS)
C PRINT 2000,ISM,IP,KK,(IPT(IWW,KK,ISM),IWW=1,12)
2000 FORMAT(' ISM,R,IOS ',2I3,3X,12I2)
ENDIF
C
C--- End of loop over planars segments for supermodule
C
20 CONTINUE
IF(KK.NE.0)CALL SHS(720+ISM,0,FLOAT(KK)+0.01)
C
C--- End of loop over supermodules
C
10 CONTINUE
C CALL ROUTINES TO LINK SEGMENTS
CALL FPPJN3
CALL FPPJ12
CALL FPPJ23
CALL FPPJ13
C LIST LINKS
CALL SHS(560,0,FLOAT(NPP)+0.01)
IF(NPP.NE.0)THEN
DO 200 I=1,NPP
IP1=0
IP2=0
IP3=0
IF(LP(1,I).NE.0)IP1=KTIP(1,LP(1,I))
IF(LP(2,I).NE.0)IP2=KTIP(2,LP(2,I))
IF(LP(3,I).NE.0)IP3=KTIP(3,LP(3,I))
* PRINT 1001,I,(IPP(II,I),II=1,36),CHPP(I),IP1,IP2,IP3
C STORE RCWH POINTERS
LPP(1,I)=IP1
LPP(2,I)=IP2
LPP(3,I)=IP3
C zero radial pointers
LRR(1,I)=0
LRR(2,I)=0
LRR(3,I)=0
200 CONTINUE
ENDIF
C END OF LINK SECTION
c pick up radials
CALL FPKPKR
*-----Debug---------------------------------------------------
* WRITE(*,*)' ***FPLPKP*** '
* WRITE(*,*)IG,' RADIAL TRACKS '
*-------------------------------------------------------------
*-----Debug---------------------------------------------------
* DO 300 I=1,IG
* PRINT 1001,I,(IRN(K,I),K=1,36),LNK3(I,1),LNK3(I,2),LNK3(I,3)
* PRINT 1002,I,(IRP(K,I),K=1,36),ISGG(1,I),ISGG(2,I),ISGG(3,I)
*300 CONTINUE
*-------------------------------------------------------------
*-----Debug---------------------------------------------------
* WRITE(*,*)NPP,' PLANAR TRACKS '
DO 310 I=1,NPP
C
IF(LPP(1,I).NE.0)CALL SHS(766,0,11.01)
IF(LPP(2,I).NE.0)CALL SHS(766,0,12.01)
IF(LPP(3,I).NE.0)CALL SHS(766,0,13.01)
C
IF(LPP(1,I)*LPP(2,I)*LPP(3,I).NE.0)THEN
CALL SHS(766,0, 1.01)
ENDIF
IF(LPP(1,I)*LPP(2,I).NE.0.AND.LPP(3,I).EQ.0)THEN
CALL SHS(766,0, 2.01)
ENDIF
IF(LPP(2,I)*LPP(3,I).NE.0.AND.LPP(1,I).EQ.0)THEN
CALL SHS(766,0, 3.01)
ENDIF
IF(LPP(1,I)*LPP(3,I).NE.0.AND.LPP(2,I).EQ.0)THEN
CALL SHS(766,0, 4.01)
ENDIF
* PRINT 1004,I,(IRR(K,I),K=1,36),LRR(1,I),LRR(2,I),LRR(3,I)
* PRINT 1003,I,(IPP(K,I),K=1,36),LPP(1,I),LPP(2,I),LPP(3,I)
310 CONTINUE
*-------------------------------------------------------------
1001 FORMAT(' RR',I2,3X,12I2,3X,12I2,3X,12I2,2X,3I2)
1002 FORMAT(' RP',I2,3X,12I2,3X,12I2,3X,12I2,2X,3I2)
1003 FORMAT(' PP',I2,3X,12I2,3X,12I2,3X,12I2,2X,3I2)
1004 FORMAT(' PR',I2,3X,12I2,3X,12I2,3X,12I2,2X,3I2)
RETURN
END
*