*-- Author : I.O.SKILLICORN
SUBROUTINE FRPKPL
**----------------------------------------------------------------------
*
* Pick up planar segments on radial-based tracks
* I.O.Skillicorn
* Array Dimensions...
*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,FDIFLG.
COMMON/LDIAG/IDIAG,IDIAG2,MAXPRT,IDOHIS,PMCUT
*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---
*KEND.
*
*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)
*
*
*KEND.
*SUNDRY VERTICES...
*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,FRWERR.
COMMON /WERR/ERRVL,ERRV,ERRP,ERRRX
*KEEP,FPTFLG.
COMMON/FPTFLG/IPLAR, NIT, IREZ, LUNFP, NPLMAX
*KEEP,FPTPAR.
COMMON/FPTPAR/PCUT1, PCUT2, PCUT3, CXP, CYP,
+ DRPCT1, DRPCT2, DRPCT3,
+ DRCUT1, DRCUT2, DRCUT3
*KEND.
* FTTRAC Results.
*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)
*KEND.
*
COMMON /FLINK3/LNK3(MAXTRK,3)
COMMON/CORRXY/CX1,CX2,CX3,CY1,CY2,CY3
* Common for track parameter errors...
COMMON /FTRERR/ DSLPHI, DPHZER, COVP, DSLPR, DRZER, COVR
COMMON/FERROR/ERRDR(MAXHTS, 36), ERRRM(MAXHTS, 36),
+ ERPDR(MAXHTS, 36), IERRF(MAXHTS, 36),
+ IERPF(MAXHTS, 36)
COMMON /FPSEG1/ ISGG(3,MAXTRK)
* LOCAL ARRAYS...
DIMENSION IUSED(MAXHTS,36) ,IUSEDP(MAXHTS,36)
DIMENSION IUSEG( MAXSEG, 3)
* ADDED FOR COVARIANCE MATRIX
DIMENSION TCOV(15), RCOV(15)
DIMENSION NNOP(48)
CHARACTER*15 FTEXT1
CHARACTER*27 FTEXT
CHARACTER*27 FTEXT2
PARAMETER(PHII=0.130899693)
PARAMETER(HPHII=PHII/2.)
PARAMETER(PI2=6.2831853)
* Location of endwall...
PARAMETER(ZWALL=132.95)
* Nominal error on x-y vertex...
PARAMETER(SVER=0.02)
* Cut to exclude poorly parameterised tracks...
PARAMETER(DRHLCT=3.0)
PARAMETER(IVDRF=4)
PARAMETER(FQFAC=10000.)
LOGICAL FIRST
*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.
DATA FIRST/.TRUE./
IF(FIRST) THEN
FIRST = .FALSE.
WRITE(6,'(///,5X,''FTREC: New version of FTREC used'')')
IQF0R8 = NAMIND('F0R8')
ENDIF
* Zero Hit lists,signs etc.
CALL VZERO(SDN, MAXTRK*36)
CALL VZERO(SDP, MAXTRK*36)
CALL VZERO(IRP, MAXTRK*36)
CALL VZERO(IRN, MAXTRK*36)
CALL VZERO(IUSED, MAXHTS*36)
CALL VZERO(IUSEDP,MAXHTS*36)
CALL VZERO(IUSEG, MAXSEG*3)
CALL VZERO(ISGG, MAXTRK*3)
CALL VZERO(IGTTRK,MAXTRK)
*******************************************
* Begin Main loop over linked tracks...
NTRK12=0
NTRK23=0
NTRK13=0
NTRK3 =0
DO 100 K=1,IG
* Build list of radial points on the track...
MOD3=0
M1=LNK3(K,1)
M2=LNK3(K,2)
M3=LNK3(K,3)
*-----Debug---------------------------------------------------
* Write(6,'('' FRPKPL>>>'',I4,6X,3I4)')K,M1,M2,M3
IF(M1*M2*M3.NE.0) THEN
MOD3=1
NTRK3 = NTRK3 + 1
ELSEIF(M1*M2.NE.0) THEN
NTRK12= NTRK12 + 1
ELSEIF(M2*M3.NE.0) THEN
NTRK23= NTRK23 + 1
ELSEIF(M1*M3.NE.0) THEN
NTRK13= NTRK13 + 1
ELSE
ENDIF
IFIRR = 0
ZMINR = 10000.
DO 656 KK=1,3
I=LNK3(K,KK)
IF(I.EQ.0)THEN
DO 657 KKK=1,12
KP=12*(KK-1)+KKK
IRN(KP,K)=0
657 CONTINUE
ELSE
DO 658 KKK=1,12
KP=12*(KK-1)+KKK
IKK =IRPT(KKK,I,KK)
IF(IKK.NE.0) THEN
IF(IUSED(IKK,KP) .EQ. 0) THEN
IF(IFIRR.EQ.0) THEN
IFIRR=KP
ZMINR=ZP(KP)
ENDIF
IRN(KP,K)=IRPT(KKK,I,KK)
SDN(KP,K)=SDRFT(KKK,I,KK)
IUSED(IRN(KP,K),KP)=1
ENDIF
ENDIF
658 CONTINUE
ENDIF
656 CONTINUE
100 continue
*-----Debug---------------------------------------------------
* WRITE(*,*)' ***FRPKPLA** '
* WRITE(*,*)IG,' RADIAL TRACKS '
* PRINT 1001,K,(IRN(J,K),J=1,36),LNK3(K,1),LNK3(K,2),LNK3(K,3)
* PRINT 1002,K,(IRP(J,K),J=1,36),ISGG(1,K),ISGG(2,K),ISGG(3,K)
*1001 FORMAT(' RR',I2,3X,12I2,3X,12I2,3X,12I2,2X,3I2)
*1002 FORMAT(' RP',I2,3X,12I2,3X,12I2,3X,12I2,2X,3I2)
*-----Debug---------------------------------------------------
c pick up planar line segments
CALL FPLPKS( IUSEDP, IUSEG)
c refit r-z, phi-z radials + planars
call frefit
RETURN
END
*