*-- Author : Stephen Burke SUBROUTINE FFKAL *-----------------------------------------Updates 07/09/93------- **: FFKAL 40000 SB. No more garbage collection. *-----------------------------------------Updates 27/07/93------- **: FFKAL 30907 RP. Farm changes. *-----------------------------------------Updates 03/05/93------- **: FFKAL 30907 SB. Print summary on ENDJOB. **: FFKAL 30907 SB. Output LOOK histograms. *-----------------------------------------Updates 30/11/92------- **: FFKAL 30907 SB. Print new counters. **: FFKAL 30907 SB. Call new diagnostic routine FFTRAN. *-----------------------------------------Updates 06/08/92------- **: FFKAL 30907 SB. Cosmetic changes. *-----------------------------------------Updates 13/03/92------- **: FFKAL 30205.SB. Put REVENT code after ENDRUN code **: FFKAL 30205.SB. Suppress printout if IW(6).LE.0 *-----------------------------------------Updates 13/02/92------- **: FFKAL 30205.SB. Small cosmetic change (IFIRST -> LINIT). **: FFKAL 30205.SB. ERRLOG error numbers changed. *-----------------------------------------Updates 07/02/92------- **: FFKAL 30205.SB. Change printout format slightly. *-----------------------------------------Updates 24/01/92------- **: FFKAL 30205.SB. BKFMT calls moved here. **: FFKAL 30205.SB. New counters added. **: FFKAL 30205.SB. Call H1STOP if initialisation fails. **: FFKAL 30205.SB. ERRLOG message format changed. **: FFKAL 30205.SB. Make sure PAW directory is reset. *-----------------------------------------Updates---------------- ********************************************************************** * * * Steer Kalman filter track fit on results of FTREC * * * ********************************************************************** *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,FFSCAL. * Counters PARAMETER (NSCAL=145) COMMON /FFSCAL/ NPFAIL,NRFAIL,NXFAIL,NFFAIL,NMFAIL,NBFAIL,NTFAIL &, NWFAIL,NNSPLT,NNMISS,NNMISP &, NQFAIL,NAFAIL,NOFAIL,NIFAIL &, NTRIN,NTROUT,NPRSEG(0:7,0:7),N23SEG(0:7,0:7) *KEEP,FFWBI. * Work bank indices (note that INDKTR is *NOT* a work bank index!) PARAMETER (NWBI=10) COMMON /FFWBI/ INDRSX(2),INDX(2),INDKX(2),INDPUR &, INDKTR,INDKTX,INDTPR *KEEP,FFDBG. CHARACTER*5 CFDBG CHARACTER*6 CFKDBG PARAMETER (CFDBG='FFDBG',CFKDBG='FFKDBG') PARAMETER (NTRACK=1000) COMMON /FFDBG/ ITRTR(2,NTRACK),ITRNF(5,NTRACK),JTRTR *KEEP,FKDBG. *KEND. LOGICAL LINIT SAVE LINIT *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/ *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. DATA LINIT/.TRUE./ ********************************************************************** * Initialise Kalman filter, and set parameter defaults IF (BEGJOB) CALL FKINIT IF (BEGRUN .AND. LINIT) THEN * Zero work bank indices (just in case ...) CALL VZERO(INDRSX,NWBI) * Zero counters CALL VZERO(NPFAIL,NSCAL) * Override defaults with parameters read from text banks CALL FFTEXT * Format output banks CALL BKFMT('FTKR','2I,(6F,I,9F,I,F,3I)') CALL BKFMT('FTKX','B16') CALL BKFMT('FTPR','B16') CALL BKFMT('FTPX','B16') CALL BKFMT('FTRX','B16') * Book monitoring histograms CALL FFBKLK * Book some debug histograms CALL FKHBK CALL FFHBK * Initialise GKS LINIT = .FALSE. ENDIF IF (REVENT .AND. LINIT) THEN * This shouldn't happen! WRITE(6,*) WRITE(6,*) '**FFKAL** Not initialised - code error' WRITE(6,*) CALL H1STOP ENDIF IF (ENDRUN.OR.ENDJOB) CALL FFEND IF (.NOT.REVENT) RETURN CALL FFFIT * Count tracks INFTUR = NLINK('FTUR',0) IF (INFTUR.GT.0) NTRIN = NTRIN + IW(INFTUR+2) INFTKR = NLINK('FTKR',0) IF (INFTKR.GT.0) NTROUT = NTROUT + IW(INFTKR+2)/2 * Check output IF (MOD(IHFF,1000).GT.100) CALL FFKLCH IF (LTRUTH) CALL FFTRAN * Make sure PAW directory is reset CALL HCDIR('//PAWC',' ') RETURN END *