*-- Author : Stephen J. Maxfield 27/02/93
SUBROUTINE FILHIS
**-------------------------------------------------------------
*
* Fill some LOOK histograms for monitoring
* Forward Tracker Pattern Recognition.
*
*--------------------------------------------------------------
*
*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 ------
*KEEP,H1EVDT.
COMMON /H1EVDT/ KEVENT,IDATA,MONTE,LCONF
INTEGER KEVENT,IDATA,LCONF
LOGICAL MONTE
*
* 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,FDIFLG.
COMMON/LDIAG/IDIAG,IDIAG2,MAXPRT,IDOHIS,PMCUT
*KEEP,FPTFLG.
COMMON/FPTFLG/IPLAR, NIT, IREZ, LUNFP, NPLMAX
*KEND.
COMMON /WWFPTH/ INDPUR, INDTUR, INDRUX, INDPUX, INDRRX, INDRPX
*------statement functions for table access--------------------------
*KEEP,STFUNCT.
* index of element before row number IROW
INDR(IND,IROW)=IND+2+IW(IND+1)*(IROW-1)
* index of L'th element of row number IROW
INDCR(IND,L,IROW)=INDR(IND,IROW) + L
* L'th integer element of the IROW'th row of bank with index IND
IBTAB(IND,L,IROW)=IW(INDCR(IND,L,IROW))
* L'th real element of the IROW'th row of bank with index IND
RBTAB(IND,L,IROW)=RW(INDCR(IND,L,IROW))
*KEND.
*
*
*
*-----------------------------------------------------------------
* Fill Histograms.
*
* Zero all Work Bank Indices...
INDPUR = 0
INDTUR = 0
INDRUX = 0
INDPUX = 0
*
* 'Pointering' bank FPUR...
NBN = 0
IND = NLINK('FPUR',NBN)
IF (IND .EQ. 0) THEN
RETURN
ENDIF
CALL BKTOW(IW,'FPUR',NBN,IW,INDPUR,*900)
NTRK = IW(INDPUR+2)
*
* Number of tracks found...
CALL SHS(101, 0, FLOAT(NTRK))
*
*
*
* Level '0' track parameters...
NBN = 0
INDTUR = NLINK('FTUR',NBN)
IF (INDTUR .EQ. 0) THEN
GO TO 900
ENDIF
*
* List of radial hits...
NBN = 0
IND = NLINK('FRUX',NBN)
IF (IND .EQ. 0) THEN
GO TO 900
ENDIF
CALL BKTOW(IW,'FRUX',NBN,IW,INDRUX,*900)
*
* List of planar hits...
NBN = 0
IND = NLINK('FPUX',NBN)
IF (IND .EQ. 0) THEN
GO TO 900
ENDIF
CALL BKTOW(IW,'FPUX',NBN,IW,INDPUX,*900)
*
* Radial hit data (drifts etc.)...
INDRLC = NLINK('FRLC',NBN)
IF (INDRLC .EQ. 0) THEN
GO TO 900
ENDIF
*
* Planar hit data (drifts etc.)...
INDPLC = NLINK('FPLC',NBN)
IF (INDPLC .EQ. 0) THEN
GO TO 900
ENDIF
*
* Loop over pattern recognised tracks
NPRFND = 0
DO 1 JTRK = 1, NTRK
*
CURV = RBTAB(INDTUR, 1, JTRK )
PHI = RBTAB(INDTUR, 2, JTRK )
THETA = RBTAB(INDTUR, 3, JTRK )
*
IF(ABS(CURV) .GT. 0.) THEN
PTMEAS = ABS(0.0002998*12.0/CURV)
PMEAS = PTMEAS/ABS(SIN(THETA))
ELSE
PTMEAS = 0.0
PMEAS = 0.0
ENDIF
CALL SHS(102, 0, PHI )
CALL SHS(103, 0, THETA)
CALL SHS(104, 0, PMEAS)
IF (PMEAS .GT. 0.0) THEN
CALL SHS(105, 0, 1./PMEAS)
CALL SHS(106, 0, LOG(1./PMEAS))
ENDIF
*
NHITSR = IBTAB(INDPUR, 1, JTRK )
IPFRUX = IBTAB(INDPUR, 2, JTRK )
NHITSP = IBTAB(INDPUR, 3, JTRK )
IPFPUX = IBTAB(INDPUR, 4, JTRK )
*
* Get hit data for each radial hit on the track...
IPNEXT = IPFRUX
DO 6 KHIT = 1, NHITSR
* Drift from FRLC bank...
DRIFT = RBTAB(INDRLC, 2, IPNEXT)
RADIUS= RBTAB(INDRLC, 4, IPNEXT)
CALL SHS( 110,0, DRIFT)
CALL SHS( 111,0, RADIUS)
CALL SHD( 112,0, DRIFT, RADIUS)
IPNEXT = IBTAB(INDRUX,1,IPNEXT)
6 CONTINUE
* Get hit data for each planar hit on the track...
IPNEXT = IPFPUX
DO 7 KHIT = 1, NHITSP
* Drift from FPLC bank...
DRIFT = RBTAB(INDPLC, 2, IPNEXT)
CALL SHS( 113,0, DRIFT)
IPNEXT = IBTAB(INDPUX,1,IPNEXT)
7 CONTINUE
* ...Monte Carlo
*
1 CONTINUE
* ...Loop over tracks
*
*----------- Done ----------------------------------------
* Drop all Work banks (unused ones should have index 0 so O.K.)
900 CONTINUE
CALL WDROP(IW,INDPUR)
CALL WDROP(IW,INDRUX)
CALL WDROP(IW,INDPUX)
*
RETURN
END
*