*-- Author : I.O.Skillicorn
SUBROUTINE FTZFIT(TZZ,NPAR,ZVERT,IMSTDY)
**: FTZFIT.......SM. New routine for monitoring.
**----------------------------------------------------------------------
C
C
C TRY MODS TO FIT VELOCITY FACTOR TO RADIALS
C
C
C
C MODIFIED TO WORK ON PLANAR-BASED PATTERN RECOGNITION
C NOTE ROUTINES OF SAME NAME IN GRFTRAC !!!!!!!!!!!!!!
C
C
C FIT PLANAR TRACKS TO GET T0 , FILL VERTEX HISTOGRAMS...
C IF IRPIK=1 USE RADIAL POINTS ALSO
C DMIN CUT INTRODUCED FOR PLANAR POINTS 25/2/92
C PUT (Z-200.) IN ALL TERMS 26/2/92
C CHANGE TO Z 28/2/92 TO GET MOMENTUM
C ADD RESIDUAL PRINT 2/3/92
C TRY DRIFT VELOCITY DETERMINATION.. ...DOES NOT WORK
C DUE TO STRONG CORRELATION WITH TIME-ZERO
C
C 27/4/92 INTRODUCE SECTION TO COMPARE SLOPE OF LINE SEGMENT
C IN VERTICAL WIRES WITH FITTED LINE BETWEEN PLANAR CHAMBERS.
C RATIO OF SLOPES SHOULD BE RATIO OF ASSUMED AND TRUE DRIFT
C VELOCITIES . FIND A VALUE CIRCA 1.02 THIS VALUE
C GIVES BETTER RESIDUALS IN PLANARS. COSTXT NOW HAS 42.15
C FOR PLANARS
C 1 /5/92 INCLUDE SECTION FOR RADIALS
C
SAVE
*KEEP,BOSMDL.
C ------BOSMDL
LOGICAL BEGJOB,ENDRUN,BEGRUN,REVENT,ENDJOB,OTHDAT
COMMON/BOSMDL/BEGJOB,ENDRUN,BEGRUN,REVENT,ENDJOB,OTHDAT,
+ LCCRUN,NCCRUN,NEVENT,
+ IHA,IBS,IDB,IDATEL,LUP,ISN,JSN
SAVE /BOSMDL/
C ------
*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.
*
*FOR PLOTS...
*KEEP,FRPLTA.
COMMON/PLOTA/KKK
*KEND.
*FTTRAC RESULTS (SJM)
*KEEP,FRH3FT.
* Common for RETRAC results (SJM)
COMMON/FRH3FT/ IRN(36,MAXTRK),SDN(36,MAXTRK),
+ IRP(36,MAXTRK),SDP(36,MAXTRK),
+ IG2,IGTTRK(MAXTRK),
+ CHISQ(MAXTRK),NUMDF(MAXTRK),
+ FITX(MAXTRK),FITY(MAXTRK),FITZ(MAXTRK),
+ FITTH(MAXTRK),FITPH(MAXTRK),
+ FITCU(MAXTRK),FTCOV(15,MAXTRK)
*KEND.
*
*
*
*
COMMON /FTTAKS/NTKSV,
1 VXV(20),VYV(20),VZV(20),VFL(20),VFM(20),VFN(20),VR(20)
COMMON/DISPL/IWKID
COMMON/TRUTH/PTR(199),LLTT(3,199),NLT,THAAA(199,2),PHITR(199,2)
COMMON/REZZID/RPH(4,72),RRZ(4,72),IPH(72),IRZ(72),INP,INR
COMMON/PCLOSE/IPC(99,99)
COMMON /FLINK3/LNK3(MAXTRK,3)
COMMON/CORRXY/CX1,CX2,CX3,CY1,CY2,CY3
C COMMON/FTVERT2/NNFTV,FLPP(10000),FMPP(10000),
C 1 FXPP(10000),FYPP(10000)
*
COMMON/CMPR/PHID(200),PHIZ(200),RRD(200),RZZ(200),CHIF(200)
*KEEP,FPLSEG.
C---
COMMON /FPLSEG / PW(12,MAXSEG,3) , PWC(12,MAXSEG,3) ,
1 PRCHI(MAXSEG,3) , NFSEG(3) ,
2 XYDXY(4,MAXSEG,3) , EXYDXY(4,4,MAXSEG,3) ,
3 ZSEG(2,MAXSEG,3) ,
4 ASEGIN(MAXSEG,3) , ISEGIN(5,MAXSEG,3) ,
5 MASKSG(MAXSEG,3) , IDGISG(12,MAXSEG,3)
C---
*KEND.
************************************************************************
C XXX ADDED 3/3/92
COMMON/FPLFIT/NNDATA,MATOT,AA(100,50),YYY(100),SSIG(100),XXX(100)
COMMON /FPLOUT/TZ,F1,F2,F3,F4,F5,F6,F7,F8,F9,F10,CHI
C TZ=TIME-ZERO
C ADDED FOR RESIDUAL CHECK
COMMON /FPRES/NPLA,RES(100),IPRES(100),THET(100)
COMMON /FPSCAL/SF1,SF2,WZER(100)
C BANKS FOR PLANAR PATTERN RECOGNITION
COMMON/FTPPBK/NPP,IPP(36,100),CHPP(100),LP(3,100)
COMMON/FTPPBS/SPP(36,100)
COMMON/FPPFIT/PSSS(100),PISS(100),RSSS(100),RISS(100)
COMMON/FPLNK/KTIP(3,50),LPP(3,100)
C COMMON FOR RADIALS ASSOCIATED WITH PLANAR TRACKS
COMMON/FTRRBK/IRR(36,MAXTRK),SRR(36,MAXTRK),LRR(3,MAXTRK)
C PLANAR SEGMENTS ASSOCIATED WITH RADIALS
C ISGG POINTS TO ROB'S SEGMENT BANKS
COMMON /FPSEG1/ ISGG(3,MAXTRK)
COMMON /FPSEG2/ ISGP(3,MAXTRK),IUZP(MAXSEG,3),IUZR(MAXTRK,3)
DIMENSION ARES(100),INX(100)
************************************************************************
C GLOBAL FIT TO PLANAR LINE SEGMENTS
C NPAR=4 STRAIGHT LINE IN X-Z , Y-Z PLANES
C NPAR=6 PARABOLAE IN X-Z, Y-Z PLANES
C*********************************************************************
C WITH SUITABLE MODS CAN FIT ALL MODULES SIMULTANEOUSLY
C (EACH MODULE TO A (DIFFERENT) STRAIGHT LINE )
C OR EACH TRACK TO A STRAIGHT LINE OR PARABOLA)
DATA ISTART/0/
DATA IITART/0/
C MINIMUM NUMBER OF PLANAR POINTS
NNPLA=20
C NNPLA=25
C PICK UP PLANAR POINTS ONLY IF DRIFT > DMIN
C TO AVOID WRONG SIGN POINTS
DMIN=0.5
C TO USE RADIAL POINTS IRPIK=1
IRPIK=1
IF(ISTART.EQ.0)THEN
ISTART=1
IHX=3000
CALL STEXT(IHX+270,4,' PROJECTED VERTEX X ' )
CALL BHS(IHX+270,0,50,-5.,5.)
CALL STEXT(IHX+271,4,' PROJECTED VERTEX Y ' )
CALL BHS(IHX+271,0,50,-5.0,5.0)
CALL STEXT(IHX+272,4,' 1/P FROM FIT ' )
CALL BHS(IHX+272,0,50,-2.5,2.5)
CALL STEXT(IHX+273,4,' 1/P FROM FIT CHI < 5 ' )
CALL BHS(IHX+273,0,50,-2.5,2.5)
CALL STEXT(IHX+273,4,' 1/P FROM FIT CHI < 5 ' )
CALL BHS(IHX+273,0,50,-2.5,2.5)
CALL STEXT(IHX+280,4,' VFACTOR MEAS/PRED CHI < 5 PLANAR' )
CALL BHS(IHX+280,0,50,00.5,1.5)
CALL STEXT(IHX+281,4,' SLOPE PREDICTED PLANAR ' )
CALL BHS(IHX+281,0,50,-0.5,0.5)
CALL STEXT(IHX+282,4,' SLOPE MEAS PLANAR ' )
CALL BHS(IHX+282,0,50,-0.5,0.5)
CALL STEXT(IHX+283,4,' SLOPE MEAS -SLOPE PRED PLANAR' )
CALL BHS(IHX+283,0,50,-0.1,0.1)
CALL STEXT(IHX+290,4,' VFACTOR MEAS/PRED CHI < 5 RADIAL' )
CALL BHS(IHX+290,0,50,00.5,1.5)
CALL STEXT(IHX+291,4,' SLOPE PREDICTED RADIAL ' )
CALL BHS(IHX+291,0,50,-0.5,0.5)
CALL STEXT(IHX+292,4,' SLOPE MEAS RADIAL ' )
CALL BHS(IHX+292,0,50,-0.5,0.5)
CALL STEXT(IHX+293,4,' SLOPE MEAS -SLOPE PRED RADIAL' )
CALL BHS(IHX+293,0,50,-0.1,0.1)
IF(IRPIK.EQ.0)WRITE(*,*)' RADIALS NOT USED IN T0 FIT '
IF(IRPIK.EQ.1)WRITE(*,*)' RADIALS USED IN T0 FIT '
WRITE(*,*)' FTZFIT DMIN,NNPLA= ',DMIN,NNPLA
C WRITE(*,*)' FTZFIT MIN # PLANAR PTS= ',NNPLA
WRITE(*,*)' RADIALS *NOT* DOWN-WEIGHTED SIG =1000 MICRONS'
WRITE(*,*)' PLANARS SIG = 300 MICRONS'
WRITE(*,*)' PLANARS NO DMIN CUT,20 POINTS MIN '
WRITE(*,*)' NPAR = ',NPAR
ENDIF
IITART=IITART+1
DO 3210 I=1,100
DO 3211 II=1,50
AA(I,II)=0.
3211 CONTINUE
3210 CONTINUE
C COUNTS DATA POINTS
NNDATA=0
C COUNTS TRACK SEGMENTS
NTT=0
C LOOP TRACKS
C WRITE(*,*)' NPP ',NPP
DO 3000 K=1,NPP
C WRITE(*,*)' FTZFIT K IRP,IRN ',K
CC PRINT 1000,(IPP(JJ,K),JJ=1,36)
CC PRINT 1001,(SPP(JJ,K),JJ=1,36)
CC PRINT 1000,(IRR(JJ,K),JJ=1,36)
CC PRINT 1001,(SRR(JJ,K),JJ=1,36)
C TO FIT EACH TRACK FOR T0 - THESE LINES ADDED------------
NTT=0
NNDATA=0
DO 3200 I=1,100
DO 3201 II=1,50
AA(I,II)=0.
3201 CONTINUE
3200 CONTINUE
C --------------------------------------TO HERE
C MODULES
DO 3010 IMOD=1,3
IGSEG=0
C ORIENTATIONS
DO 3020 IM=1,3
IPT=0
C WIRES /ORIENTATION
DO 3030 IP=1,4
IPL=IP+(IM-1)*4+(IMOD-1)*12
IF(IPP(IPL,K).GT.0)THEN
IPT=IPT+1
ENDIF
3030 CONTINUE
IF(IPT.GE.2)IGSEG=IGSEG+1
3020 CONTINUE
CTEMP IF(IGSEG.NE.3)GOTO3010
C GOOD SEGMENT- AT LEAST 2 POINTS/PLANAR ORIENTATION
C SUM SEGMENTS
NTT=NTT+1
C TO FIT WHOLE TRACK--- ADD NEXT LINE ----------
NTT=1
C WHOLE TRACK FITTED AS STRAIGHT LINE WITH T0 FIT
C 5 PARAMETER FIT
C------------------------------------------------------------
IF(NTT.LE.8)THEN
C FILL POINTS
DO 3040 IM=1,3
DO 3050 IP=1,4
IPL=IP+(IM-1)*4+(IMOD-1)*12
J=IPP(IPL,K)
IF(J.EQ.0)GOTO3050
C IF(DRIW(J,IPL).LT.DMIN)GOTO3050
NNDATA=NNDATA+1
IPRES(NNDATA)=IPL
THET(NNDATA)=ATAN2(S(IPL),C(IPL))
C IF(IITART.LT.10)WRITE(*,*)' FTZFIT THET PLA ',THET(NNDATA)
XXX(NNDATA)=ZPP(IPL)
YYY(NNDATA)=SPP(IPL,K)*DRIW(J,IPL)+DW(J,IPL)
WZER(NNDATA)=DW(J,IPL)
KKK=4*(NTT-1)
C DY/DZ
AA(NNDATA,KKK+1)= (ZPP(IPL)- 00.)*C(IPL)
C YZ
AA(NNDATA,KKK+2)= C(IPL)
C DX/DZ
AA(NNDATA,KKK+3)=-(ZPP(IPL)- 00.)*S(IPL)
C XZ
AA(NNDATA,KKK+4)= -S(IPL)
C PLUS
C TWO TERMS TO GIVE CURVATURE---RY,RX--------------
IF(NPAR.EQ.6.OR.NPAR.EQ.7) THEN
AA(NNDATA,KKK+5)= (ZPP(IPL)- 00.)**2*C(IPL)
AA(NNDATA,KKK+6)=-(ZPP(IPL)- 00.)**2*S(IPL)
ENDIF
C ------------------------------------------------
AA(NNDATA,KKK+7)= 0.0
C
AA(NNDATA,50)= SPP(IPL,K)
SSIG(NNDATA)= 0.030
**********************************************************
C DOWN WEIGHT PLANAR MODULE TO BE STUDIED
IMM=(IPL-1)/12
C IF(IMM.EQ.0)SSIG(NNDATA)=SSIG(NNDATA)*100.
C IF(IMM.EQ.1)SSIG(NNDATA)=SSIG(NNDATA)*100.
C IF(IMM.EQ.2)SSIG(NNDATA)=SSIG(NNDATA)*100.
**********************************************************
3050 CONTINUE
3040 CONTINUE
ELSE
NTT=NTT-1
GOTO 3060
ENDIF
3010 CONTINUE
C STORE NNDATA VALUE FOR PLANARS
NPLA=NNDATA
C ADD POINT COUNT CHECK INSTEAD OF SEGMENT COUNT
C WRITE(*,*)' FTZFIT NPLA ',NPLA
IF(NNDATA.LT.NNPLA)GOTO3000
C PICK UP RADIALS .............................................
IF(IRPIK.EQ.1)THEN
DO 3070 IPL=1,36
IM=(IPL-1)/12
J=IRR(IPL,K)
IF(J.EQ.0)GOTO3070
NNDATA=NNDATA+1
IPRES(NNDATA)=IPL
C ADDED 3/3/92
XXX(NNDATA)=ZP(IPL)
YYY(NNDATA)=SRR(IPL,K)*DRI(J,IPL)+DWS(J,IPL)
WZER(NNDATA)=DWS(J,IPL)
CCC=COS(WW(J,IPL)+0.0000)
SSS=SIN(WW(J,IPL)+0.0000)
THET(NNDATA)=ATAN2(SSS ,CCC )
C IF(IITART.LT.10)WRITE(*,*)' FTZFIT THET RAD',THET(NNDATA),
C 1 WW(J,IPL)
KKK=4*(NTT-1)
C DY/DZ
AA(NNDATA,KKK+1)= (ZP(IPL)- 00.)*CCC
C YZ
AA(NNDATA,KKK+2)= CCC
C DX/DZ
AA(NNDATA,KKK+3)=-(ZP(IPL)- 00.)*SSS
C XZ
AA(NNDATA,KKK+4)= -SSS
C PLUS
C TWO TERMS TO GIVE CURVATURE---RY,RX--------------
IF(NPAR.EQ.6.OR.NPAR.EQ.7) THEN
AA(NNDATA,KKK+5)= (ZP(IPL)- 00.)**2*CCC
AA(NNDATA,KKK+6)=-(ZP(IPL)- 00.)**2*SSS
ENDIF
C ------------------------------------------------
IF(NPAR.EQ.7)THEN
C CORRECT DRIFT BY A FACTOR FOR WRONG VELOCITY
AA(NNDATA,KKK+7)= YYY(NNDATA)
ENDIF
IF(NPAR.EQ.5)THEN
C CORRECT DRIFT BY A FACTOR FOR WRONG VELOCITY
AA(NNDATA,KKK+5)= YYY(NNDATA)
ENDIF
C
AA(NNDATA,50)= SRR(IPL,K)
SSIG(NNDATA)= 0.100
C
C
C
C
C
******************************************************************
C DOWN-WEIGHT RADIAL MODULE TO BE STUDIED IM=0,1,2
C IM=2 GIVES SYSTEMATIC SHIFT AT LOW MOMENTA AND SIG=2.0
C DUE TO EXTRAPOLATION FROM PLANARS
** IF(IM.EQ.0)SSIG(NNDATA)=SSIG(NNDATA)*100.
** IF(IM.EQ.1)SSIG(NNDATA)=SSIG(NNDATA)*100.
** IF(IM.EQ.2)SSIG(NNDATA)=SSIG(NNDATA)*100.
******************************************************************
C NOTE ANGLE SELECTION FOR RESIDUALS IN FXLFIT
******************************************************************
C
C
C
C
C
3070 CONTINUE
ENDIF
C.................................END RADIAL PICKUP SECTION
C NEXT LINE FOR FIT /TRACK -------------------------
MATOT=NTT*NPAR
*********************************************
*********************************************
*********************************************
C IF NO RADIAL DATA DO NOT FIT ADDITIONAL PARAMETER
IF(NNDATA.EQ.NPLA)MATOT=MATOT-NTT
C TO SET TO NORMAL 6 PARAMETER FIT UNCOMMENT NEXT LINE
CC IF(NPAR.EQ.6)MATOT=NTT*6
C TO SET TO NORMAL 4 PARAMETER FIT UNCOMMENT NEXT LINE
CC IF(NPAR.EQ.4)MATOT=NTT*4
******************************************************
******************************************************
******************************************************
C FIT W= (YZ+YD*(Z- 00.)+YR*(Z- 00.)**2 )*COS(THETA)
C -(XZ+XD*(Z- 00.)+XR*(Z- 00.)**2 )*SIN(THETA)
C WRITE(*,*) NPLA,(IPRES(KK),KK=1,NNDATA)
IF(NTT.NE.0)CALL FXLFIT(NPAR)
IF(NTT.NE.0)THEN
IF(NPAR.EQ.4)F5=0.
IF(NPAR.EQ.4)F6=0.
C F1=DY , F3=DX
FL=F3/SQRT(F3**2+F1**2)
FM=F1/SQRT(F3**2+F1**2)
C X,Y INTERCEPTS AT Z=ZVERT
XZ=F3*(ZVERT- 00.)+F4+(ZVERT- 00.0)**2*F6
YZ=F1*(ZVERT- 00.)+F2+(ZVERT- 00.0)**2*F5
C TRACKS ALONG Y(X) AXIS DETERMINE X(Y) VERTEX.
IF(ABS(FM).GT.0.7)CALL SHS(IHX+270,0,XZ)
IF(ABS(FL).GT.0.7)CALL SHS(IHX+271,0,YZ)
ENDIF
C
C -------------------------------------------------------
IF(NTT.NE.0.AND.NPAR.EQ.6)THEN
C SECTION TO CALCULATE 1/PZ FOR TEST PURPOSES
S1=0.
S2=0.
C SIGN CHANGE NEEDED FOR 'X' PARABOLA TERM
FF6=0.
FF5=0.
IF(F1.NE.0.)FF6=-F6/F1
IF(F3.NE.0.)FF5=F5/F3
IF(FF6.NE.0.0)S1=FF6/ABS(FF6)
IF(FF5.NE.0.0)S2=FF5/ABS(FF5)
SS=S1
IF(S1.NE.S2)THEN
IF(ABS(F5).GT.ABS(F6))SS=S2
ENDIF
IF(S1.EQ.0.0)SS=S2
IF(S2.EQ.0.0)SS=S1
TTHET=SQRT(F1**2+F3**2)
RPZ=2.*SQRT(F6**2+F5**2)/(0.0002998*12.*TTHET)*SS
CALL SHS(IHX+272,0,RPZ)
C IF(ABS(RPZ).LT.0.5)THEN
IF(CHI.LT.5.)CALL SHS(IHX+273,0,RPZ)
C ENDIF
*** WRITE(*,*)' FTZFIT 1/PZ = ',RPZ,S1,S2,SS
WRITE(*,*)' F6,F1,F5,F3,F7 ',F6,F1,F5,F3,F7
WRITE(*,*)' TZ CHI',TZ,CHI
ENDIF
C -------------------------------------------------------
C CHECK VELOCITY DETERMINATION - VERTICAL WIRES -PLANAR
DO 3500 IM=1,3
IPL=(IM-1)*12+1
J=IPP(IPL,K)
IF(J.EQ.0)GOTO3500
SGN=SPP(IPL,K)
KK=1
XXX(KK)=ZPP(IPL)
YYY(KK)=SPP(IPL,K)*DRIW(J,IPL)+DW(J,IPL)
DO 3510 KKK=1,3
IP=IPL+KKK
J=IPP(IP,K)
IF(J.EQ.0)GOTO3510
IF(SPP(IP,K).NE.SGN)GOTO3510
KK=KK+1
XXX(KK)=ZPP(IP)
YYY(KK)=SPP(IP,K)*DRIW(J,IP)+DW(J,IP)
3510 CONTINUE
IF(KK.NE.4)GOTO3500
C FIT SLOPE
CALL FTLFT(XXX,YYY,KK,0,SLPM,B,E)
C PREDICTED SLOPE
SLPP=(F3+F6*(XXX(1)+XXX(4)))
CALL SHS(IHX+281,0.,SLPP)
CALL SHS(IHX+282,0.,SLPM)
IF(ABS(SLPM-SLPP).LT.0.1)THEN
IF(SLPP.GT.0.0)CALL SHS(IHX+283,0.,SLPM-SLPP)
IF(SLPP.LT.0.0)CALL SHS(IHX+283,0.,SLPP-SLPM)
ENDIF
IF(ABS(SLPP).GT.0.10.AND.CHI.LT.5.0)THEN
C WRITE(*,*)' SLOPE MEAS PRED P',SLPM,SLPP,SLPM/SLPP
IF(SLPM/SLPP.GT.0.5.AND.SLPM/SLPP.LT.1.5)
1CALL SHS(IHX+280,0.,SLPM/SLPP)
ENDIF
3500 CONTINUE
C -------------------------------------------------------
C ----AS FILTER FORTRAN (IOSXA ) SOME LINES REMOVED 4/5/92
C CHECK VELOCITY DETERMINATION - RADIAL
C MODULES WITHIN PLANAR SYSTEM ONLY
DO 3600 IM=1,2
IPL=(IM-1)*12
SGN=0.
KK=0
DO 3610 KKK=1,8
IP=IPL+KKK
J=IRR(IP,K)
IF(J.EQ.0)GOTO3610
IF(SGN.EQ.0.)SGN=SRR(IP,K)
IF(SRR(IP,K).NE.SGN)GOTO3610
XR=F3*ZP(IP)+F4+ZP(IP)**2*F6
YR=F1*ZP(IP)+F2+ZP(IP)**2*F5
KK=KK+1
IF(KK.EQ.1)THEN
C FIRST POINT
W1=YR*COS(WW(J,IP))-XR*SIN(WW(J,IP))
ENDIF
C LAST POINT
W2=YR*COS(WW(J,IP))-XR*SIN(WW(J,IP))
XXX(KK)=ZP(IP)
YYY(KK)=SRR(IP,K)*DRI(J,IP)+DWS(J,IP)
3610 CONTINUE
IF(KK.LT.5)GOTO3600
C FIT SLOPE
CALL FTLFT(XXX,YYY,KK,0,SLPM,B,E)
C PREDICTED SLOPE RELATIVE TO ANODE PLANE
SLPP=(W2-W1)/(XXX(KK)-XXX(1))
CALL SHS(IHX+291,0.,SLPP)
CALL SHS(IHX+292,0.,SLPM)
IF(ABS(SLPP).LT.0.1.AND.CHI.LT.5.0)THEN
IF(SLPP.GT.0.0)CALL SHS(IHX+293,0.,(SLPM-SLPP))
IF(SLPP.LT.0.0)CALL SHS(IHX+293,0.,(SLPP-SLPM))
ENDIF
IF(ABS(SLPP).GT.0.0500.AND.CHI.LT.5.0)THEN
C WRITE(*,*)' SLOPE MEAS PRED R',SLPM,SLPP,SLPM/SLPP
IF(SLPM/SLPP.GT.0.5.AND.SLPM/SLPP.LT.1.5)
1CALL SHS(IHX+290,0.,SLPM/SLPP)
ENDIF
3600 CONTINUE
3000 CONTINUE
3060 CONTINUE
C NEXT TWO LINES FOR FIT ALL SEGMENTS
CO MATOT=NTT*4
CO IF(NTT.NE.0)CALL FXLFIT
1000 FORMAT(' ',12I2,2X,12I2,2X,12I2)
1001 FORMAT(' ',12F3.0,2X,12F3.0,2X,12F3.0)
RETURN
END
*