*-- Author : I. O. Skillicorn 31/08/93
SUBROUTINE FPCHI(IM1,IM2,I,J,CHID)
**: FPCHI 40000 IS. New routine to calculate chi-squared.
**----------------------------------------------------------------------
C234567
C CALCULATES CHI RELATIVE TO HELIX FOR TWO-MODULE TRACKS
*ARRAY DIMENSIONS...
*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,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,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,FPFVTX.
COMMON/VERTFF/ZFF,XFF,YFF
*
*KEND.
COMMON/FTPS3/NS(3),SPAR(4,50,3),IPT(12,50,3),IPLA(12,50,3),
1 SGN(12,50,3),YYS(12,50,3),YYF(12,50,3)
DIMENSION XX(50),YY(50),ZZ(50),WP(50)
PI2=2.*ACOS(-1.)
C VERTEX FROM FIRST PLANAR MODULE
C HELIX DEFINED RELATIVE TO THIS VERTEX
IF(IM1.EQ.1)ZED=ZPP(1)
IF(IM1.EQ.2)ZED=ZPP(13)
XFFF=SPAR(3,I,IM1)*ZED+SPAR(4,I,IM1)
YFFF=SPAR(1,I,IM1)*ZED+SPAR(2,I,IM1)
ZFFF=ZED
C FIT HELIX TO FITTED LINE SEGMENTS
C STRAIGHT LINE PHI-Z
IC=0
C WRITE(*,*)' M1,M2,I,J ',IM1,IM2,I,J
C WRITE(*,*)' XFFF,YFFF,ZFFF ',XFFF,YFFF,ZFFF
DO 10 IP=1,36
IM=(IP-1)/12+1
IF((IM.NE.IM1).AND.(IM.NE.IM2))GOTO 10
IC=IC+1
IF(IM.EQ.IM1)II=I
IF(IM.EQ.IM2)II=J
ZED=ZPP(IP)
XF=SPAR(3,II,IM)*ZED+SPAR(4,II,IM)
YF=SPAR(1,II,IM)*ZED+SPAR(2,II,IM)
XH=XF-XFFF
YH=YF-YFFF
RH=SQRT(XH**2+YH**2)
C WRITE(*,*)' IM,II,RH,XH,YH ',IM,II,RH,XH,YH
IF(RH.NE.0.0)THEN
XX(IC)=ZED
YY(IC)=ATAN2(YH/RH,XH/RH)
ZZ(IC)=RH
WP(IC)=1./(0.1/RH)
ELSE
XX(IC)=ZED
YY(IC)=0.0001
ZZ(IC)=RH
WP(IC)=0.0
ENDIF
10 CONTINUE
DO 20 JJ=2,IC
DP=YY(JJ)-YY(JJ-1)
IF(DP.GT.0.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
20 CONTINUE
C FIT PHI-Z IN HELIX FRAME
CALL FTLFTW(XX,YY,WP,IC,0,2,PS,PI,D1,D2,D3,D4)
IF(PS.EQ.0.0)PS=0.0000001
C FIT R-Z IN HELIX FRAME
C STRAIGHT LINE IN R - SIN(.....)
IC=0
DO 30 IP=1,36
IM=(IP-1)/12+1
IF((IM.NE.IM1).AND.(IM.NE.IM2))GOTO 30
IC=IC+1
XX(IC)=SIN(PS*(ZPP(IP)-ZFFF))/PS
WP(IC)=1.0
30 CONTINUE
CALL FTLFTW(XX,ZZ,WP,IC,0,2,RS,RI,D1,D2,D3,D4)
C EXAMINE PLANAR RESIDUALS WITH RESPECT TO HELIX
CHID=0.
IC=0
DO 40 IP=1,36
IM=(IP-1)/12+1
IF((IM.NE.IM1).AND.(IM.NE.IM2))GOTO40
LL=IP-(IM-1)*12
IF(IM.EQ.IM1)II=I
IF(IM.EQ.IM2)II=J
JJ=IPT(LL,II,IM)
IF(JJ.LE.0)GOTO40
SGNN=SGN(LL,II,IM)
WM=SGNN*DRIW(JJ,IP)+DW(JJ,IP)
ZED=ZPP(IP)
PHIH=PS*ZED+PI
RRH=RS*SIN(PS*(ZED-ZFFF))/PS+RI
THETA=ATAN2(S(IP),C(IP))
WEH=RRH*SIN(PHIH-THETA)+YFFF*COS(THETA)-XFFF*SIN(THETA)
IC=IC+1
CHID=CHID+(WM-WEH)**2/(0.03)**2
40 CONTINUE
CHID=CHID/FLOAT(IC)
RETURN
END
*