*-- Author : Stephen Burke 30/08/93
SUBROUTINE FPT0
*-----------------------------------------Updates 07/09/93-------
**: FPT0 40000 SB. New routine to plot DT vs. trigger element.
*-----------------------------------------Updates----------------
**********************************************************************
* *
* Histogram the planar drift time distribution for each trigger *
* element. *
* *
**********************************************************************
COMMON /FPT0XX/ INFRPE
*KEEP,CTCPAR.
*
* DESCRIPTION of INPUT CARDS
* number of CTC_Input cards
INTEGER NCARD
PARAMETER (NCARD=3)
* number of Trigger Elements groups per card
* and number of trigger elements per group
INTEGER NTEGRP,NTEPGP
PARAMETER (NTEGRP=8,NTEPGP=8)
* number of Trigger Elements
INTEGER NTELMS
PARAMETER (NTELMS=NTEGRP*NTEPGP*NCARD)
* number of trigger elements per word
INTEGER NTE_P_WRD
PARAMETER (NTE_P_WRD=32)
* number of trigger element words
INTEGER TE_NWORD
PARAMETER (TE_NWORD=NTELMS/NTE_P_WRD)
* number of RAM (8(11) bit groups)
INTEGER NRAM
PARAMETER (NRAM=NTEGRP*NCARD)
* maximal number of bits per RAM
INTEGER BPRAM
PARAMETER (BPRAM=11)
*
* DESCRIPTION of SUMMING CARDS
* number of CTC_Summing cards
INTEGER NSUMCD
PARAMETER (NSUMCD=4)
* number of subtriggers
INTEGER NSUBTR
PARAMETER (NSUBTR=128)
* number of subtriggers per card
INTEGER NST_P_CARD
PARAMETER (NST_P_CARD=32)
* number of subtrigger gate groups
INTEGER NST_GATEGR
PARAMETER (NST_GATEGR=8)
*
* TECHNICAL OFFLINE PARAMETERS
* maximum number of conditions per subtrigge
INTEGER MAXCON
PARAMETER (MAXCON=16)
*KEND.
INTEGER TEL1(0:NTELMS-1)
CHARACTER*256 TNAME
*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,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,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.
**********************************************************************
IF (BEGJOB) THEN
CALL HCDIR('//PAWC',' ')
CALL HMDIR('FPT0','S')
DO 100 JHIST=1,NTELMS
CALL TELNAM(JHIST-1,TNAME)
CALL HBOOK1(JHIST,'PLANAR DRIFT TIME - '//
& TNAME(1:LENB(TNAME)),100,0.,2000.,0.)
100 CONTINUE
CALL HMINIM(0,0.)
CALL HIDOPT(0,'INTE')
ENDIF
IF (ENDJOB) THEN
CALL HCDIR('//PAWC/FPT0',' ')
DO 200 JHIST=1,NTELMS
CALL HPRINT(JHIST)
200 CONTINUE
CALL HCDIR('//PAWC',' ')
RETURN
ENDIF
IF (.NOT.REVENT) RETURN
CALL UNTEL1(0,0,1,TEL1,IEXIST)
INFRPE = NLINK('FRPE',0)
IF (IEXIST.LE.0 .OR. INFRPE.LE.0) RETURN
CALL HCDIR('//PAWC/FPT0',' ')
INFRPE = 0
CALL BKTOW(IW,'FRPE',0,IW,INFRPE,*1000)
DO 700 JFRPE=1,IW(INFRPE+2)
DT = IBTAB(INFRPE,2,JFRPE)
DO 400 JB=1,NTELMS
IF (TEL1(JB-1).EQ.1) CALL HFILL(JB,DT,0.,1.)
400 CONTINUE
700 CONTINUE
1000 CONTINUE
* Must make sure work banks are dropped!!!
CALL WDROP(IW,INFRPE)
CALL HCDIR('//PAWC',' ')
RETURN
END
*