*-- Author : Stephen Burke
SUBROUTINE FFTEXT
*-----------------------------------------Updates 21/09/93-------
**: FFTEXT.......SB. Turn off momentum cuts for zero field.
*-----------------------------------------Updates 30/11/92-------
**: FFTEXT.......SB. New steering cuts; FFRS bank format changed.
*-----------------------------------------Updates 13/03/92-------
**: FFTEXT 30205.SB. Suppress printout if IW(6).LE.0
*-----------------------------------------Updates 13/02/92-------
**: FFTEXT 30205.SB. Steering banks/parameters modified.
**: FFTEXT 30205.SB. Now protected against getting wrong version
**: FFTEXT 30205.SB. of steering banks.
**: FFTEXT 30205.SB. ERRLOG error numbers changed.
**: FFTEXT 30205.SB. Printout format improved.
*-----------------------------------------Updates 07/02/92-------
**: FFTEXT 30205.SB. Add printout of main steering parameters.
*-----------------------------------------Updates 24/01/92-------
**: FFTEXT 30205.SB. Small bug fix in debug steering.
*-----------------------------------------Updates----------------
**********************************************************************
* *
* Initialise the Kalman filter using data read in from steering *
* banks: *
* *
* FFTS - general steering flags *
* FFTP - various parameters *
* FFTM - `maps', i.e. parameters set for each wire plane *
* *
**********************************************************************
*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,FFSTEE.
PARAMETER (NFT=72)
LOGICAL LRISV,LWMAP,LGRAPH,LTRUTH
REAL DSX,DSY,DSQOP,DSTTH,DSPHI,PMCUT,PCUT,CHPCUT
&, QOPMAX,THEMAX,RFTMIN,RFTMAX,CEMAX
COMMON /FFSTEE/ DSX,DSY,DSQOP,DSTTH,DSPHI
&, PMCUT,IDIAG,JPLRSV,LRISV,LWMAP(NFT),JPLMAX
&, IRP(NPL),JPLFT(NPL),JFTPL(NFT)
&, LUNGKS,IWKGKS,IDGKS,LUNHB,LUNGKM,IWKGKM,IDGKM
&, LGRAPH,LTRUTH,IHFF,IHFK,ISRJCT,PCUT,CHPCUT
&, QOPMAX,THEMAX,RFTMIN,RFTMAX,CEMAX
*KEEP,FKCNTL.
COMMON /FKCNTL/ LUN,IPR,ITR,IPL,JSTART,JSTOP,JLAST,JSTEP
*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,FKCONS.
DOUBLE PRECISION ZPL,DZPL,RADL
COMMON /FKCONS/ ZPL(NPL),DZPL(NPL),RADL(NPL)
*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,FKLERR.
PARAMETER(NROUT=20,NCODE=50)
COMMON /FKLERR/ NMERR(NCODE,NROUT),NUERR(NCODE,NROUT)
&, NFAT,NERR,NOFL,NUFL,IULAST,IRLAST,MAXERR
*KEEP,BCS.
INTEGER NHROW,NHCOL,NHLEN
PARAMETER (NHROW = 2, NHCOL = 1, NHLEN=2)
INTEGER NBOSIW
PARAMETER (NBOSIW=1000000)
INTEGER IW(NBOSIW)
REAL RW(NBOSIW)
COMMON /BCS/ IW
EQUIVALENCE (RW(1),IW(1))
SAVE /BCS/
*KEND.
DIMENSION NMES(NFT),R(3),B(3)
DATA NMES/12*1,12*2,12*1,12*2,12*1,12*2/
**********************************************************************
IF (NFT.GT.NPL) THEN
WRITE(6,*)
WRITE(6,*) '**FFTEXT** NFT.GT.NPL; coding error'
WRITE(6,*)
CALL H1STOP
ENDIF
* Get the steering bank
CALL UGTBNK('FFTS',INDS)
IF (INDS.GT.0) THEN
IVERS = IW(INDS+1)
IF (IVERS.NE.301192) THEN
INDS = 0
CALL ERRLOG(381,'F:FFTEXT: Wrong version of bank FFTS;'//
& ' defaults used')
ENDIF
ELSE
CALL ERRLOG(382,'W:FFTEXT: Bank FFTS not found;'//
& ' defaults used')
ENDIF
IF (INDS.LE.0) THEN
IDIAG = 0
PMCUT = 0.
LRISV = .FALSE.
JPLISV = 37
ISRJCT = 0
PCUT = 0.1
CHPCUT = 0.0001
LUNHB = 0
LUNGKS = 20
IWKGKS = 8601
IDGKS = 1
LUNGKS = 21
IWKGKS = 4
IDGKS = 2
QOPMAX = 1000.0
THEMAX = 1.0
RFTMIN = 12.0
RFTMAX = 80.0
CEMAX = 100.0
ELSE
LUN = IW(INDS+2)
IPR = IW(INDS+3)
MAXERR = IW(INDS+4)
IDIAG = IW(INDS+5)
PMCUT = RW(INDS+6)
IF (IW(INDS+7).EQ.1) THEN
LPOINT = .TRUE.
ELSE
LPOINT = .FALSE.
ENDIF
IF (IW(INDS+8).EQ.1) THEN
LBLOCK = .TRUE.
ELSE
LBLOCK = .FALSE.
ENDIF
IF (IW(INDS+9).EQ.1) THEN
LPRINI = .TRUE.
ELSE
LPRINI = .FALSE.
ENDIF
IF (IW(INDS+10).EQ.1) THEN
LRISV = .TRUE.
ELSE
LRISV = .FALSE.
ENDIF
JPLRSV = IW(INDS+11)
ISRJCT = IW(INDS+12)
PCUT = RW(INDS+13)
CHPCUT = RW(INDS+14)
LUNHB = IW(INDS+15)
LUNGKS = IW(INDS+16)
IWKGKS = IW(INDS+17)
IDGKS = IW(INDS+18)
LUNGKM = IW(INDS+19)
IWKGKM = IW(INDS+20)
IDGKM = IW(INDS+21)
QOPMAX = RW(INDS+22)
THEMAX = RW(INDS+23)
RFTMIN = RW(INDS+24)
RFTMAX = RW(INDS+25)
CEMAX = RW(INDS+26)
ENDIF
* Don't cut on momentum if field is too small
CALL VZERO(R,3)
CALL GUFLD(R,B)
IF (ABS(B(3)).LT.1.0) THEN
PCUT = -1.0
QOPMAX = -1.0
ENDIF
* Decode diagnostic steering
IF (MOD(IDIAG,10).GT.0) THEN
LGRAPH = .TRUE.
ELSE
LGRAPH = .FALSE.
ENDIF
IF (MOD(IDIAG/10,10).GT.0) THEN
LTRUTH = .TRUE.
ELSE
LTRUTH = .FALSE.
ENDIF
IHFK = MOD(IDIAG/100,1000)
IHFF = IDIAG/100000
* Get the parameter bank
CALL UGTBNK('FFTP',INDP)
IF (INDP.GT.0) THEN
IVERS = IW(INDP+1)
IF (IVERS.NE.13292) THEN
INDP = 0
CALL ERRLOG(383,'F:FFTEXT: Wrong version of bank FFTP;'//
& ' defaults used')
ENDIF
ELSE
CALL ERRLOG(384,'W:FFTEXT: Bank FFTP not found;'//
& ' defaults used')
ENDIF
IF (INDP.LE.0) THEN
DSX = 1.0
DSY = 1.0
DSQOP = 1.0
DSTTH = 0.1
DSPHI = 0.1
ELSE
X2PCUT = RW(INDP+2)
X2CUTB = RW(INDP+3)
X2CUTA = RW(INDP+4)
X2CUTN = RW(INDP+5)
X2PCTI = RW(INDP+6)
X2CTBI = RW(INDP+7)
X2CTAI = RW(INDP+8)
X2CTNI = RW(INDP+9)
DSX = RW(INDP+10)
DSY = RW(INDP+11)
DSQOP = RW(INDP+12)
DSTTH = RW(INDP+13)
DSPHI = RW(INDP+14)
ENDIF
* Get the map bank
CALL UGTBNK('FFTM',INDM)
IF (INDM.GT.0) THEN
IVERS = IW(INDM+1)
IF (IVERS.NE.13292) THEN
INDM = 0
CALL ERRLOG(385,'F:FFTEXT: Wrong version of bank FFTM;'//
& ' defaults used')
ENDIF
ELSE
CALL ERRLOG(386,'W:FFTEXT: Bank FFTM not found;'//
& ' defaults used')
ENDIF
IF (INDM.LE.0) THEN
DO 100 JFT=1,NFT
LWMAP(JFT) = .TRUE.
IRP(JFT) = NMES(JFT)
JPLFT(JFT) = JFT
JFTPL(JFT) = JFT
100 CONTINUE
JPLMAX = NFT
ELSE
DO 200 JPL=1,NPL
NBLOCK(JPL) = IW(INDM+JPL+1)
IF (IW(INDM+NPL+JPL+1).EQ.1) THEN
LWIRE(JPL) = .TRUE.
ELSE
LWIRE(JPL) = .FALSE.
ENDIF
RAD = RW(INDM+2*NPL+JPL+1)
IF (RAD.GT.0.) THEN
RADL(JPL) = RAD
LRAD(JPL) = .TRUE.
ELSE
RADL(JPL) = -RAD
LRAD(JPL) = .FALSE.
ENDIF
200 CONTINUE
JPLMAX = 0
DO 300 JFT=1,NFT
IF (IW(INDM+3*NPL+JFT+1).EQ.1) THEN
JPLMAX = JPLMAX + 1
LWMAP(JFT) = .TRUE.
JFTPL(JFT) = JPLMAX
IRP(JPLMAX) = NMES(JFT)
JPLFT(JPLMAX) = JFT
ELSE
LWMAP(JFT) = .FALSE.
JFTPL(JFT) = 0
ENDIF
300 CONTINUE
ENDIF
*Check print flag
IF (IW(6).LE.0) RETURN
WRITE(LUN,*)
WRITE(LUN,*)
WRITE(LUN,*) ' *** Kalman Filter steering parameters ***'
WRITE(LUN,*)
WRITE(LUN,*)
IF (LPOINT) THEN
WRITE(LUN,*) 'Point rejection enabled'
WRITE(LUN,1000) X2PCUT
ELSE
WRITE(LUN,*) 'Point rejection disabled'
ENDIF
IF (LBLOCK) THEN
WRITE(LUN,*) 'Block point rejection enabled'
WRITE(LUN,1000) X2CUTB
ELSE
WRITE(LUN,*) 'Block point rejection disabled'
ENDIF
IF (LPOINT .OR. LBLOCK) THEN
WRITE(LUN,*) 'Point reacquisition enabled'
WRITE(LUN,1000) X2CUTA
WRITE(LUN,*) 'New point finding enabled'
WRITE(LUN,1000) X2CUTN
ELSE
WRITE(LUN,*) 'New point finding disabled'
ENDIF
WRITE(LUN,*)
IF (LRISV) THEN
WRITE(LUN,*) 'Initial state vector removed'
WRITE(LUN,1001) JPLRSV
IF (LPRINI) THEN
IF (LPOINT) THEN
WRITE(LUN,*) 'Point rejection performed on first pass'
WRITE(LUN,1000) X2PCTI
ENDIF
IF (LBLOCK) THEN
WRITE(LUN,*)
& 'Block point rejection performed on first pass'
WRITE(LUN,1000) X2CTBI
ENDIF
IF (LPOINT .OR. LBLOCK) THEN
WRITE(LUN,*)
& 'Point reacquisition performed on first pass'
WRITE(LUN,1000) X2CTAI
WRITE(LUN,*) 'New point finding performed on first pass'
WRITE(LUN,1000) X2CTNI
ENDIF
ELSEIF (LPOINT .OR. LBLOCK) THEN
WRITE(LUN,*) 'Point rejection not performed on first pass'
WRITE(LUN,*) 'New point finding not performed on first pass'
ENDIF
ELSE
WRITE(LUN,*) 'Initial state vector not removed'
ENDIF
WRITE(LUN,*)
WRITE(LUN,1002) ISRJCT
WRITE(LUN,1003) PCUT
WRITE(LUN,1004) CHPCUT
WRITE(LUN,1005) QOPMAX
WRITE(LUN,1006) THEMAX
WRITE(LUN,1007) RFTMIN
WRITE(LUN,1008) RFTMAX
WRITE(LUN,1009) CEMAX
1000 FORMAT(' Chi-squared probability cut: ',F7.4)
1001 FORMAT(' Starting plane: ',I2)
1002 FORMAT(' Track rejection flag: ',I7/)
1003 FORMAT(' Initial momentum cut: ',F5.2)
1004 FORMAT(' Final chi-squared probability cut: ',F7.4)
1005 FORMAT(' Final 1/momentum cut: ',F7.2)
1006 FORMAT(' Final theta cut: ',F7.4)
1007 FORMAT(' Minimum radius allowed: ',F7.2)
1008 FORMAT(' Maximum radius allowed: ',F7.2)
1009 FORMAT(' Maximum chi-squared between start/end:',F7.2/)
WRITE(LUN,1010) DSX
WRITE(LUN,1011) DSY
WRITE(LUN,1012) DSQOP
WRITE(LUN,1013) DSTTH
WRITE(LUN,1014) DSPHI
1010 FORMAT(' Initial error on x: ',F5.2)
1011 FORMAT(' Initial error on y: ',F5.2)
1012 FORMAT(' Initial error on q/p: ',F5.2)
1013 FORMAT(' Initial error on tan(theta): ',F6.3)
1014 FORMAT(' Initial error on phi: ',F6.3//)
RETURN
END
*