*-- Author : S Burke / J.V. Morris
SUBROUTINE FKLFTR(IERR)
**********************************************************************
* *
* Kalman fit with removal of the initial state vector *
* *
* Calling sequence is as for FKLFIT *
* *
* ERROR CONDITIONS; *
* *
* IERR = 0 ; normal termination *
* -> IERR = 101 ; no starting point was provided *
* -> IERR = 102 ; not enough measurements to fit *
* -> IERR = 103 ; invalid value in MES array *
* -> IERR = 104 ; invalid value of JSTART, JSTOP or JLAST *
* IERR = 8 ; covariance n.p.d. in FKLWM (1st call) *
* IERR = 9 ; covariance n.p.d. in FKLWM (2nd call) *
* IERR = 20 + n ; 2 < n < 10 iterations in point rejection *
* -> IERR = 130 ; 10 iterations in point rejection *
* IERR = 30 + n ; 2 < n < 10 iterations over fit sections *
* -> IERR = 140 ; 10 iterations over fit sections *
* IERR = 40 + n ; 1 < n < 10 restarts *
* -> IERR = 150 ; 10 restarts *
* -> IERR = 200 + ee ; fatal error ee from FKLPRO *
* -> IERR = 300 + ee ; fatal error ee from FKLFIL *
* -> IERR = 400 + ee ; fatal error ee from FKLSMO *
* -> IERR = 500 + ee ; fatal error ee from FKLPRS *
* -> IERR = 600 + ee ; fatal error ee from FKLPAS *
* *
* -> Fatal errors *
* *
**********************************************************************
*KEEP,FKECODE.
*KEND.
*KEEP,FKNPL.
*
* Per-track values can go in H1WORK; note that LTRUE and LFIRST must
* be set at least per event.
*
* This is about 36k words long; the remaining common blocks are
* about 3.6k in total. Some of this could be in /H1WORK/, but the
* blocks would have to be reorganised.
*
* /FKPROJ/
* /FKFILT/
* /FKSMTH/
* /FKINT/
* /FKRSID/
* /FKTRUE/
* /FKDBG/
*KEEP,FKCNTL.
*KEEP,FKFLAG.
*KEEP,FKCONS.
*KEEP,FKPROJ.
*KEEP,FKFILT.
*KEEP,FKSMTH.
*KEEP,FKRJCT.
*KEEP,FKTRUE.
*KEEP,FKINT.
*KEND.
**********************************************************************
**********************************************************************
* Remember values of parameters which will be changed
CALL UCOPY(SPRO(1,JSTART),STEMP,10)
CALL FKCOPY(CPRO(1,1,JSTART),CTEMP)
* Initialise flags
* Re-entry point for re-starts
* These need to be re-set for each pass
* Set the stop point to the start point
* Switch off residuals and point rejection for the first pass
CALL FKPRSV(1)
CALL FKLFIT(IFAIL)
CALL FKPRSV(-1)
* Check errors
IF (IFAIL.NE.0) CALL FKERR(IUTIL,IROUT,IFAIL/100,IFAIL,IERR)
* If this is getting too complicated, start again from scratch!
* Now loop over the two sections until no points are altered
* Remove the initial vector (to create a FILTERED vector)
CALL FKLWM(-1,SSMT(1,JSTART),CSMT(1,1,JSTART),SPRO(1,JSTART),
* If the vector can't be removed we have a serious problem
CALL FKERR(IUTIL,IROUT,IWARN,IOCV+(ISEC-5)/2,IERR)
* If we've rejected some points, start again from the beginning
* First part is OK, so do half of the filter the other way round
* If it happens at the start, leave the initial vector in and carry on
CALL UCOPY(SSMT(1,JSTART),SFIL(1,JSTART),10)
CALL FKCOPY(CSMT(1,1,JSTART),CFIL(1,1,JSTART))
* Change direction
* We've filtered at this point, so project into the other section
CALL FKLPRO(JSTART,IFAIL)
CALL FKERR(IUTIL,IROUT,IFPRO,IFAIL,IERR)
* Flip the start and end points, and filter the other section
CALL FKLFIT(IFAIL)
IF (IFAIL.NE.0) CALL FKERR(IUTIL,IROUT,IFAIL/100,IFAIL,IERR)
* We've been once over every plane, so don't zero IRJCT again
* If NPASS is > 1 we rejected some points, so quit and start again
* If no point was rejected, and this isn't the first time, that's all
* Don't change error code
IF (NTRY.GT.1) CALL FKERR(IUTIL,IROUT,IWARN,IFREE2+NTRY,IER)
* Restore the saved vectors
CALL FKSAVE(-1,JBEGIN,JSTART-JSTEP)
* Pass back code 11 if it occurred
IF (NSEC.GT.2) CALL FKERR(IUTIL,IROUT,IWARN,IFREE1+NSEC,IER)
IF (NTRY.GT.1) CALL FKERR(IUTIL,IROUT,IWARN,IFREE2+NTRY,IER)
IF (NTRY.GT.1) CALL FKERR(IUTIL,IROUT,IWARN,IFREE2+NTRY,IERR)
CALL FKERR(IUTIL,IROUT,IFATAL,IFREE2,IERR)
* Reset the end-point flags so we don't screw up the calling routine
*
* We get here if FKLWM fails on the second removal
* The fixup is to do half of the filter the other way round
*
* Save the smoothed vectors/residuals between JSTART and JLAST
CALL FKSAVE(1,JSTART,JLAST)
* Reset the starting values, and start again
* This resets everything and starts again
CALL FKERR(IUTIL,IROUT,IFATAL,IFREE3,IERR)
CALL UCOPY(STEMP,SPRO(1,JSTART),10)
CALL FKCOPY(CTEMP,CPRO(1,1,JSTART))
*