*-- Author : I.O. Skillicorn
SUBROUTINE FTJN13(CF,IU,LLL,LL,RPC,RPS,PH,CH, ZI)
**: FTJN13 40000 IS. New linking code.
**----------------------------------------------------------------------
**: FTJN13 40000 SM. Fix selection of best link.
**----------------------------------------------------------------------
C AUTHOR I.O.SKILLICORN
C JOIN MODULES 1 AND 3
C 21/5/91 REDUCE SIZE
*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,FJNPAR.
COMMON/FJNPAR/
+ CHT3, CHT12, CHT23, CHT13,
+ PCT3, PCT12, PCT23, PCT13,
+ PSC3, PSC12, PSC23, PSC13,
+ RCT3, RCT12, RCT23, RCT13
*KEND.
*
COMMON/PARA/PA1,PA2,PA3,ZA1,ZA2,ZA3
*
* LOCAL ARRAYS...
DIMENSION CF(MAXTR3,3),IU(MAXTR3,3),LL(MAXTRK,2)
DIMENSION RPC(MAXTRK),RPS(MAXTRK)
DIMENSION PH(MAXTRK),CH(MAXTRK),CX(3)
C DIMENSION IP(36),SD(36),IPP(36,MAXTRK),SDD(36,MAXTRK)
DIMENSION IP(36),SD(36)
DIMENSION ZI(MAXTRK)
DIMENSION XX(36),YY(36),ZZ(36),WT(36),IMM(36)
DIMENSION XXX(36),YYY(36),ZZZ(36),WWT(36)
C 'Centre' points of radial modules
PARAMETER(IZM1=6)
PARAMETER(IZM2=18)
PARAMETER(IZM3=30)
*
ZM12 = 0.5*(ZP(IZM1) + ZP(IZM2))
ZM23 = 0.5*(ZP(IZM2) + ZP(IZM3))
ZM13 = 0.5*(ZP(IZM1) + ZP(IZM3))
Z1=ZP(06)
Z2=ZP(18)
Z3=ZP(30)
*
C TO JOIN TWO MODULES
C STANDARD DEVIATIONS ** 2
PI2=6.2831853
C CUTS CHANGED FOR FAST FILTER - SECOND LINE FOR FAST FILTER
C SELECT TRACKS STR LINE PHI-Z ONLY
C IE THOSE FROM Z-AXIS
C REPLACEMENT VALUES H1SIM ****************************
CHT = CHT13
PCUT = PCT13
PSCUT = PSC13
RCUT = RCT13
C
C ****************************************************
*************************NEW CUTS******94 DATA**************
* CHT=100.
* RCUT=20.
* PCUT=0.04
* PSCUT=0.002
************************************************************
C
LLL=0
ZVV=ZV
N1=NTRAKS(1)
N2=NTRAKS(2)
N3=NTRAKS(3)
C =0 USE MANY TIMES =1 USE ONCE
ICHK=1
C IU SET IN FTJN3
C *******************************
DO 10 I=1,N1
IF(CHSQ(I,1).GT.1000.)GOTO10
IF(ICHK.EQ.1.AND.IU(I,1).EQ.1)GOTO10
DO 20 J=1,N3
IF(CHSQ(J,3).GT.1000.)GOTO20
IF(ICHK.EQ.1.AND.IU(J,3).EQ.1)GOTO20
RTEST=(RFIT(I,1)-RFIT(J,3)*Z1/Z3)
IF(ABS(RTEST).GT.RCUT)GOTO20
C REFIT PHI-Z WITH R-VALUES OF SEGMENTS
C FILL POINTS/DRIFT SIGN
C RECALCULATE PHI-Z SLOPE AND INTERCEPT
DO 200 KK=1,36
IF(KK.LE.12)THEN
IP(KK)=IRPT(KK,I,1)
SD(KK)=SDRFT(KK,I,1)
ENDIF
IF(KK.GT.24)THEN
IP(KK)=IRPT(KK-24,J,3)
SD(KK)=SDRFT(KK-24,J,3)
ENDIF
IF(KK.GT.12.AND.KK.LE.24)IP(KK)=0
200 CONTINUE
L=0
DO 210 KK=1,36
IF(IP(KK).EQ.0)GOTO210
JJ=IP(KK)
L=L+1
IF(KK.LE.12)IMM(L)=1
IF(KK.GT.24)IMM(L)=2
C R : ASSUMES LINEAR TO VERTEX
RR=(RFIT(I,1)+RFIT(J,3))/(Z1+Z3)*ZP(KK)
XX(L)=ZP(KK)
YY(L)=ATAN((DRI(JJ,KK)*SD(KK)+DWS(JJ,KK))/RR) +WW(JJ,KK)
IF(YY(L).LT.0.0)YY(L)=YY(L)+PI2
WT(L)=1.0
210 CONTINUE
C PHI CONTINUOUS
IF(L .GT. 1)THEN
DO220 JJ=2,L
DP = YY(JJ)-YY(JJ-1)
IF(DP.GT.0.) THEN
IF(ABS(DP).GT.ABS(DP-PI2))YY(JJ)=YY(JJ)-PI2
ELSE
IF(ABS(DP).GT.ABS(DP+PI2))YY(JJ)=YY(JJ)+PI2
ENDIF
220 CONTINUE
ENDIF
IC=0
DO 230 KK=1,L
IF(IMM(KK).EQ.1)THEN
IC=IC+1
XXX(IC)=XX(KK)
YYY(IC)=YY(KK)
WWT(IC)=WT(KK)
ENDIF
230 CONTINUE
CALL FTLFTW(XXX,YYY,WWT,IC,0,2,PS1,PZ1,D1,D2,D3,COV)
IC=0
DO 240 KK=1,L
IF(IMM(KK).EQ.2)THEN
IC=IC+1
XXX(IC)=XX(KK)
YYY(IC)=YY(KK)
WWT(IC)=WT(KK)
ENDIF
240 CONTINUE
CALL FTLFTW(XXX,YYY,WWT,IC,0,2,PS2,PZ2,D1,D2,D3,COV)
C CHECK RECALCULATED PHI CONTINUOUS
PP1=PS1*ZM13+PZ1
PP2=PS2*ZM13+PZ2
IF(ABS(PS1-PS2).LT.PSCUT)CALL SHS(2002,0,PP1-PP2)
*
IF(ABS(PP1-PP2).GT.PCUT)GOTO20
IF(ABS(PS1-PS2).GT.PSCUT)GOTO20
*
CALL FTCHKH(PCOS, PHZ, PSIN, RI, I, 0, J, CHI)
IF(CHI.GT.CHT)GOTO50
C GOOD LINK
LLL=LLL+1
C******************************************12/10/88********************
IF(LLL.GT.MAXTRK)LLL=MAXTRK
LL(LLL,1)=I
LL(LLL,2)=J
C LL(LLL,3)=K
RPC(LLL)=PCOS
RPS(LLL)=PSIN
PH(LLL)=PHZ
CH(LLL)=CHI
ZI(LLL)=RI
*------------------------------------------
CDEB PRINT 1010,LLL,(IPP(NNN,LLL),NNN=1,36)
1010 FORMAT(' JOIN2 ',I3,1X,12I2,1X,12I2,1X,12I2,F8.2)
*------------------------------------------
50 CONTINUE
20 CONTINUE
10 CONTINUE
DO 100 LOOP=1,LLL
CHB=100000.
KB=0
C SELECT BEST
DO 110 K=1,LLL
IF(CH(K).LT.0.0)GOTO 110
IF(LL(K,1).EQ.0)GOTO110
IF(CH(K).LT.CHB)THEN
CHB=CH(K)
KB=K
ENDIF
110 CONTINUE
IF(KB.EQ.0)GOTO199
C COMPARE BEST WITH REMAINDER
DO 120 K=1,LLL
IF(K.EQ.KB)GOTO120
IF(LL(K,1).EQ.0)GOTO120
IF(LL(K,1).EQ.LL(KB,1))GOTO130
IF(LL(K,2).EQ.LL(KB,2))GOTO130
CCCCC IF(LL(K,3).EQ.LL(KB,3))GOTO130
GOTO 120
C REMOVE LINK
130 LL(K,1)=0
LL(K,2)=0
120 CONTINUE
C COMPARE FINISHED , MARK BEST SEGMENT USED
CH(KB)=-CH(KB)
100 CONTINUE
C RESET CHI WHEN COMPARE FINISHED
199 DO 140 LOOP=1,LLL
IF(CH(LOOP).LT.0.0)CH(LOOP)=-CH(LOOP)
140 CONTINUE
C
C
C
C SET USED FLAGS
NLLL=0
DO 300 I=1,LLL
IF(LL(I,1)*LL(I,2).EQ.0)GOTO300
NLLL=NLLL+1
IU(LL(I,1),1)=1
IU(LL(I,2),3)=1
CCCCCC IU(LL(I,3),3)=1
CALL SHS(2040,0,8.)
CALL SHS(2040,0,10.)
*------------------------------------------
C PRINT1000,LL(I,1),LL(I,2),LL(I,3)
1000 FORMAT(' T1,T2,T3 ',5I3)
*------------------------------------------
300 CONTINUE
IF(NLLL.NE.0)CALL SHS(2044,0,FLOAT(LLL)/FLOAT(NLLL))
RETURN
C
END
*
*
C new version imported from IOS fortran 6/6/91
*