*-- Author : I.O. Skillicorn
SUBROUTINE FTFHQQ(NPLA,IPA,SD,ZVV,C1,C2,C3,
1 RPCOS,THET,PHZ,DRPCOS,DTHET,DPHZ,RZII,CH,IT)
**: FTFHQQ 40000 IS. New linking code.
**----------------------------------------------------------------------
C LEAST SQUARES FIT IN R-Z, PHI-Z
C FOR SINGLE LINE SEGMENT
C AUTHOR I.O.SKILLICORN
C RECODED 13/6/93
*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)
*
*
*KEND.
*
*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,FRWERR.
COMMON /WERR/ERRVL,ERRV,ERRP,ERRRX
*KEND.
*
COMMON/FERROR/ERRDR(MAXHTS, 36), ERRRM(MAXHTS, 36),
+ ERPDR(MAXHTS, 36), IERRF(MAXHTS, 36),
+ IERPF(MAXHTS, 36)
DIMENSION XX(40),YY(40),WP(40)
DIMENSION IPA(36),SD(36),CB(36)
PI2=6.2831853
II=0
FF=0.
RMN=0.
DO 20 K=1,NPLA
C J IS POINT NO. K=PLANE NO.
J=IPA(K)
IF(J.EQ.0)GOTO20
IF(DRI(J,K).GT.900.)GOTO20
II=II+1
YY(II)=RM(J,K)
XX(II)=ZP(K)
WP(II)=1./ERRRM(J,K)
RMN=RMN+YY(II)*WP(II)
FF=FF+WP(II)
C PRINT1003,II,J,XX(II),YY(II),WP(II)
1003 FORMAT(' HELIX R',2I5,3F10.4)
20 CONTINUE
CALL FTLFTW(XX,YY,WP,II,0,2,RZS,RZII,ET,DRZS,DRZI,COV)
THET=RZS
DTHET=DRZS
C WEIGHTED MEAN R
R1=RMN/FF
C
C CALCULATE PHI BASED ON FITTED R
II=0
DO30 K=1,NPLA
C J IS POINT NO. K=PLANE NO.
J=IPA(K)
IF(J.EQ.0)GOTO30
IF(DRI(J,K).GT.900.)GOTO30
II=II+1
XX(II)=ZP(K)
C USE RESULTS OF STR LINE FIT IN R-Z
RR=RZS*ZP(K)+RZII
C LAB PHI WITH FITTED R
C TRY MEAN R INSTEAD OF RR - R1
PHI=ATAN((DRI(J,K)*SD(K)+DWS(J,K))/R1)+WW(J,K)
IF(PHI.LT.0.0)PHI=PHI+PI2
YY(II)=PHI
C TAKE ERROR IN PHI PROPORTIONAL TO 1./RR
WP(II)=R1
C PRINT1002,J,II,XX(II),YY(II),WP(II),RR
1002 FORMAT(' PHI ',2I5,4F10.4)
30 CONTINUE
IF(II.GE.2)THEN
DO 32 JK=2,II
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
32 CONTINUE
ENDIF
C
CALL FTLFTW(XX,YY,WP,II,0,2,RPCOS,PHZ,EL,DRPCOS,DPHZ,COV)
C RPCOS-SLOPE PHI-Z,PHZ-INTERCEPT PHI AXIS
CH=0.
C ERROR IN RPCOS IS UNKNOWN DUE TO R-MEASUREMENT PROBLEMS
DRPCOS=1.0
DPHZ=1.0
DTHET=1.0
IF(RPCOS.EQ.0.0.AND.PHZ.EQ.0.0)THEN
CH=2000.
RETURN
ENDIF
CDEB PRINT5000,RPCOS,PHZ,DRPCOS,DPHZ
5000 FORMAT(' PHI-Z RPCOS,PHZ,EPC,EP ',4F10.5)
RETURN
END
*