*-- Author : I.O.Skillicorn
SUBROUTINE FTPRTR
**: FTPRTR 30907 RP. Farm changes.
**----------------------------------------------------------------------
*
* Calculate track parameters and fill lists of hits for the
* Single-Planar extrapolated tracks.
*
*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,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---
*KEND.
COMMON /FPSEG1/ ISGG(3,MAXTRK)
COMMON /FPSEG2/ ISGP(3,MAXTRK),IUZP(MAXSEG,3),IUZR(MAXTRK,3)
COMMON /FPSEG3/ ISGR(3,MAXSEG)
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)
COMMON /FPLNK/ KTIP(3,50),LPP(3,100)
COMMON /FTRRBK/ IRR(36,MAXTRK),SRR(36,MAXTRK),LRR(3,MAXTRK)
COMMON /FLINK3/LNK3(MAXTRK,3)
COMMON/FKLOC/KLOC(100)
COMMON/FEVSAT/IEVSAT
DIMENSION PSEG(4)
PARAMETER (PI2=6.2831853)
*
* Single planar module associated with one or more radial modules
DO 350 ISMP=1,3
DO 360 IP=1,NFSEG(ISMP)
IF(ISGR(ISMP,IP).EQ.0)GOTO360
CALL SHS(712,0,10.0)
CALL SHS(716,0,10.0)
NPP=NPP+1
IF(NPP.GT.100) THEN
NPP = 100
IEVSAT = 1
ENDIF
KLOC(NPP) = 5
C RADIAL POINTERS
LRR(1,NPP)=0
LRR(2,NPP)=0
LRR(3,NPP)=0
C PLANAR POINTERS
LPP(1,NPP)=0
LPP(2,NPP)=0
LPP(3,NPP)=0
DO 361 II=1,36
IPP(II,NPP)=0
361 IRR(II,NPP)=0
NRR=0
DO 366 ISM=1,3
IF(ISM.EQ.1)THEN
K3=ISGR(ISMP,IP)/10000
K2=(ISGR(ISMP,IP)-10000*K3)/100
K1=ISGR(ISMP,IP)-10000*K3-100*K2
ENDIF
IF(ISM.EQ.3)K=K3
IF(ISM.EQ.2)K=K2
IF(ISM.EQ.1)K=K1
IF(ISM.EQ.1)THEN
IF(ISMP.EQ.2.AND.K1 .NE.0)CALL SHS(712,0,1.01)
IF(ISMP.EQ.3.AND.K2 .NE.0)CALL SHS(712,0,3.01)
IF(ISMP.EQ.1.AND.K1 .NE.0)CALL SHS(712,0,5.01)
IF(ISMP.EQ.2.AND.K2 .NE.0)CALL SHS(712,0,7.01)
IF(ISMP.EQ.3.AND.K3 .NE.0)CALL SHS(712,0,9.01)
ENDIF
IF(K.EQ.0)GOTO366
NRR=NRR+1
LRR(ISM,NPP)=K
DO 362 II=1,12
IRR(II+(ISM-1)*12,NPP)=IRPT(II,K,ISM)
SRR(II+(ISM-1)*12,NPP)=SDRFT(II,K,ISM)
362 CONTINUE
366 CONTINUE
C NUMBER RADS/SINGLE PLANAR
CALL SHS(712,0,FLOAT(NRR)+20.01)
LPP(ISMP,NPP)=IP
DO 365 II=1,12
IOSP=IDGISG(II,IP,ISMP)
IPP(II+(ISMP-1)*12,NPP)=IABS(IOSP)
SPP(II+(ISMP-1)*12,NPP)=SIGN(1.0,FLOAT(IOSP))
365 CONTINUE
DO 363 II=1,4
PSEG(II)=XYDXY(II,IP,ISMP)
363 CONTINUE
C FILL BANKS WITH STR LINES THROUGH PLANARS
C DISTANCES IN MM HERE FOR RCWH
Z1MM=ZPP(1+12*(ISMP-1))*10.
Z2MM=ZPP(12+12*(ISMP-1))*10.
X1=PSEG(1)+Z1MM*PSEG(3)
Y1=PSEG(2)+Z1MM*PSEG(4)
X2=PSEG(1)+Z2MM*PSEG(3)
Y2=PSEG(2)+Z2MM*PSEG(4)
R1=SQRT(X1**2+Y1**2)
R2=SQRT(X2**2+Y2**2)
P1=ATAN2(Y1,X1)
P1=AMOD(P1,PI2)
IF(P1.LT.0.)P1=P1+PI2
P2=ATAN2(Y2,X2)
P2=AMOD(P2,PI2)
IF(P2.LT.0.)P2=P2+PI2
DP=P1-P2
IF(DP.GT.6.0)DP=DP-PI2
IF(DP.LT.-6.0)DP=DP+PI2
C BACK TO CMS
RSSS(NPP)=(R1-R2)/(Z1MM-Z2MM)
RISS(NPP)=(R1-RSSS(NPP)*Z1MM)/10.
PSSS(NPP)= DP*10./(Z1MM-Z2MM)
PISS(NPP)=(P1-PSSS(NPP)*Z1MM/10.)
C
* PRINT 2000,ISM,ISMP,K,ISGP(ISM,K),
* 1 (IRPT(I,K,ISM),I=1,12),
* 1 (IABS(IDGISG(II,IP,ISMP)),II=1,12)
360 CONTINUE
350 CONTINUE
* From now on, this is diagnostic stuff...
*
C COUNT UNUSED SEGMENTS
DO 370 ISM=1,3
NSS=0
DO 371 I=1,NFSEG(ISM)
IF(MASKSG(I,ISM).NE.0)GOTO 371
NSS=NSS+1
CALL SHS(714,0,FLOAT(15+ISM)+0.01)
IF(IUZP(I,ISM).NE.0)GOTO371
CALL SHS(714,0,FLOAT( 5+ISM)+0.01)
371 CONTINUE
C WRITE(*,*)' MOD,#SEGS ',ISM,NSS
DO 372 I=1,NTRAKS(ISM)
CALL SHS(714,0,FLOAT(10+ISM)+0.01)
IF(IUZR(I,ISM).NE.0)GOTO372
CALL SHS(714,0,FLOAT(ISM)+0.01)
372 CONTINUE
370 CONTINUE
C CHECK PLANAR EFFICIENCY FOR R1-R2 TRACKS
DO 380 K=1,IG
IF(LNK3(K,1)*LNK3(K,2).NE.0)THEN
CALL SHS(715,0,1.01)
C R1-R2 TRACK
IF(ISGG(2,K).NE.0)THEN
C P2 PRESENT
CALL SHS(715,0,2.01)
ENDIF
IF(ISGG(3,K).NE.0)THEN
C P3 PRESENT
CALL SHS(715,0,3.01)
ENDIF
ENDIF
C CHECK PLANAR EFFICIENCY FOR R1-R2-R3 TRACKS
IF(LNK3(K,1)*LNK3(K,2)*LNK3(K,3).NE.0)THEN
C R1-R2-R3 TRACK
CALL SHS(715,0,10.1)
IF(ISGG(1,K).NE.0)THEN
C P1 PRESENT
CALL SHS(715,0,11.01)
ENDIF
IF(ISGG(2,K).NE.0)THEN
C P2 PRESENT
CALL SHS(715,0,12.01)
ENDIF
IF(ISGG(3,K).NE.0)THEN
C P3 PRESENT
CALL SHS(715,0,13.01)
ENDIF
ENDIF
380 CONTINUE
C CHECK RADIAL EFFICIENCY (XCHECK - SEE ALSO 710-FILLED FPKPKR)
C CHECKED -OK
DO 390 K=1,NPP
IF( LPP(1,K)* LPP(2,K).NE.0)THEN
C P1-P2 TRACK
CALL SHS(715,0,20.01)
IF( LRR(1,K).NE.0)THEN
C R1 PRESENT
CALL SHS(715,0,21.01)
ENDIF
ENDIF
IF(LPP(1,K)*LPP(2,K)*LPP(3,K).NE.0)CALL SHS(716,0,1.01)
IF(LPP(1,K)*LPP(2,K)*LPP(3,K).EQ.0)THEN
IF(LPP(1,K)*LPP(2,K).NE.0)CALL SHS(716,0,3.01)
IF(LPP(2,K)*LPP(3,K).NE.0)CALL SHS(716,0,5.01)
IF(LPP(1,K)*LPP(3,K).NE.0)CALL SHS(716,0,7.01)
ENDIF
390 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)
1005 FORMAT(' RRB',I2,3X,12I2,3X,12I2,3X,12I2,2X,3I2)
1006 FORMAT(' RPB',I2,3X,12I2,3X,12I2,3X,12I2,2X,3I2)
1007 FORMAT(' RRV',I2,3X,12I2,3X,12I2,3X,12I2,2X,3I2)
1010 FORMAT(' ',I2,3X,12F3.0,3X,12F3.0,3X,12F3.0)
2000 FORMAT(' RP LINK ',2I3,3X,2I3,2X,12I2,2X,12I2)
C FINAL CHECK OF PLANARS
C WRITE(*,*)' PLANARS 2M 3M R1P2 R2P3 '
DO 400 I=1,NPP
CALL SHS(716,0,12.0)
C TRACKS BASED ON LINKED PLANAR SEGMENTS - ACCEPT AS GOOD
* PRINT 1003,I,(IPP(K,I),K=1,36),LPP(1,I),LPP(2,I),LPP(3,I)
C PRINT 1010,I,(SPP(K,I),K=1,36)
* PRINT 1004,I,(IRR(K,I),K=1,36),LRR(1,I),LRR(2,I),LRR(3,I)
C PRINT 1010,I,(SRR(K,I),K=1,36)
400 CONTINUE
C TRY TIME-ZERO AND VELOCITY DETERMINATION
C 4 FIT STR LINE
C 5 " + VELOCITY FACTOR
C 6 FIT PARABOLAE
C 7 " + VELOCITY FACTOR
C
* CALL FTZFIT(TZZ,7,0.)
* CALL FTVDET
RETURN
END
*