*-- Author : I.O. Skillicorn 18/08/93
SUBROUTINE FTCHKH(PS,PI,RS,RI,II,JJ,KK,CHID)
**: FTCHKH 40000 IS. New linking routine.
**----------------------------------------------------------------------
*
*
C CALCULATES PS,PI,RS,RI ,CHID
C PARABOLA PHI-Z R-Z FOR THREE MODULE TRACKS
C HELIX PHI-Z R-Z FOR TWO MODULE TRACKS
C ADDITIONAL PLOTS ARE MADE WRT STR LINES IN PHI-S R-Z.
C WITH THESE WE CAN OPTIMISE PARAMETERS FOR TRACK
C ORIGINATING FROM THE IP
C
SAVE ISTART
*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,FDIFLG.
COMMON/LDIAG/IDIAG,IDIAG2,MAXPRT,IDOHIS,PMCUT
*KEND.
*
COMMON/FERROR/ERRDR(MAXHTS, 36), ERRRM(MAXHTS, 36),
+ ERPDR(MAXHTS, 36), IERRF(MAXHTS, 36),
+ IERPF(MAXHTS, 36)
COMMON/PARA/PA1,PA2,PA3,ZA1,ZA2,ZA3
DIMENSION LT(3),XX(40),YY(40),ZZ(40),WP(40),SL(3),DM(3)
DIMENSION WPR(40),IMM(40),RA(3),PHA(3),ZA(3),FN(3),DIF(40)
DATA ISTART/0/
*******************************************************************
C OPTION TO USE LINEAR TRACK MODEL:-
C IF USED, TRACKS ORIGINATING FROM IP WILL BE SELECTED
C PREFERENTIALLY
LINCHK=0
IF(ISTART.EQ.0)THEN
ISTART=1
CALL STEXT(1201,4,' FTCHKH: CHI DRIFT RAD 123' )
CALL BHS(1201,0,50, 0.00,25.0)
CALL STEXT(1202,4,' FTCHKH: CHI DRIFT RAD 12 ')
CALL BHS(1202,0,50, 0.00,25.0)
CALL STEXT(1203,4,' FTCHKH: CHI DRIFT RAD 13 ')
CALL BHS(1203,0,50, 0.00,25.0)
CALL STEXT(1204,4,' FTCHKH: CHI DRIFT RAD 23 ')
CALL BHS(1204,0,50, 0.00,25.0)
CALL STEXT(1205,4,' FTCHKH: RESIDUAL 3RAD M1 ')
CALL BHS(1205,0,50, -.50,0.50)
CALL STEXT(1206,4,' FTCHKH: RESIDUAL 3RAD M2 ')
CALL BHS(1206,0,50, -.50,0.50)
CALL STEXT(1207,4,' FTCHKH: RESIDUAL 3RAD M3 ')
CALL BHS(1207,0,50, -.50,0.50)
CALL STEXT(1208,4,' FTCHKH: RESIDUAL 2RAD M1 ')
CALL BHS(1208,0,50, -.50,0.50)
CALL STEXT(1209,4,' FTCHKH: RESIDUAL 2RAD M2 ')
CALL BHS(1209,0,50, -.50,0.50)
CALL STEXT(1210,4,' FTCHKH: RESIDUAL 2RAD M3 ')
CALL BHS(1210,0,50, -.50,0.50)
ENDIF
*******************************************************************
PI2=6.2831853
LT(1)=II
LT(2)=JJ
LT(3)=KK
C FIT R -Z IN LAB FRAME
IC=0
RA(1)=0.
RA(2)=0.
RA(3)=0.
ZA(1)=0.
ZA(2)=0.
ZA(3)=0.
FN(1)=0.
FN(2)=0.
FN(3)=0.
PHA(1)=0.
PHA(2)=0.
PHA(3)=0.
DO 50 JPL=1,36
IM=(JPL-1)/12+1
IF(LT(IM).EQ.0)GOTO50
NT=LT(IM)
IPL=JPL-(IM-1)*12
J=IRPT(IPL,NT,IM)
IF(J.EQ.0)GOTO50
IC=IC+1
XX(IC)=ZP(JPL)
ZZ(IC)=RM(J,JPL)
WPR(IC)=1./ERRRM(J,JPL)
IF(II*JJ*KK.EQ.0)GOTO50
ZA(IM)=ZA(IM)+ZP(JPL)
RA(IM)=RA(IM)+RM(J,JPL)
FN(IM)=FN(IM)+1.
50 CONTINUE
C FIT R -Z IN LAB FRAME
CALL FTLFTW(XX,ZZ,WPR,IC,0,2,RS,RI,D1,D2,D3,D4)
C FIT PHI-Z LAB FRAME USING FITTED R
IC=0
DO 60 JPL=1,36
IM=(JPL-1)/12+1
IF(LT(IM).EQ.0)GOTO60
NT=LT(IM)
IPL=JPL-(IM-1)*12
J=IRPT(IPL,NT,IM)
IF(J.EQ.0)GOTO60
IC=IC+1
RR=RS*ZP(JPL)+RI
C PRINT 1001,IM,NT,IPL,JPL,J
PHI=ATAN((DRI(J,JPL)*SDRFT(IPL,NT,IM)+DWS(J,JPL))/RR)+WW(J,JPL)
YY(IC)=PHI
IF(YY(IC).LT.0.0)YY(IC)=YY(IC)+PI2
WP(IC)=RR
IMM(IC)=IM
60 CONTINUE
IF(IC.GE.2)THEN
DO 62 JK=2,IC
DP=YY(JK)-YY(JK-1)
IF(DP.GT.0.0)THEN
IF(ABS(DP).GT.ABS(DP-PI2))YY(JK)=YY(JK)-PI2
ELSE
IF(ABS(DP).GT.ABS(DP+PI2))YY(JK)=YY(JK)+PI2
ENDIF
62 CONTINUE
ENDIF
IF(II*JJ*KK.NE.0)THEN
DO 63 JK=1,IC
PHA(IMM(JK))=PHA(IMM(JK))+YY(JK)
63 CONTINUE
ENDIF
C FIT PHI-Z IN LAB FRAME
CALL FTLFTW(XX,YY,WP,IC,0,2,PS,PI,D1,D2,D3,D4)
C WRITE(*,*)' FTCHKH LT ',LT
C FIND VERTEX - FIRST POINT , FIRST SEGMENT
DO 10 IM=1,3
NT=LT(IM)
IF(NT.EQ.0)GOTO 10
C PRINT 1000,IM,NT,(IRPT(JKL,NT,IM),JKL=1,12)
JPL=(IM-1)*12+1
PHI=PS*ZP(JPL)+PI
RR =RS*ZP(JPL)+RI
XFFF=RR*COS(PHI)
YFFF=RR*SIN(PHI)
ZFFF=ZP(JPL)
GOTO 11
10 CONTINUE
11 CONTINUE
C WRITE(*,*)XFFF,YFFF,ZFFF
C WRITE(*,*)PS,PI,RS,RI
C FIT PHI-Z , R-Z IN HELIX FRAME
IC=0
DO 20 JPL=1,36
IM=(JPL-1)/12+1
IF(LT(IM).EQ.0)GOTO20
NT=LT(IM)
IPL=JPL-(IM-1)*12
J=IRPT(IPL,NT,IM)
IF(J.EQ.0)GOTO20
IC=IC+1
RR=RS*ZP(JPL)+RI
C PRINT 1001,IM,NT,IPL,JPL,J
1001 FORMAT(' IM,NT,IPL,JPL,J ',6I3)
PHI=ATAN((DRI(J,JPL)*SDRFT(IPL,NT,IM)+DWS(J,JPL))/RR)+WW(J,JPL)
XF=RR*COS(PHI)
YF=RR*SIN(PHI)
XH=XF-XFFF
YH=YF-YFFF
RH=SQRT(XH**2+YH**2)
ZZ(IC)=RH
WPR(IC)=1./ERRRM(J,JPL)
IF(RH.NE.0.0)THEN
XX(IC)=ZP(JPL)
YY(IC)=ATAN2(YH/RH,XH/RH)
IF(YY(IC).LT.0.0)YY(IC)=YY(IC)+PI2
C ERROR IN PHI DEPENDS ON 1/RH
WP(IC)=RH
ELSE
XX(IC)=ZP(JPL)
YY(IC)=0.0001
WP(IC)=0.0
ENDIF
20 CONTINUE
IF(IC.GE.2)THEN
DO 22 JK=2,IC
IF(WP(JK-1).EQ.0.0)GOTO22
DP=YY(JK)-YY(JK-1)
IF(DP.GT.0.0)THEN
IF(ABS(DP).GT.ABS(DP-PI2))YY(JK)=YY(JK)-PI2
ELSE
IF(ABS(DP).GT.ABS(DP+PI2))YY(JK)=YY(JK)+PI2
ENDIF
22 CONTINUE
ENDIF
C FIT PHI-Z IN HELIX FRAME
CALL FTLFTW(XX,YY,WP,IC,0,2,PSH,PIH,D1,D2,D3,D4)
C WRITE(*,*)' IC PSH PIH ',IC,PSH,PIH
C FIT R -Z IN HELIX FRAME
CALL FTLFTW(XX,ZZ,WPR,IC,0,2,RSH,RIH,D1,D2,D3,D4)
C WRITE(*,*)' IC RSH RIH ',IC,RSH,RIH
C GET CHI**2 WRT TO HELIX PHI-Z ,R-Z
IF(II*JJ*KK.NE.0)THEN
DO 23 IM=1,3
RA(IM)=RA(IM)/FN(IM)
ZA(IM)=ZA(IM)/FN(IM)
PHA(IM)=PHA(IM)/FN(IM)
23 CONTINUE
PA1=PHA(1)
PA2=PHA(2)
PA3=PHA(3)
ZA1=ZA(1)
ZA2=ZA(2)
ZA3=ZA(3)
ENDIF
C CHI FOR PARABOLAE - THREE MODULE TRACKS
C CHI FOR PHI-Z,R-Z HELIX FRAME - TWO MODULE TRACKS
CHID=0.
LL=0
DO 100 IM =1,3
NT=LT(IM)
IF(NT.EQ.0)GOTO100
DO 110 IPL=1,12
JPL=IPL+(IM-1)*12
J=IRPT(IPL,NT,IM)
IF(J.EQ.0)GOTO110
LL=LL+1
IMM(LL)=IM
RRH=RSH*ZP(JPL)+RIH
PHIH=PSH*ZP(JPL)+PIH
IF(PHIH.LT.0.0)PHIH=PHIH+PI2
C MEASURED DRIFT
DRM=SDRFT(IPL,NT,IM)*DRI(J,JPL)+DWS(J,JPL)
C PREDICTED DRIFT
THETA=WW(J,JPL)
DEH=RRH*SIN(PHIH-THETA)+YFFF*COS(THETA)-XFFF*SIN(THETA)
C WRITE(*,*)' DRIFTS ',LL,DRM,DEH
IF(II*JJ*KK.NE.0)THEN
C PARABOLA FOR CHI AND RESIDUALS
ZED=ZP(JPL)
PHIP=FPARAB(ZED,PHA(1),PHA(2),PHA(3),
1 ZA(1), ZA(2), ZA(3))
RRP =FPARAB(ZED, RA(1), RA(2), RA(3),
1 ZA(1), ZA(2),ZA(3))
DEH=RRP*SIN(PHIP-THETA)
CHID=CHID+(DRM-DEH )**2/(0.04)**2
DIF(LL)=DRM-DEH
ELSE
C PHI-Z HELIX FRAME
CHID=CHID+(DRM-DEH)**2/(0.03)**2
DIF(LL)=DRM-DEH
ENDIF
110 CONTINUE
100 CONTINUE
CHID=CHID/FLOAT(LL)
C PCHID=PROB(CHID*FLOAT(LL),LL)
C WRITE(*,*)' CHID ',CHID
IF(II*JJ*KK.NE.0)CALL SHS(1201,0, CHID)
IF(II*JJ.NE.0.AND.KK.EQ.0)CALL SHS(1202,0, CHID)
IF(II*KK.NE.0.AND.JJ.EQ.0)CALL SHS(1203,0, CHID)
IF(JJ*KK.NE.0.AND.II.EQ.0)CALL SHS(1204,0, CHID)
IF(CHID.LT.5.0)THEN
DO 130 JK=1,LL
IM=IMM(JK)
IF(II*JJ*KK.NE.0)THEN
C PARABOLA FOR CHI AND RESIDUALS
IF(IM.EQ.1)CALL SHS(1205,0,DIF(JK))
IF(IM.EQ.2)CALL SHS(1206,0,DIF(JK))
IF(IM.EQ.3)CALL SHS(1207,0,DIF(JK))
ELSE
C PHI-Z HELIX FRAME
IF(IM.EQ.1)CALL SHS(1208,0,DIF(JK))
IF(IM.EQ.2)CALL SHS(1209,0,DIF(JK))
IF(IM.EQ.3)CALL SHS(1210,0,DIF(JK))
ENDIF
130 CONTINUE
ENDIF
RETURN
END
*