c
c    hist8.f  
c
c     1994/6/3 Modification
c          add implicit none
c          hropen was changed to open the file name coressponding with run#
c          si_param.i was modified for fetching the run#( run_num )
c                by Hiroyuki Maeohmichi.
c
c     1995/2/22 modified  
c          1) In this beamtest, we don't use AT&T chip, so I comment out
c          the part related to AT&T chip ( hit logic ).
c          2) And I modified the subdirectory which histogram file is stored
c          to "/wrk1/sdc_si/feb95/data/hist".
c          3) I changed the algorithm to calculate the residual.
c          4) I re-defined bad channels
c                by Makoto Takahata
C     1995/2/27
C          1) clustering
C          2) unequal spacing between anchor1-DUT-anchor2
C                by Y. Unno
C     1995/3/28
C          1) occupancy/noise hit distance from the "best hit"
C          2) exclusion window for occupancy/noise evaluation
C                by Y. Hasegawa


      SUBROUTINE ANA_INIT()
      implicit none
      integer hmemory(300000)
      COMMON /PAWC/HMEMORY

      write(*,*)'executing ana_init'
      CALL hlimit(300000)

      RETURN
      END


      SUBROUTINE ANA_EXEC(IDATA)
      implicit none

      INTEGER IDATA(*)
      INCLUDE 'si_param.i'
      LOGICAL BTEST
     
      integer hmemory(300000)
      COMMON /PAWC/HMEMORY
      common/occup/trials(65,4),hits(65,4),eps(65,4),err(65,4)
        integer trials, hits
        real eps, err
C common for efficiencies, 1=P DUT, 2 = N DUT

      integer i,j,k
      integer itype
      integer nt,k1,k2,k3,exphit
c     IFB=1: n-side  IFB=0: p-side
      INTEGER IFB
      INTEGER JBIT,JBYT
      INTEGER NRUN,NEV,STATUS,ERRSTAT,NR_DATA
      INTEGER CHIP,NUMXFER,IND,BIT,DATUM,CHAN,TIMESLICE,WORD
      INTEGER tdc(2)
      LOGICAL HIT
      integer NR_HITS(16,10),HIT_STRIP(64,16,10)
      integer nl_hits(8), strip_hit(15,8),igood,ilay
      integer ncl_hits(8),xcl1,xcl2,wcl,strip_save
      integer kcl_trk(8)
      Integer nhitx
      real    minhit,ia1,ia2,ia3
      real    xcl_hit(15,8), wcl_hit(15,8), dstrip
      REAL    D(2),dd,RHIT,rptry,rntry,rpwin,rnwin,rhits
      real    rexphit, absrhit
      real    rexphit3,rexphit5,rexphit6
      real    wclhalf
      Real    dresdal
      DATA D/16.,8./
       integer ilg(8)/10,12,14,16,2,4,6,8/

      logical*1 badchan(16,64)
      data badchan/1024*0/
  
      LOGICAL KHITX, KHITY
      integer iadrs
C     INTEGER ICATT(2)
C     DATA ICATT/12,15/
C
C  flag for debugging ...
      logical*1 debug
      data debug/.false./


C  Tek chips ... n-side: hit=1, p-side: hit=0
C  ATT chips ... n-side: hit=1, p-side: hit=1
      call defbad( badchan )
      
      DO 10 I=1,7
         IF(BTEST(IDATA(2),I-1))
     +        CALL HF1(10, FLOAT(I)-0.5, 1.)
 10   CONTINUE

*     IDATA(  ) :
*            1  : # OF HEADER WORDS
*            2  : TRIGGER BIT : NORMAL-1, SPILL_END-2, ...
*            3  : ADDRESS OF ADC DATA (A1+1)
*            4  : ADDRESS OF TDC DATA (A2+1)
*            5  : ADDRESS OF DRS      (A3+1)
*         A1+1  : # OF ADC DATA
*         A2+1  : # OF TDC DATA
*         A3+1  : # OF DRS DATA
*         A3+2  : DRS READ STATUS
*         A3+3  : DRS BYTE COUNT
*         A3+4  : DRS ERROR WORDS
*         A3+5  : DRS SPARE

      IF(.NOT.BTEST(IDATA(2),1)) THEN

         CALL HF1(20, FLOAT(IDATA(IDATA(4)+2)), 1.)  !TDC DATA
         CALL HF1(30, FLOAT(IDATA(IDATA(4)+3)), 1.)  !TDC DATA
         CALL HF1(40, FLOAT(IDATA(IDATA(4)+4)), 1.)  !TDC DATA
         CALL HF1(50, FLOAT(IDATA(IDATA(4)+5)), 1.)  !TDC DATA
         TDC(1)=IDATA(IDATA(4)+2)
         TDC(2)=IDATA(IDATA(4)+3)
c         CALL HF1(60, 1000.+TDC(1)-TDC(2), 1.)
	 call hf2(70, float(idata(idata(4)+2)),
     +               float(idata(idata(4)+3)),1.) 

C     Get run, event number from header
         NRUN = IDATA(-3)
         NEV = IDATA(-2)
         
C     Check error status
         STATUS  = IDATA(IDATA(5)+2)
         ERRSTAT = IDATA(IDATA(5)+4)
         NR_DATA = IDATA(IDATA(5)+1)-5 
         CALL HF1(100, FLOAT(NR_DATA), 1.) 
         IF(JBIT(STATUS,9).EQ.1) THEN
            CHIP = JBYT(ERRSTAT,17,4)
            NUMXFER = JBYT(ERRSTAT,1,4)
C            WRITE(*,1000) NEV,STATUS,CHIP,NUMXFER
C 1000       FORMAT(' Event ',I6,' error status ',Z4,', chip ',I2,
C     >           ', during transfer ',I2)
            CALL HF1(91,FLOAT(CHIP),1.)
            RETURN
         END IF
C     
C     Expect NR_CHIPS*2*NR_TIMESLICES words
C     
         IF (NR_DATA.NE.2*NR_CHIPS*NR_TIMESLICES) THEN
C            WRITE(*,1001) NEV,NR_DATA
C 1001       FORMAT(' Event ',I6,' unexpected data length = ',
C     +           I4,' words')
            RETURN
         END IF
         
         IADRS=IDATA(5)+5
         
C     WRITE(*,*) 'DATA H =',(IDATA(IDATA(5)+J),J=1,5)
         
         DO 100 NT=1,NR_TIMESLICES
C         NT=2
         DO 20 I=1,NR_CHIPS
            NR_HITS(I,NT)=0
            CHIP=CHIP_ADDRESS(I)
            ITYPE=MOD(CHIP,4)
            IF(ITYPE.EQ.0.OR.ITYPE.EQ.1) IFB=1
            IF(ITYPE.EQ.2.OR.ITYPE.EQ.3) IFB=0
            DO 30 J=0,1
               IADRS=IADRS+1
               DO 40 K=1,32
cc                  IF(IFB.EQ.0.AND.
cc     +                 (.NOT.BTEST(IDATA(IADRS),K-1))) THEN
cc                     CALL HF1(1000+CHIP*10,FLOAT(65-32*J-K),1.)
cc                     CALL HF1(2000+CHIP*10,FLOAT(NT),1.)
cc                     NR_HITS(I,NT)=NR_HITS(I,NT)+1
cc                     HIT_STRIP(NR_HITS(I,NT),I,NT)=FLOAT(65-32*J-K)
cc                  ENDIF
cc                  IF(IFB.EQ.1.AND.
cc     +                    (BTEST(IDATA(IADRS),K-1))) THEN
cc                     CALL HF1(1000+CHIP*10,FLOAT(32*J+K),1.)
cc                     CALL HF1(2000+CHIP*10,FLOAT(NT),1.)
cc                     NR_HITS(I,NT)=NR_HITS(I,NT)+1
cc                     HIT_STRIP(NR_HITS(I,NT),I,NT)=FLOAT(32*J+K)
cc                  ENDIF

C                 AT&T chip ...
C                 IF(CHIP.GE.ICATT(1).AND.CHIP.LE.ICATT(2)) THEN
C                    KHITX = .NOT.BTEST(IDATA(IADRS),K-1)
C                    KHITY = KHITX
C                 ELSE
C                 Tek chip ...
                     KHITX = BTEST(IDATA(IADRS),K-1)
                     KHITY = .NOT.KHITX
C                 ENDIF

                  IF(IFB.EQ.0.AND.KHITY) THEN
                     if( badchan(CHIP,65-32*j-k) .eq. 0 ) then
                     NR_HITS(I,NT)=NR_HITS(I,NT)+1
CC                     HIT_STRIP(NR_HITS(I,NT),I,NT)=65-(J*32+K)+64*ILR
                     HIT_STRIP(NR_HITS(I,NT),I,NT)=FLOAT(65-(J*32+K))
                       CALL HF1(1000+CHIP*10,FLOAT(65-32*J-K),1.)
                       CALL HF1(2000+CHIP*10,FLOAT(NT),1.)
                     endif

                  ELSE IF(IFB.EQ.1.AND.KHITX) THEN
                     if( badchan(CHIP,32*j+k) .eq. 0 ) then
                     NR_HITS(I,NT)=NR_HITS(I,NT)+1
CC                     HIT_STRIP(NR_HITS(I,NT),I,NT)=J*32+K+64*ILR
                     HIT_STRIP(NR_HITS(I,NT),I,NT)=FLOAT(J*32+K)

                       CALL HF1(1000+CHIP*10,FLOAT(32*J+K),1.)
                       CALL HF1(2000+CHIP*10,FLOAT(NT),1.)
                     end if

                  ENDIF


 40            CONTINUE
 30         CONTINUE
 20      CONTINUE
 100     CONTINUE
*
* compress out time slice dependence . do this for 6 layers
* of interest. (9,11,13,(15),1,3,5,7). 15 is not fully bonded out,
* so ignore it for now. put data into strip_hit(hits,layer) and
* nl_hits(layer) , layer = 1,8 corresponding to the above list.
* some other definitions:
*
* anchor layer  1  = board 2   = chips 9,11  (N,P)
*               2          3          13,15  
*              DUT         0           1, 3
*               3          1           5, 7

        Do i=1,8
 	  nl_hits(i)=0
        enddo

	do nt=1,nr_timeslices
	 	do ilay=1,8
		   do k1=1,nr_hits(ilg(ilay),nt)
		      igood=1
		      if(nl_hits(ilay).gt.0) then
			do i=1,nl_hits(ilay)
			   if(hit_strip(k1,ilg(ilay),nt).eq.
     >				strip_hit(i,ilay))igood=0
			enddo
		      endif
		       if(igood.eq.1.and.nl_hits(ilay).lt.15) then
			nl_hits(ilay)=nl_hits(ilay)+1
			strip_hit(nl_hits(ilay),ilay)=
     >				hit_strip(k1,ilg(ilay),nt)
		       endif
		   enddo
		enddo
	enddo
C
C before proceeding, add diagnostic histos of the hit pattern by
C chip for comparison with online...
C
	do i=1,8
	  if(nl_hits(i).gt.0) then

CC             write(6,6911) i,(strip_hit(j,i),j=1,nl_hits(i))
CC 6911        format(1h ,'i,strip_hit',15i3)

             do j=1,nl_hits(i)
                call hf1(700+i, float(strip_hit(j,i)),1.)
             enddo
           endif
         enddo
C
C timeslice compression complete. now look for p-n matches on
C anchor layers 1 and 3 (chips 9,11 & 5,7)
C
C  clusterize the hits first...
C    ncl_hits(pl#)     = number of clusters per plane
C    xcl_hit(cl#,pl#) = geometrical center of the cluster of hits
C    wcl_hit(cl#,pl#) = width of the cluster
C  strip_hit(j,i) is not in order (strange but...)...loop for check...
C
C  do not use the chip-edge strip...(not implemented as of 95/2/27)
	do i=1,8
          ncl_hits(i) = 0
          if(nl_hits(i).gt.0) then
            ncl_hits(i)=1
            xcl_hit(1,i)=strip_hit(1,i)
            wcl_hit(1,i)=1

            if( nl_hits(i).gt.1) then
C
C    sort the strip_hit...
              do j=1,nl_hits(i)
                k1=j+1
                do k=k1,nl_hits(i)
                  if(strip_hit(k,i).lt.strip_hit(j,i)) then
                    strip_save = strip_hit(j,i)
                    strip_hit(j,i)=strip_hit(k,i)
                    strip_hit(k,i)=strip_save
                  endif
                enddo
              enddo
C          
C clusterize ...
              xcl1= strip_hit(1,i)
              xcl2=xcl1
              wcl=1
              do j=2,nl_hits(i)
                dstrip = strip_hit(j,i)-xcl2
                if( dstrip .gt. 1) then
                  xcl_hit(ncl_hits(i),i)=float(xcl1+xcl2)/2.
                  wcl_hit(ncl_hits(i),i)=float(xcl2-xcl1+1)

                  ncl_hits(i) = ncl_hits(i)+1
                  xcl1 = strip_hit(j,i)
                endif
                xcl2=strip_hit(j,i)
                if( j.eq.nl_hits(i)) then
                  xcl_hit(ncl_hits(i),i)=float(xcl1+xcl2)/2.
                  wcl_hit(ncl_hits(i),i)=float(xcl2-xcl1+1)
                endif
              enddo
            endif
          endif
        enddo

        CALL HF1(496,FLOAT(ncl_hits(1)),1.)
        CALL HF1(497,FLOAT(ncl_hits(2)),1.)
        CALL HF1(498,FLOAT(ncl_hits(7)),1.)
        CALL HF1(499,FLOAT(ncl_hits(8)),1.)
C
C select events with one cluster in each layer
C
        nhitx = ncl_hits(1)*ncl_hits(2)*ncl_hits(7)*ncl_hits(8)
        If(nhitx.eq.1) then

C
C find single 'best' match in anchors 1 & 3
C
        do i=1,8
          kcl_trk(i)=0
        enddo

	minhit=999.
	rhits=999.
        if( ncl_hits(1).gt.0.and.ncl_hits(2).gt.0) then
	  do k1=1,ncl_hits(1)
            do k2 = 1,ncl_hits(2)
              rhit=abs(xcl_hit(k1,1)-xcl_hit(k2,2))
              if(rhit.lt.15. .and. rhit.lt.abs(rhits)) then
                minhit=xcl_hit(k1,1)
                rhits=xcl_hit(k1,1)-xcl_hit(k2,2)
                kcl_trk(1)=k1
                kcl_trk(2)=k2
              endif
           enddo
	  enddo
        endif
	if(minhit.lt.999.) then

          if(DEBUG) then
             write(6,6921) minhit,rhits,kcl_trk(1),kcl_trk(2)
 6921        format(1h ,'anchor1:minhit,rhits',2f5.1,2i5)
          endif

          call hf1(500,minhit,1.)
          call hf1(501,rhits,1.)
	endif
	ia1 = minhit
C
C
	minhit=999.
	rhits=999.
        if( ncl_hits(7).gt.0.and.ncl_hits(8).gt.0) then
 	  do k1=1,ncl_hits(7)
	     do k2 = 1,ncl_hits(8)
		rhit=xcl_hit(k1,7)-xcl_hit(k2,8)
                absrhit = abs(rhit)
		if(absrhit.lt.15. .and. 
     X              absrhit.lt.abs(rhits)) then
                  minhit=xcl_hit(k1,7)
                  rhits=rhit
                  kcl_trk(7)=k1
                  kcl_trk(8)=k2
		endif
	     enddo
	  enddo
        endif
	if(minhit.lt.999.) then

          if(DEBUG) then
             write(6,6922) minhit,rhits,kcl_trk(7),kcl_trk(8)
 6922        format(1h ,'anchor3:minhit,rhits',2f5.1,2i5)
          endif

          call hf1(502,minhit,1.)
          call hf1(503,rhits,1.)
	endif
	ia3 = minhit

C
*
* have found 'best' hits in the outer 2 anchor layers. check for
* coincidence of the 2, and for a hit in anchor layer 2
*
*
* first, histo something to give us number of trials possible
*
	call hf2(504,ia1,ia3,1.)

        minhit = 999.

        if((ia1+ia3).lt.999..and.abs(ia1-ia3).lt.15.) then
C
C  (x1+x3)/2 is not correct in the setup of Feb95
C    it is (D(2)*x1+D(1)*x2)/(D(1)+D(2)
C      then, use exphit to the nearest real strip position...
CCCCCC	   exphit=(ia1+ia3)/2
           dd = D(1)+D(2)
           rexphit3=(d(1)*xcl_hit(kcl_trk(1),1)+
     X        d(2)*xcl_hit(kcl_trk(7),7))/dd
           rexphit5=(d(2)*xcl_hit(kcl_trk(1),1)+
     X        d(1)*xcl_hit(kcl_trk(7),7))/dd
           rexphit6=(d(2)*xcl_hit(kcl_trk(2),2)+
     X        d(1)*xcl_hit(kcl_trk(8),8))/dd

*
* check another anchor
*
	  rhits = 999.
          if( ncl_hits(3).gt.0) then
            do k1 = 1,ncl_hits(3)
              rhit= rexphit3-xcl_hit(k1,3)
              absrhit = abs(rhit)
              if(absrhit.lt.15. .and.absrhit.lt.abs(rhits)) then
                rhits = rhit
		minhit = xcl_hit(k1,3)
                exphit = rexphit3
                kcl_trk(3) = k1
              endif
            enddo
          endif
C
	  if(minhit.lt.999.) then
C
C got a track candidate!
C
            call hf1(505,float(exphit),1.)
	    call hf1(506,rhits,1.)

	  endif
        endif
        exphit = minhit
C
C exphit < 999 => good track
C
C now search in DUT for a match...
C
        If (exphit.lt.999) then	
C
C  debug ...==================================
        if(exphit.le.0) debug=.true.
        if(rexphit5.lt.1.) debug=.true.
        if(rexphit6.lt.1.) debug=.true.

        if(DEBUG) then
          write(6,6912) (ncl_hits(i),i=1,8)
 6912     format(1h ,16i5)
          do i=1,8
             if(ncl_hits(i).gt.0) then
            write(6,6912) i,(strip_hit(j,i),j=1,nl_hits(i))
             do j=1,ncl_hits(i)
               write(6,6914) i,xcl_hit(j,i),wcl_hit(j,i)
 6914   format(1h ,i5,2f7.1)
             enddo
             endif
           enddo
           write(6,6923) ia1,ia3
 6923      format(1h ,'ia1,ia3',2f5.1)
            write(6,6932) rexphit3,rexphit5,rexphit6
 6932       format(1h ,3f10.1)
              write(6,6925) exphit,rhits
 6925         format(1h ,'exphit,rhits',i5,f5.1)

        endif
        debug=.false.
C  debug ...==================================

          rpwin=0.
          rnwin=0.
          if(exphit.lt.1.or.exphit.gt.64) write(6,1037) exphit
1037  format(' reconstructed track out of bounds!',i5)

          exphit=rexphit6
          if(exphit.lt.1.or.exphit.gt.64) write(6,1037) exphit

          trials(exphit,1)=trials(exphit,1)+1
          exphit=rexphit5
          if(exphit.lt.1.or.exphit.gt.64) write(6,1037) exphit

          trials(exphit,2)=trials(exphit,2)+1
          trials(65,1)=trials(65,1)+1
          trials(65,2)=trials(65,2)+1

CCCCCC          write(6,6950) trials(65,1)

*     P SIDE
C
C find only 'best' point
C
          minhit=999. 
          rhits = 999.
          if( ncl_hits(6).gt.0) then
            DO 53 K2=1,ncl_hits(6)
              RHIT = rexphit6-xcl_hit(k2,6)
              absrhit = abs( rhit)
              IF(absrhit.LT.10.) THEN
                if(absrhit.lt.abs(rhits)) then
                  minhit = xcl_hit(k2,6)
                  rhits = rhit
                  exphit = rexphit6
                  kcl_trk(6)=k2
                endif
              ENDIF
 53         CONTINUE
          endif
          if(minhit.lt.999.) then

            if(DEBUG) then
              write(6,6927) exphit,rhits
 6927         format(1h ,'p-side:exphit,rhits',i5,f5.1)
            endif

            rpwin=rpwin+1
            CALL HF1(310,minhit,1.)
            CALL HF1(410,rhits,1.)
C
C efficiency...
            hits(exphit,1)=hits(exphit,1)+1
            hits(65,1)=hits(65,1)+1
C occupancy ...
            do k2=1,ncl_hits(6)
              if(k2.ne.kcl_trk(6)) then
                wcl=wcl_hit(k2,6)
                wclhalf=(wcl_hit(k2,6)-1.)/2.
                exphit=xcl_hit(k2,6)-wclhalf
                Do k3 = 1, wcl
                  exphit=exphit+k3-1
                  dresdal=exphit-rexphit6

                  CALL HF1(412,dresdal,1.)

                  If(ABS(dresdal).gt.15) then
                     hits(exphit,3)=hits(exphit,3)+1
                  endif

               EndDo
              endif
            enddo

          endif
C
*     N SIDE
          minhit = 999.
          rhits = 999.
          if( ncl_hits(5).gt.0) then
            DO 56 K2=1,ncl_hits(5)
              RHIT= rexphit5-xcl_hit(k2,5)
              absrhit = abs(rhit)
              IF(absrhit.LT.10.) THEN
                if( absrhit.lt.abs(rhits)) then
                  minhit = xcl_hit(k2,5)
                  rhits = rhit
                  exphit = rexphit5
                  kcl_trk(5)=k2
                endif
              ENDIF
 56         CONTINUE
          endif         
          if(minhit.lt.999.) then

            if(DEBUG) then
              write(6,6929) exphit,rhits
 6929         format(1h ,'n-side:exphit,rhits',i5,f5.1)
            endif

            rnwin=rnwin+1
            CALL HF1(320,minhit,1.)
            CALL HF1(420,rhits,1.)
C efficiency ...
            hits(exphit,2)=hits(exphit,2)+1
            hits(65,2)=hits(65,2)+1
C occupancy ...
            do k2=1,ncl_hits(5)
              if(k2.ne.kcl_trk(5)) then
                wcl=wcl_hit(k2,5)
                wclhalf=(wcl_hit(k2,5)-1.)/2.
                exphit=xcl_hit(k2,5)-wclhalf
                do k3=1,wcl
                  exphit=exphit+k3-1
                  dresdal=exphit-rexphit5

                  CALL HF1(422,dresdal,1.)

                  If(ABS(dresdal) .gt. 15) then
                     hits(exphit,4)=hits(exphit,4)+1
                  endif

                enddo
              endif
            enddo

          endif

          call hf1(432,rpwin,1.)
          call hf1(433,rnwin,1.)

          do i=1,8
            call hf1(433+i,float(ncl_hits(i)),1.)
          enddo
        endif

CC        write(6,6950) hits(65,1),trials(65,1)
CC 6950   format(1h ,2i5)

        EndIf
C  End of the selection of events with one cluster in each layer
         
      ELSE
*     
*     SCALAR DATA
*     IDATA(  ) :
*           A1  : # OF SCALAR DATA
*     
         
      ENDIF
      
      RETURN
      END
      
      SUBROUTINE ANA_EXIT()
      implicit none

      INTEGER*4 ICYCLE,i,j,id1
      integer hmemory(300000)
      COMMON /PAWC/HMEMORY
      common/occup/trials(65,4),hits(65,4),eps(65,4),err(65,4)
        integer trials, hits
        real eps, err
	character*40 title
      character*1 np(2)/'p','n'/
      integer j2,nsum1,nsum2
C
C
C common for efficiencies, 1=P DUT, 2 = N DUT
      write(*,*)'executing ana_exit'
C
C efficiency ...
       do j=1,2
CC         nsum1=0
CC         nsum2=0
         do i=1,65
           err(i,j)=1.0
  	   if(trials(i,j).ne.0) then
 	     eps(i,j)=float(hits(i,j))/float(trials(i,j))
             err(i,j)=sqrt( eps(i,j)*(1-eps(i,j))
     X         /float(trials(i,j)))

CC             nsum1=nsum1+hits(i,j)
CC             nsum2=nsum2+trials(i,j)

           endif
             
CC           write(6,6910) i,j,hits(i,j),trials(i,j),
CC     x        eps(i,j),err(i,j)
CC 6910        format(1h ,4i5,2f10.3)

         enddo

CC         write(6,6940) nsum1,nsum2
CC 6940    format(1h ,10x,2i5)

       enddo
C occupancy ...
       do j=1,2
         j2=j+2
         do i=1,65
           err(i,j2)=1.0
  	   if(trials(65,j).ne.0) then
 	     eps(i,j2)=float(hits(i,j2))/float(trials(65,j))
             err(i,j2)=sqrt( eps(i,j2)*(1-eps(i,j2))
     X          /float(trials(65,j)))
           endif
             
CC         write(6,6920) i,j,hits(i,j2),trials(65,j),
CC     x        eps(i,j2),err(i,j2)
CC 6920        format(1h ,4i5,2f10.3)

         enddo
       enddo

C
c load up histo
c
	do j=1,2
          id1=600+j
 	  write(title,1006) np(j)
1006      format(' Strip#; efficiency; ',A1,' side')
	  call hbook1(id1, title, 65,0.,65.,0.)
          call hpak(id1,eps(1,j))
          call hpake(id1,err(1,j))
	enddo

	do j=1,2
          j2=j+2
          id1=600+j2
 	  write(title,1007) np(j)
 1007     format(' Strip#; occupancy; ',A1,' side')
	  call hbook1(id1, title, 65,0.,65.,0.)
          call hpak(id1,eps(1,j2))
          call hpake(id1,err(1,j2))
	enddo

      CALL HROUT(0,ICYCLE,' ')
      CALL HREND('SDC_SI')
      call hreset( 0 , ' ' ) 
      CALL HDELET(0)

      RETURN
      END


      SUBROUTINE ANA_BEGIN(IDATA)
      implicit none
      integer hmemory(300000)
      COMMON /PAWC/HMEMORY
      common/occup/trials(65,4),hits(65,4),eps(65,4),err(65,4)
        integer trials, hits
        real eps, err
C common for efficiencies, 1=P DUT, 2 = N DUT

      INTEGER IDATA(*)
      integer i,istat,j
       integer ilg2(8)/9,11,13,15,1,3,5,7/

      CHARACTER*40 TITL,TAGS(2)*2
      DATA TAGS/'T0','T1'/
      character*40 file 
      character*1 str(30)
      equivalence ( file , str )
      INCLUDE 'si_param.i'
      write(*,*)'executing ana_begin'
C
C clear accumulation of effeciency(1,2) & occupancy(3,4)...
C
	do j=1,4
	do i=1,65
	   trials(i,j)=0
           hits(i,j)=0
           eps(i,j)=0.
           err(i,j)=0.
	enddo
	enddo

      CALL SET_PAR(IDATA)
      CALL HBOOK1( 10, 'Interrupt  $', 8, 0., 8., 0.)
      CALL HBOOK1( 20, 'TDC0 $', 128, 1000.,1512., 0.)
      CALL HBOOK1( 30, 'TDC1 $', 128, 1000.,1512., 0.)
      CALL HBOOK1( 40, 'TDC2 $', 128, 1000.,1512., 0.)
      CALL HBOOK1( 50, 'TDC3 $', 128, 1000.,1512., 0.)

c     CALL HBOOK1( 60, 'TDC0+TDC1 $', 128, 0.,4095., 0.)
      call hbook2( 70, 'TDC0 VS. TDC1 $' , 32,1000.,1512.
     +            ,32,1000.,1512.,0.)

      CALL HBOOK1( 91, 'error chips$', 12, 0.,12., 0.)
      CALL HBOOK1(100, '#WORDS OF DRS$', 100, 0., 100., 0.)
         DO 10 I=0,15
            WRITE(TITL,1000) I
 1000       FORMAT(' Hit Pattern of Chip',I3,'$')
            CALL HBOOK1(1000+I*10,TITL, 65,  0., 65., 0.)
            WRITE(TITL,1010) I
 1010       FORMAT(' Timeslices of Chip',I3,'$')
            CALL HBOOK1(2000+I*10,TITL, 6,  0., 6., 0.)
 10      CONTINUE

      CALL HBOOK1(310, 'MATCHED P HITS VS strip$', 
     >64,0.,64., 0.)
      CALL HBOOK1(320, 'MATCHED N HITS VS strip$',
     > 64,0.,64., 0.)
      CALL HBOOK1(410, 'DELTA STRIP ON P SIDE$', 100, -10., 10., 0.)
      CALL HBOOK1(412, 'RealHit-ExpHit, P side$',129,-64.5,64.5,0.)
      CALL HBOOK1(420, 'DELTA STRIP ON N SIDE$', 100, -10., 10., 0.)
      CALL HBOOK1(422, 'RealHit-ExpHit, N side$',129,-64.5,64.5,0.)
      CALL HBOOK1(432,'#WIN/EVENT, PSIDE',10,0.,10.,0.)
      CALL HBOOK1(433,'#WIN/EVENT, N SIDE',10,0.,10.,0.)
      CALL HBOOK1(434,' HITS/EVENT, PLANE 9',20,0.,20.,0.)
       CALL HBOOK1(435,' HITS/EVENT, PLANE 11',20,0.,20.,0.)
       CALL HBOOK1(436,' HITS/EVENT, PLANE 13',20,0.,20.,0.)
       CALL HBOOK1(437,' HITS/EVENT, PLANE 15',20,0.,20.,0.)
       CALL HBOOK1(438,' HITS/EVENT, PLANE 1',20,0.,20.,0.)
       CALL HBOOK1(439,' HITS/EVENT, PLANE 3',20,0.,20.,0.)
       CALL HBOOK1(440,' HITS/EVENT, PLANE 5',20,0.,20.,0.)
       CALL HBOOK1(441,' HITS/EVENT, PLANE 7',20,0.,20.,0.)
C
       Call HBOOK1(496, 'Nclus/Event, PLANE 9$', 20, -0.5, 19.5, 0.)
       Call HBOOK1(497, 'Nclus/Event, PLANE 11$', 20, -0.5, 19.5, 0.)
       Call HBOOK1(498, 'Nclus/Event, PLANE 5$', 20, -0.5, 19.5, 0.)
       Call HBOOK1(499, 'Nclus/Event, PLANE 7$', 20, -0.5, 19.5, 0.)
	call hbook1(500,'anchor plane 1 strip distn p-n match',
     >		64,0.,64.,0.)
	call hbook1(501,'anchor plane 1 n-p strip delta',30,-15.,15.,0.)
	call hbook1(502,'anchor plane 3 strip disn, p-n match',
     >		64,0.,64.,0.)
	call hbook1(503,'anchor plane 3 n-p strip delta', 30,-15.,15,0.)
	call hbook2(504,'best anchor 1 vs best anchor 3 ',
     >		64,0.,64.,64,0.,64.,0.)
	call hbook1(505,'candidate track strip distn', 64,0.,64.,0.)
CCCCCCC	call hbook1(506,'a1*a3-a2 strip delta', 30,-15.,15.,0.)
	call hbook1(506,'a1*a3-a2 strip delta', 100,-10.,10.,0.)
	do i=1,8
	write(titl,1007) ilg2  (i)
1007        format(' hit pattern (tslice-or) for chip ',i2)
                call hbook1(700+i,titl,64,0.,64.,0.)
	enddo
C
      call hreset( 0 , ' ' )
      write( file,500) run_num
 500  format( 'ana8_r00',I5,'.hst' )
      do i = 9,14		! change here if you modify path
          if( str(i) .eq. ' ' ) str(i) = '0'
      end do

      CALL HROPEN(1,'SDC_SI',file,'N',1024,ISTAT)
      IF(ISTAT.NE.0) WRITE(*,*) 'ERROR IN HROPEN'

      RETURN
      END

      SUBROUTINE ANA_RESUME(IDATA)
      implicit none

      INCLUDE 'si_param.i'
      INTEGER IDATA(*)
      integer n
      CHARACTER*40 TITL
      DATA N/-1/

      write(*,*)'executing ana_resume'
      CALL SET_PAR(IDATA)

      RETURN
      END

      SUBROUTINE ANA_PAUSE(IDATA)
      implicit none

      INCLUDE 'si_param.i'
      INTEGER IDATA(*)

      write(*,*)'executing ana_pause'
      CALL SET_PAR(IDATA)

      RETURN
      END

      SUBROUTINE SET_PAR(IDATA)
      implicit none
      INCLUDE 'si_param.i'
      INTEGER IDATA(*)
      integer i,j,n
      integer infor_time1,infor_time2
*
*     CALLED ON BEGINRUN, RESUMERUN, AND PAUSERUN 
*
*     IDATA(  ) : SEVERAL PARAMETERS ARE STORED
*            1  : RUN_TYPE
*            2  : NUMBER OF CHIPS
*            3  : TRIGGER DELAY
*            4  : NUMBER OF TIMESLICES
*            5  : THRESHOLD
*            6  : CALIBURATION MODE SELECTED
*            7  : CALIBURATION AMPLITUDE
*            8  : BIAS VOLTAGE
*         9-17  : CHIP ADDRESS
*****   Should put the quantities below into a reasonable (pretty)   ******
*                           COMMON block

      INFOR_TIME1 = IDATA(1)
      
      INFOR_TIME2 = IDATA(2)
      
      RUN_TYPE = IDATA(3)       !  1 for data, 2 for cal
      
      NR_CHIPS = IDATA(4)       !  (2 front, 2 back; 256 strips) / layer
                                !  data = 0 means 1 chip
      TRIGGER_DELAY = IDATA(5)  !
      
      NR_TIMESLICES = IDATA(6) ! Up to 80 time samples allowed
      
      DO J=1,16
         CHIP_ADDRESS(J) = IDATA(J+6)
      ENDDO
      
      run_num =  idata(-3)
      WRITE(*,*) 'RUN PARAMETER DUMPED'
      WRITE(*,*) 'RUN TYPE             =',RUN_TYPE
      WRITE(*,*) 'NUMBER OF CHIPS      =',NR_CHIPS
      WRITE(*,*) 'TRIGGER DELAY        =',TRIGGER_DELAY
      WRITE(*,*) 'NUMBER OF TIMESLICES =',NR_TIMESLICES
      WRITE(*,*) 'THRESHOLD            =',THRESHOLD
C     
C     +Beam Energy, Position of the box in the beam (x,y transverse, rotation
C     angles,   displacement of central (test) layer, ...
C
C     Group separately :     DRS stuff
C                            Calibration quantities
C                            Beam defining quantities
C                            Environmental quantities
      RETURN
      END
      

      subroutine defbad( badchan )
      logical*1 badchan(16,64)

      badchan(  1 , 64 ) = 1

      return
      end
