*-- Author : S.Burke / J.V. Morris
SUBROUTINE FKPRSV(IFLAG)
**********************************************************************
* *
* Save/restore point-rejection status *
* *
* Save if IFLAG is >= 0; restore otherwise *
* *
* Note that the only form of error checking for a restore is that *
* values have been saved at least once. *
* *
**********************************************************************
IMPLICIT DOUBLE PRECISION (A-H,O-Z)
*KEEP,FKNPL.
CHARACTER*5 CKDBG
PARAMETER (CKDBG='FKDBG')
PARAMETER (NPL=72)
LOGICAL LTRUE,LFIRST,LTRPL,LTRPLD
DOUBLE PRECISION TRUE,RTRUE,CHITRU,SPRO,CPRO,SFIL,CFIL
&, SSMT,CSMT,SSMTR,CSMTR,DPRO,CBPRO,QPRO,QGAIN
&, RPRO,CRPRO,RFIL,CRFIL,RSMT,CRSMT,CHIFIL,CHISMT
*
* 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.
*
COMMON /H1WORK/
* /FKPROJ/
& SPRO(5,NPL),CPRO(5,5,NPL)
* /FKFILT/
&, SFIL(5,NPL),CFIL(5,5,NPL)
* /FKSMTH/
&, SSMT(5,NPL),CSMT(5,5,NPL)
&, SSMTR(5,NPL),CSMTR(5,5,NPL)
* /FKINT/
&, DPRO(5,5,NPL),CBPRO(5,5,NPL),QPRO(5,5,NPL)
&, QGAIN(5,5,NPL),IAPROX,LFIRST
* /FKRSID/
&, RPRO(2,NPL),CRPRO(2,2,NPL),RFIL(2,NPL)
&, CRFIL(2,2,NPL),RSMT(2,NPL),CRSMT(2,2,NPL)
&, CHIFIL(NPL),CHISMT(NPL)
* /FKTRUE/
&, TRUE(5,NPL),RTRUE(5,NPL),CHITRU(NPL),LTRUE
* /FKDBG/
&, LTRPL(NPL),LTRPLD(NPL)
*KEEP,FKFLAG.
LOGICAL LPRO,LFIL,LSMT,LMES,LRAD,LRPRO,LRFIL,LRSMT,LPOINT,LBLOCK
COMMON /FKFLAG/ LPRO(NPL),LFIL(NPL),LSMT(NPL),LMES(NPL)
&, LRAD(NPL),LRPRO,LRFIL,LRSMT,LPOINT,LBLOCK
*KEEP,FKRJCT.
DOUBLE PRECISION CHITOT,X2PCUT,X2CUTB,X2CUTA,X2CUTN
&, X2PCTI,X2CTBI,X2CTAI,X2CTNI
LOGICAL LWIRE,LPRINI
COMMON /FKRJCT/ X2PCUT,X2CUTB,X2CUTA,X2CUTN
&, X2PCTI,X2CTBI,X2CTAI,X2CTNI
&, CHITOT(NPL),NDF(NPL)
&, NBLOCK(NPL),NBADP(NPL),NBADB(NPL)
&, NFAILP(NPL),NFAILB(NPL),NNEWP(NPL)
&, NUNRJP(NPL),NUNRJB(NPL),NRERJP(NPL)
&, NCPRS,NBPRS,NCPAS,NPASS,IRJCT(NPL)
&, LWIRE(NPL),LPRINI
*KEEP,FKTRUE.
*KEND.
**********************************************************************
LOGICAL LFLAGS(5),LTEMP(5),LTTRUE
DIMENSION XCUTS(4),XCUTSI(4),XTEMP(4)
EQUIVALENCE (LFLAGS,LRPRO),(XCUTS,X2PCUT),(XCUTSI,X2PCTI)
SAVE LTEMP,LTTRUE,XTEMP,ILIM
DATA ILIM/0/
**********************************************************************
IF (IFLAG.LT.0) GOTO 1000
*
* Switch off residuals and point rejection, or leave point rejection on,
* but with a larger cut
*
IF (LPRINI) THEN
CALL UCOPY(XCUTS,XTEMP,8)
CALL UCOPY(XCUTSI,XCUTS,8)
ILIM = 3
ELSE
ILIM = 5
ENDIF
DO 100 I=1,ILIM
LTEMP(I) = LFLAGS(I)
LFLAGS(I) = .FALSE.
100 CONTINUE
LTTRUE = LTRUE
LTRUE = .FALSE.
RETURN
1000 CONTINUE
IF (ILIM.LE.0) RETURN
* Switch on residuals and PR as appropriate
IF (ILIM.EQ.3) CALL UCOPY(XTEMP,XCUTS,8)
DO 200 I=1,ILIM
LFLAGS(I) = LTEMP(I)
200 CONTINUE
LTRUE = LTTRUE
RETURN
END
*