*-- Author : I.O.Skillicorn
SUBROUTINE FXLFIT(NPAR)
C 3/2/92 SEARCH FOR BAD POINTS AND REFIT
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 ------
*KEND.
C XX ADDED FOR RESIDUAL CHECK - MEDFIT
COMMON /FPLFIT/NNDATA,MATOT,AA(100,50),YY(100),SSIG(100),XX(100)
COMMON /FPLOUT/TZ,F1,F2,F3,F4,F5,F6,F7,F8,F9,F10,CHI
COMMON /FPRES/NPLA,RES(100),IPRES(100),THET(100)
COMMON /FPSCAL/SF1,SF2,WZER(100)
DIMENSION ARES(100),INX(100)
PARAMETER (MMAX=50,NDATA=510,MA=50,NCVM=100)
DIMENSION X(NDATA),Y(NDATA),SIG(NDATA),A(MA),LISTA(MA),
1 COVAR(NCVM,NCVM),BETA(MMAX),AFUNC(MMAX)
DATA ISTART/0/
IF(ISTART.EQ.0)THEN
ISTART=1
IHX=3000
CALL STEXT(IHX+250,4,' TIME0 PLANAR FIT ' )
CALL BHS(IHX+250,0,50,-1.,1.)
CALL STEXT(IHX+251,4,' TIME0 PLANAR FIT ' )
CALL BHS(IHX+251,0,50,-0.1,0.1)
CALL STEXT(IHX+252,4,' CHI PLANAR FIT ' )
CALL BHS(IHX+252,0,50,0.,10.)
CALL STEXT(IHX+253,4,' TIME0 PLANAR FIT CHI <5 ' )
CALL BHS(IHX+253,0,50,-1.,1.)
CALL STEXT(IHX+254,4,' TIME0 PLANAR FIT CHI <5 ' )
CALL BHS(IHX+254,0,50,-0.1,0.1)
CALL STEXT(IHX+255,4,' ERROR IN T0 FIT CHI <5 ' )
CALL BHS(IHX+255,0,50,0.0,0.025)
CALL STEXT(IHX+256,4,' # POINTS IN T0 FIT ' )
CALL BHS(IHX+256,0,50,0.0,100. )
CALL STEXT(IHX+257,4,' RESIDUAL CHI < 5 PLANARS M0 ' )
CALL BHS(IHX+257,0,50,-5.0,5.0 )
CALL STEXT(IHX+258,4,' RESIDUAL CHI < 5 PLANARS M1 ' )
CALL BHS(IHX+258,0,50,-5.0,5.0 )
CALL STEXT(IHX+259,4,' RESIDUAL CHI < 5 PLANARS M2 ' )
CALL BHS(IHX+259,0,50,-5.0,5.0 )
CALL STEXT(IHX+260,4,' RESIDUAL CHI < 5 RADIALS M0 ' )
CALL BHS(IHX+260,0,50,-5.0,5.0 )
CALL STEXT(IHX+261,4,' RESIDUAL CHI < 5 RADIALS M1 ' )
CALL BHS(IHX+261,0,50,-5.0,5.0 )
CALL STEXT(IHX+262,4,' RESIDUAL CHI < 5 RADIALS M2 ' )
CALL BHS(IHX+262,0,50,-5.0,5.0 )
CC CALL STEXT(IHX+263,4,' SCALE FACTOR CHI < 5 ' )
CC CALL BHS(IHX+263,0,50,0.9,1.1)
CALL STEXT(IHX+264,4,' SCALE FACTOR FOR RADIAL DRIFT CHI< 5 ')
CALL BHS(IHX+264,0,50,-1.0,1.0)
ENDIF
DO 10 K=1,MATOT
A(K)=0.
10 LISTA(K)=K
MFIT=MATOT
C NEXT 2 LINES FOR T0 FIT *************************
LISTA(MATOT+1)=50
A(MATOT+1)=0.
MFIT=MFIT+1
C******************************************************
C FIRST FIT
CALL FXFIT(X,YY,SSIG,NNDATA,A,MA,LISTA,MFIT,COVAR,NCVM,CHISQ)
CHI=CHISQ/FLOAT(NNDATA)
C WRITE(*,*)' CHI 1 ',CHI
** IF(CHI.GT.2.0)THEN
C REMOVE BAD POINTS AND REFIT
** RMAX=0.
** DO 3100 I=1,NNDATA
** ARES(I)=ABS(RES(I))
** INX(I)=I
** IF(ABS(RES(I)).GT.RMAX)RMAX=ABS(RES(I))
3100 CONTINUE
C CALL SORTFL(ARES,INX,NNDATA)
* DO 3110 I=1,NNDATA
C PRINT 2002,I,INX(I),ARES(INX(I))
2002 FORMAT(1X,2I5,F8.2)
* IF(ABS(RES(I)).GT.RMAX/1.5)THEN
*** SSIG(I)=1000.
* ENDIF
*3110 CONTINUE
C EXAMINE RESIDUALS WITH MEDFIT - REJECT IF > 2.5 * MEAN
C ROBUST STR LINE FIT (LEAST ABSOLUTE DEVIATION)
** CALL MEDFIT(XX,RES,NNDATA,AR,BR,ABDEV)
C WRITE(*,*)' MEDFIT RESIDUALS ',ABDEV
** DO 3300 I=1,NNDATA
** RR=RES(I)-(AR+BR*XX(I))
C PRINT2002,I,I,RR
C TEMP REMOVAL OF POINT REJECT
** IF(ABS(RR).GT.2.5*ABDEV)SSIG(I)=1000.
3300 CONTINUE
C REFIT AFTER POINT REJECT
** CALL FLFIT(X,YY,SSIG,NNDATA,A,MA,LISTA,MFIT,COVAR,NCVM,CHISQ)
** CHI=CHISQ/FLOAT(NNDATA)
C WRITE(*,*)' CHI 2 ',CHI
** RMAX=0.
** DO 3200 I=1,NNDATA
** ARES(I)=ABS(RES(I))
** INX(I)=I
* IF(ABS(RES(I)).GT.RMAX)RMAX=ABS(RES(I))
3200 CONTINUE
* CALL SORTFL(ARES,INX,NNDATA)
* DO 3210 I=1,NNDATA
C PRINT 2002,I,INX(I),ARES(INX(I))
* IF(ABS(RES(I)).GT.RMAX/1.5)THEN
* SSIG(I)=1000.
* ENDIF
*3210 CONTINUE
** ENDIF
TZ=A(50)
F1=A(1)
F2=A(2)
F3=A(3)
F4=A(4)
F5=A(5)
F6=A(6)
F7=A(7)
F8=A(8)
F9=A(9)
MOD=1
CC PRINT 1000,MOD,NNDATA,CHI
CC PRINT1001,(A(KK),KK=1,MFIT-1)
C PRINT1001,(A(KK),KK=1,MFIT )
CC PRINT1002,A(50)
1000 FORMAT(' FIT ',2I5,F6.1,' YD,YZ,XD,XZ ,CY,CZ')
1001 FORMAT(' ',16X,4F8.3,3E12.4)
1002 FORMAT(' TIME ZERO ',F8.3)
CALL SHS(IHX+250,0,A(50))
CALL SHS(IHX+251,0,A(50))
CALL SHS(IHX+252,0,CHI)
IF(CHI.LT.5.0)THEN
CALL SHS(IHX+253,0,A(50))
CALL SHS(IHX+254,0.,A(50))
DTZ=SQRT(ABS(COVAR(MFIT,MFIT)))
CALL SHS(IHX+255,0.,DTZ)
CALL SHS(IHX+256,0.,FLOAT(NNDATA))
C SCALE FACTOR = 1/FACTOR FOR DRIFT VELOCITY CHANGE
C IE BETTER DRIFT VEL = DV ORIGINAL/SF
CCC SF=SF1/SF2
C WRITE(*,*)' FTZFIT SF ',SF
CCC IF(ABS(SF-1.0).LT.0.1)CALL SHS(IHX+263,0.,SF)
IF(NPAR.EQ.7.AND.F7.NE.0.0)CALL SHS(IHX+264,0.,F7)
IF(NPAR.EQ.5.AND.F5.NE.0.0)CALL SHS(IHX+264,0.,F5)
**********************************************************************
C SELECT ANGLE OF WIRES -1.57,-2.62,-0.52 Y,U,V
THSEL=-1.570796
C THSEL=-0.52
C THSEL=-2.62
**********************************************************************
DO 3400 I=1,NNDATA
IF(SSIG(I).GT.50.0)GOTO3400
C WRITE(*,*)' THET ',I,THET(I)
C
C
C
C
C
*************************************************************
C MODULE TO BE STUDIED HAS SSIG MULTPILIED BY 100.
C IN FTZFIT
IF(SSIG(I).GT.1.0)RES(I)=RES(I)*100.
C
IM=(IPRES(I)-1)/12
IF(ABS(RES(I)).GT.5.0)GOTO3400
C PLANAR RESIDULALS
**************ANGLE SELECTION********************************
CX IF(ABS(THET(I)-THSEL).LT.0.50)THEN
*************************************************************
IF(I.LE.NPLA)CALL SHS(IHX+257+IM,0.,RES(I))
C RADIAL RESIDUALS
IF(I.GT.NPLA)CALL SHS(IHX+260+IM,0.,RES(I))
CX ENDIF
3400 CONTINUE
ENDIF
RETURN
END
*