*-- Author : Stephen Burke SUBROUTINE FFFIT *-----------------------------------------Updates 22/11/93------- **: FFFIT.......SB. New parameters in FFOUT call. *-----------------------------------------Updates 27/07/93------- **: FFFIT 30907 SB. Changes to monitoring histograms. **: FFFIT 30907 RP. Farm changes. *-----------------------------------------Updates 03/03/93------- **: FFFIT 30907 SB. New monitoring histograms. *-----------------------------------------Updates 06/08/92------- **: FFFIT 30907 SB. Cosmetic changes. *-----------------------------------------Updates 03/06/92------- **: FFFIT 30907 SB. 1-column FTKR banks no longer made. **: FFFIT 30907 SB. Creation of empty files moved to FFOUT. **: FFFIT 30907 SB. Small fix to error counting. *-----------------------------------------Updates 28/04/92------- **: FFFIT 30907 SB. Make empty FTKX bank if necessary. *-----------------------------------------Updates 13/02/92------- **: FFFIT 30205.SB. ERRLOG error numbers changed. *-----------------------------------------Updates 24/01/92------- **: FFFIT 30205.SB. BKFMT calls moved to FFKAL. **: FFFIT 30205.SB. Count failures due to banks missing. **: FFFIT 30205.SB. ERRLOG message format changed. **: FFFIT 30205.SB. Add #tracks histogram call for empty events *-----------------------------------------Updates---------------- ********************************************************************** * * * Find various banks, and Kalman filter the FPATREC tracks * * * ********************************************************************** *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,FFSTEE. *KEEP,FFGEO. *KEEP,FKCNTL. *KEEP,FFSCAL. * Counters *KEEP,FFWBI. * Work bank indices (note that INDKTR is *NOT* a work bank index!) *KEEP,FFDBG. *KEEP,BCS. *KEEP,CNSTBF. *KEEP,BOSMDL. C ------BOSMDL C ------ *KEEP,H1EVDT. * * IDATA type of information (HEAD bank word 6) : * * 0 - real data H1 * 1 - MC data H1SIM * 2 - real data CERN tests * 3 - MC data ARCET * * MONTE = .TRUE. if IDATA=1 * KEVENT = event processed counter for H1REC * *KEEP,FTHIST. * indices of filter farm histos *KEEP,STFUNCT. * index of element before row number IROW * index of L'th element of row number IROW * L'th integer element of the IROW'th row of bank with index IND * L'th real element of the IROW'th row of bank with index IND *KEND. ********************************************************************** * Look for the track bank INFTUR = NLINK('FTUR',0) CALL ERRLOG(301,'S:FFFIT: Bank FTUR not found; Kalman ' CALL ERRLOG(302,'S:FFFIT: Too many tracks; Kalman ' * Unpacked geometry banks INDG1(1) = MLINK(LW,'FPG1',0) INDG1(2) = MLINK(LW,'FRG1',0) CALL FTCORG INDG1(1) = MLINK(LW,'FPG1',0) INDG1(2) = MLINK(LW,'FRG1',0) CALL ERRLOG(303,'S:FFFIT: Banks FPG1/FRG1 not found;'// * Unpacked digi banks (MUST always exist) INDLC(1) = NLINK('FPLC',0) CALL FPLOCO INDLC(1) = NLINK('FPLC',0) INDLC(2) = NLINK('FRLC',0) CALL FRLOCO INDLC(2) = NLINK('FRLC',0) CALL ERRLOG(304,'S:FFFIT: Banks FPLC/FRLC not found;'// INFPSG = NLINK('FPSG',0) INFRSG = NLINK('FRSG',0) CALL SHS(13,0,FLOAT(IW(INDLC(1)+2))) CALL SHS(14,0,FLOAT(IW(INDLC(2)+2))) IF (INFPSG.GT.0) CALL SHS(57,0,FLOAT(IW(INFPSG+2))) IF (INFRSG.GT.0) CALL SHS(58,0,FLOAT(IW(INFRSG+2))) * Zero the work bank indices CALL VZERO(INDX,2) CALL VZERO(INDRSX,2) * Get the pointering bank ... IF (NLINK('FPUR',0).LE.0) THEN CALL ERRLOG(305,'S:FFFIT: Bank FPUR not found; Kalman ' CALL BKTOW(IW,BANK,0,IW,INDPUR,*1000) CALL ERRLOG(306,'S:FFFIT: Bank FPUR has wrong length; Kalman ' * Now get the link banks ... IF (NLINK('FPUX',0).LE.0 .OR. NLINK('FRUX',0).LE.0) THEN CALL ERRLOG(307,'S:FFFIT: Banks FPUX or FRUX not found;'// CALL BKTOW(IW,BANK,0,IW,INDX(1),*1000) CALL BKTOW(IW,BANK,0,IW,INDX(2),*1000) * This is for MC data only - true track/digi link banks IF (NLINK('FRPX',0).GT.0) THEN CALL BKTOW(IW,BANK,0,IW,INDRSX(1),*1000) IF (NLINK('FRRX',0).GT.0) THEN CALL BKTOW(IW,BANK,0,IW,INDRSX(2),*1000) CALL HCDIR('//PAWC/'//CFDBG,' ') IF (MOD(IHFF,1000).GT.0) CALL HFILL(300,FLOAT(NTR),0.,1.) CALL VZERO(ITRTR,2*NTRACK) * Set the track number to (event no)*1000 + JTR * Fit each track in turn * Quick track rejection CALL FFKLMN(INFTUR,JTR) * Close the output banks CALL FFOUT(0,NPS,NRS) IF (MOD(IHFF,1000).GT.0) CALL FFTRCH 1000 CALL ERRLOG(308,'S:FFFIT: Bank '//BANK//' not found by BKTOW') * * Must make sure all work banks are dropped!!! * CALL WDROP(IW,INDPUR) CALL WDROP(IW,INDX(1)) CALL WDROP(IW,INDX(2)) CALL WDROP(IW,INDRSX(1)) CALL WDROP(IW,INDRSX(2)) *