*-- Author : I.O. Skillicorn
SUBROUTINE FTJN3(CF,IU,LLL,LL,RPC,RPS,PH,CH, ZI)
**: FTJN3 40000 IS. New linking code.
**----------------------------------------------------------------------
**: FTJN3 40000 .SM. Fix selection of best link.
**----------------------------------------------------------------------
C JOIN THREE MODULES
C AUTHOR I.O.SKILLICORN
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/FVFLAG/IVERTX
COMMON/PARA/PA1,PA2,PA3,ZA1,ZA2,ZA3
*
* LOCAL ARRAYS...
DIMENSION CF(MAXTR3,3),IU(MAXTR3,3),LL(MAXTR3,3)
DIMENSION RPC(MAXTR3),RPS(MAXTR3)
DIMENSION PH(MAXTR3),CH(MAXTR3),CX(3)
C DIMENSION IP(36),SD(36),IPP(36,MAXTR3),SDD(36,MAXTR3)
DIMENSION IP(36),SD(36)
DIMENSION ZI(MAXTR3)
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)
DATA ISTART/0/
IF(ISTART.EQ.0)THEN
ISTART=1
CALL STEXT(2016,4,' PHI CONT - M12 R12 PSCUT ALL')
CALL BHS(2016,0,40,-.10,.10)
CALL STEXT(2017,4,' PHI CONT - M23 R23 PSCUT 3M AFTER M12 SEL ')
CALL BHS(2017,0,40,-.10,.10)
ENDIF
*
ZM12 = 0.5*(ZP(IZM1) + ZP(IZM2))
ZM23 = 0.5*(ZP(IZM2) + ZP(IZM3))
ZM13 = 0.5*(ZP(IZM1) + ZP(IZM3))
*
C TO JOIN THREE MODULES
PI2=6.2831853
CONS=-2./(12.*0.0002998)
CHT = CHT3
PCUT = PCT3
PSCUT = PSC3
RCUT = RCT3
*************************NEW CUTS******94 DATA**************
* RCUT=20.
* PCUT=0.04
* PSCUT=0.002
* CHT=100
************************************************************
Z1=ZP(IZM1)
Z2=ZP(IZM2)
Z3=ZP(IZM3)
C
C
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 *******************************
DO 10 I=1,N1
C CYCLE LINE SEGMENTS M0
IF(CHSQ(I,1).GT.1000.)GOTO10
IF(ICHK.EQ.1.AND.IU(I,1).EQ.1)GOTO10
DO 20 J=1,N2
C CYCLE LINE SEGMENTS M1
IF(CHSQ(J,2).GT.1000.)GOTO20
IF(ICHK.EQ.1.AND.IU(J,2).EQ.1)GOTO20
RTEST=(RFIT(I,1)-RFIT(J,2)*Z1/Z2)
C CHECK LINE SEGMENTS POINT TO Z-AXIS
IF(ABS(RTEST).GT.RCUT)GOTO20
C FILL POINTS/DRIFT SIGN
C REFIT PHI-Z WITH R-VALUES OF SEGMENTS
C RECALCULATE PHI-Z SLOPE AND INTERCEPT
DO 100 KK=1,24
IF(KK.LE.12)THEN
IP(KK)=IRPT(KK,I,1)
SD(KK)=SDRFT(KK,I,1)
ELSE
IP(KK)=IRPT(KK-12,J,2)
SD(KK)=SDRFT(KK-12,J,2)
ENDIF
100 CONTINUE
L=0
DO 110 KK=1,24
IF(IP(KK).EQ.0)GOTO110
JJ=IP(KK)
L=L+1
IF(KK.LE.12)IMM(L)=1
IF(KK.GT.12)IMM(L)=2
C R : ASSUMES LINEAR TO VERTEX
RRS=(RFIT(I,1)+RFIT(J,2))/(Z1+Z2)
RR=RRS*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
110 CONTINUE
C PHI CONTINUOUS
IF(L .GT. 1)THEN
DO120 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
120 CONTINUE
ENDIF
IC=0
DO 130 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
130 CONTINUE
C FIT LINESEG IN M0
CALL FTLFTW(XXX,YYY,WWT,IC,0,2,PS1,PZ1,D1,D2,D3,COV)
IC=0
DO 140 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
140 CONTINUE
C FIT LINESEG IN M1
CALL FTLFTW(XXX,YYY,WWT,IC,0,2,PS2,PZ2,D1,D2,D3,COV)
C CHECK RECALCULATED PHI CONTINUOUS AT MID-PLANE
PP1=PS1*ZM12+PZ1
PP2=PS2*ZM12+PZ2
IF(ABS(PS1-PS2).LT.PSCUT)CALL SHS(2016,0,PP1-PP2)
* CHECK PHI CONTINUOUS
* CHECK PHI' SIMILAR FOR EACH SEGMENT
IF(ABS(PP1-PP2).GT.PCUT)GOTO20
IF(ABS(PS1-PS2).GT.PSCUT)GOTO20
C HERE HAVE 0-1 LINK . CYCLE LINKS IN M2
DO 50 K=1,N3
IF(CHSQ(K,3).GT.1000.)GOTO50
IF(ICHK.EQ.1.AND.IU(K,3).EQ.1)GOTO50
C CHECK 1-2 POINTS TO Z AXIS IN R
RTEST=(RFIT(J,2)-RFIT(K,3)*Z2/Z3)
IF(ABS(RTEST).GT.RCUT)GOTO50
C FILL POINTS/DRIFT SIGN
C REFIT PHI-Z WITH R-VALUES OF SEGMENTS
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.GE.13.AND.KK.LE.24)THEN
IP(KK)=IRPT(KK-12,J,2)
SD(KK)=SDRFT(KK-12,J,2)
ENDIF
IF(KK.GE.25)THEN
IP(KK)=IRPT(KK-24,K,3)
SD(KK)=SDRFT(KK-24,K,3)
ENDIF
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.GE.13.AND.KK.LT.25)IMM(L)=2
IF(KK.GT.24)IMM(L)=3
C R : ASSUMES LINEAR TO VERTEX
RRS=(RFIT(J,2)+RFIT(K,3))/(Z2+Z3)
RR=RRS*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.2)THEN
IC=IC+1
XXX(IC)=XX(KK)
YYY(IC)=YY(KK)
WWT(IC)=WT(KK)
ENDIF
230 CONTINUE
C REFIT M1 M2 WITH COMMON R
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.3)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 M2 M3
PP1=PS1*ZM23+PZ1
PP2=PS2*ZM23+PZ2
IF(ABS(PS1-PS2).LT.PSCUT)CALL SHS(2017,0,PP1-PP2)
C CHECK M1, M2 CONTINUOUS AT MID PLANE
C CHECK PHI' SIMILAR
IF(ABS(PP1-PP2).GT.PCUT)GOTO50
IF(ABS(PS1-PS2).GT.PSCUT)GOTO50
C THREE MODULES LINK WITHIN TOLERANCE
C CHECK STRAIGHT LINE IN PHI-Z
C R-Z FROM THREE MODULES
L=0
DO 310 KK=1,36
IF(IP(KK).EQ.0)GOTO310
JJ=IP(KK)
L=L+1
IF(KK.LE.12)IMM(L)=1
IF(KK.GE.13.AND.KK.LT.25)IMM(L)=2
IF(KK.GT.24)IMM(L)=3
C R : ASSUMES LINEAR TO VERTEX
RRS=(RFIT(I,1)+RFIT(J,2)+RFIT(K,3))/(Z1+Z2+Z3)
RR=RRS*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
310 CONTINUE
C PHI CONTINUOUS
IF(L .GT. 1)THEN
DO320 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
320 CONTINUE
ENDIF
IC=0
DO 330 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
330 CONTINUE
CALL FTLFTW(XXX,YYY,WWT,IC,0,2,PS2,PZ2,D1,D2,D3,COV)
IC=0
DO 340 KK=1,L
IF(IMM(KK).EQ.3)THEN
IC=IC+1
XXX(IC)=XX(KK)
YYY(IC)=YY(KK)
WWT(IC)=WT(KK)
ENDIF
340 CONTINUE
CALL FTLFTW(XXX,YYY,WWT,IC,0,2,PS3,PZ3,D1,D2,D3,COV)
IC=0
DO 250 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
250 CONTINUE
CALL FTLFTW(XXX,YYY,WWT,IC,0,2,PS1,PZ1,D1,D2,D3,COV)
C COMPARE PHI VALUES AT MODULE CENTRE
P1=PS1*Z1+PZ1
P2=PS2*Z2+PZ2
P3=PS3*Z3+PZ3
C NO CUT ON THIS PARAMETER
C GOOD LINK: GET CHI , BEST TRACK PARAMETERS
CALL FTCHKH(PCOS,PHZ,PSIN,RI,I,J,K,CHI)
C LOOSE CUT ON CHI.
C USE CHI TO SELECT BEST CANDIDATE IF AMBIGUITIES
IF(CHI.GT.CHT)GOTO50
C
LLL=LLL+1
C******************************************12/10/88********************
IF(LLL.GT.MAXTR3)LLL=MAXTR3
LL(LLL,1)=I
LL(LLL,2)=J
LL(LLL,3)=K
RPC(LLL)=PCOS
RPS(LLL)=PSIN
PH(LLL)=PHZ
CH(LLL)=CHI
ZI(LLL)=RI
PPA(LLL,1)=PA1
PPA(LLL,2)=PA2
PPA(LLL,3)=PA3
ZZA(LLL,1)=ZA1
ZZA(LLL,2)=ZA2
ZZA(LLL,3)=ZA3
50 CONTINUE
20 CONTINUE
10 CONTINUE
C NEW COMPARE SECTION
C NEW COMPARE SECTION
C NEW COMPARE SECTION
C NEW COMPARE SECTION
DO 400 LOOP=1,LLL
CHB=100000.
KB=0
C SELECT BEST
DO 410 K=1,LLL
IF(CH(K).LT.0.0)GOTO 410
IF(LL(K,1).EQ.0)GOTO410
C WRITE(*,*)' K ,CHI ',K,CH(K),LL(K,1),LL(K,2),LL(K,3)
IF(CH(K).LT.CHB)THEN
CHB=CH(K)
KB=K
ENDIF
410 CONTINUE
C WRITE(*,*)' KB,CHIB ',KB,CHB
IF(KB.EQ.0)GOTO499
C COMPARE BEST WITH REMAINDER
DO 420 K=1,LLL
IF(K.EQ.KB)GOTO420
IF(LL(K,1).EQ.0)GOTO420
IF(LL(K,1).EQ.LL(KB,1))GOTO430
IF(LL(K,2).EQ.LL(KB,2))GOTO430
IF(LL(K,3).EQ.LL(KB,3))GOTO430
GOTO 420
C REMOVE LINK
430 LL(K,1)=0
LL(K,2)=0
C WRITE(*,*)' REMOVE ',K
420 CONTINUE
C COMPARE FINISHED , MARK BEST SEGMENT USED
CH(KB)=-CH(KB)
400 CONTINUE
C RESET CHI WHEN COMPARE FINISHED
499 DO 440 LOOP=1,LLL
IF(CH(LOOP).LT.0.0)CH(LOOP)=-CH(LOOP)
440 CONTINUE
C
C
C
C SET USED FLAGS
NLLL=0
DO 500 I=1,LLL
IF(LL(I,1)*LL(I,2).EQ.0)GOTO500
NLLL=NLLL+1
IU(LL(I,1),1)=1
IU(LL(I,2),2)=1
IU(LL(I,3),3)=1
*------------------------------------------
C PRINT1000,LL(I,1),LL(I,2),LL(I,3)
1000 FORMAT(' T1,T2,T3 ',5I3)
*------------------------------------------
500 CONTINUE
RETURN
END
*