      REAL FUNCTION dsmsort()
*  Sowinski  3/18/03
*
*Program to take ntuple filled by Akio's Trg2ntp program
*and extract EEMC DSM data and histogram it.  Want to
*separate high tower from trigger patch sums.
*
*********************************************************
*                                                       *
* This file was generated by HUWFUN.                    *
* at paw> NTUPLE/UWFUNC 111 SELECT.FOR                  *
* generated file select.for which I renamed             *
*********************************************************
*
*     Ntuple Id:      111  
*     Ntuple Title:   Title
*     Creation:       18/03/2003 17.36.00
*
*********************************************************
*
      LOGICAL         CHAIN
      CHARACTER*128   CFILE
      INTEGER         IDNEVT,NCHEVT,ICHEVT
      REAL            OBS(13)
*
      COMMON /PAWIDN/ IDNEVT,OBS
      COMMON /PAWCHN/ CHAIN, NCHEVT, ICHEVT
      COMMON /PAWCHC/ CFILE
*
*--   Ntuple Variable Declarations
*
      INTEGER event,ipre,ipost,BChi,BClo,AWDBM,AWTrg,AWDaq,Token,addBit
     + ,DSM,extBusy,modBusy,physWd,TrgWd,DSMAd,cotamiBusy,npre,npost
     + ,CPA(32),qDSM(8),lastDSM(8),BCd(16),L1(32),VTXDSM(8),FPDDSM(8)
     + ,EMCDSM(8),BBCL1(16),ZDC(16),CTB(256),MWC(128),BEMC(128),BBC(80)
     + ,FPDENS(112),FPDETB(64),FPDWNS(112),FPDWTB(64),FPDENSl1(8)
     + ,FPDETBl1(8),FPDWNSl1(8),FPDWTBl1(8),EEMCLayer0(144)
     + ,EEMCLayer1(16),bunchId,bunchid7bit
*
      COMMON /PAWCR4/ event,ipre,ipost,BChi,BClo,AWDBM,AWTrg,AWDaq,Token
     + ,addBit,DSM,extBusy,modBusy,physWd,TrgWd,DSMAd,cotamiBusy,npre
     + ,npost,CPA,qDSM,lastDSM,BCd,L1,VTXDSM,FPDDSM,EMCDSM,BBCL1,ZDC,CTB
     + ,MWC,BEMC,BBC,FPDENS,FPDETB,FPDWNS,FPDWTB,FPDENSl1,FPDETBl1
     + ,FPDWNSl1,FPDWTBl1,EEMCLayer0,EEMCLayer1,bunchId,bunchid7bit
*
*   declare my variables
      integer upperch
      integer lowerch
      integer twoch
      integer uppertrg
      integer upperht
      integer lowertrg
      integer lowerht
      integer i,j,k
      integer swap,index,tstfil,iprint,wrt
      integer init
      integer block(90)
*
*--   Enter user code here
*

* initialization block  set blocked channels  -64 if unused -65 if blocked
      if (init .eq. 0)then
*        first 6 channels unused
         do i=1,6
            block(i)=-64
         enddo
*        first 3 in 2nd card unused
         do i=11,13
            block(i)=-64
         enddo
*        bad channel in card 3
         block(26)=-65
*        card 4 bad channels
         block(35)=-65
         block(38)=-65
*        unused last 2 ch of card 4
         block(39)=-64
         block(40)=-64
*        crate 5 bad channels
         block(43)=-65
         block(44)=-65
*        unused channels in card 5
         do i=45,50
            block(i)=-64
         enddo
*        cards 6-9 unused
         do i=51,90
            block(i)=-64
         enddo
         init=1
*         write (6,*) '********block initialized********'
*      else
*         write (6,*) '******new event*******'
      endif

*don't bother with pre and post.  That is settled.
      if (ipre .ne. 0 .or. ipost .ne. o) then
         dsmsort=2
         return
      endif

*  Fill array EEMCLayer0 with my values for testing - does not fill cor. pat
      tstfil=0
      if (tstfil .eq. 1) then
         do i=1,144,3
            EEMCLayer0(i)=135
            EEMCLayer0(i+1)=34
            EEMCLayer0(i+2)=17
         enddo
      endif
*      write (6,*)'*****ready to swap*******'

*  The order is pretty convoluted  7->0, 15->8  reorder
      swap=1
      if (swap .eq. 1)then
         do i=1,9
            index=(i-1)*16+1
*            write (6,*) EEMCLayer0(index),EEMCLayer0(index+1)
            tmp=EEMCLayer0(index)
            EEMCLayer0(index)=EEMCLayer0(index+7)
            EEMCLayer0(index+7)=tmp
            tmp=EEMCLayer0(index+1)
            EEMCLayer0(index+1)=EEMCLayer0(index+6)
            EEMCLayer0(index+6)=tmp
            tmp=EEMCLayer0(index+2)
            EEMCLayer0(index+2)=EEMCLayer0(index+5)
            EEMCLayer0(index+5)=tmp
            tmp=EEMCLayer0(index+3)
            EEMCLayer0(index+3)=EEMCLayer0(index+4)
            EEMCLayer0(index+4)=tmp
            tmp=EEMCLayer0(index+8)
            EEMCLayer0(index+8)=EEMCLayer0(index+15)
            EEMCLayer0(index+15)=tmp
            tmp=EEMCLayer0(index+9)
            EEMCLayer0(index+9)=EEMCLayer0(index+14)
            EEMCLayer0(index+14)=tmp
            tmp=EEMCLayer0(index+10)
            EEMCLayer0(index+10)=EEMCLayer0(index+13)
            EEMCLayer0(index+13)=tmp
            tmp=EEMCLayer0(index+11)
            EEMCLayer0(index+11)=EEMCLayer0(index+12)
            EEMCLayer0(index+12)=tmp
*            write (6,*) EEMCLayer0(index),EEMCLayer0(index+1)
         enddo
      endif
*      write (6,*) '*****data swapped*****'

*  print out starting buffer by board
      iprint=0
      if (iprint .eq. 1 .and. ipre .eq. 0 .and. ipost .eq. 0) then
         write (12,5) 0,0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15
 5       format(1x,17i4)
         do i=1,9
            index=(i-1)*16+1
            write (12,6) index,(EEMCLayer0(k),k=index,index+15)
 6          format(1x,17I4)
         enddo
      endif

*  The array EEMCLayer0 has 9 boards x 16 inputs  
*  Each word contains 6 bits of high tower and 6 bits of trig patch sum
*  ipre and ipost are 0-5 with 0 in both being the in time bit
*  The first level input is in EEMCLayer1.  more later

      j=0
      do k=1,9
         do i=1,15,3
*            write (6,*) j,k,i
*           combine 3 8 bit words into one 24 bit word
            index=i+(k-1)*16
            twoch=EEMCLayer0(index)+256*EEMCLayer0(index+1)
     +                             +65536*EEMCLayer0(index+2)
*           split into two 12 bit words
            upperch=twoch/4096
            lowerch=twoch-upperch*4096
*           split each of these into 6 bit words
            uppertrg=upperch/64
            upperht=upperch-uppertrg*64
            lowertrg=lowerch/64
            lowerht=lowerch-lowertrg*64
            if (ipre .eq. 0 .and. ipost .eq. 0) then
               wrt=0
               if (wrt .eq. 1)then
               write (6,10) ipre,ipost,index,EEMCLayer0(index),
     +           EEMCLayer0(index+1), EEMCLayer0(index+2),
     +           twoch,upperch,lowerch,uppertrg,upperht,
     +           lowertrg,lowerht
               endif
 10            format(1x,3i3,3i4,i9,2i5,4i3)
               call hfill(10,float(lowerht),float(j),1.0)
               call hfill(12,float(lowertrg),float(j),1.0)
               call hfill(10,float(upperht),float(j+1),1.0)
               call hfill(12,float(uppertrg),float(j+1),1.0)
*              fix adc for unused and blocked channels
               if (block(j+1) .lt. 0)then
                  lowerht=-block(j+1)
                  lowertrg=-block(j+1)
               endif
               if (block(j+2) .lt. 0)then
                  upperht=-block(j+2)
                  uppertrg=-block(j+2)
               endif
               call hfill(20,float(lowerht),float(j),1.0)
               call hfill(22,float(lowertrg),float(j),1.0)
               call hfill(20,float(upperht),float(j+1),1.0)
               call hfill(22,float(uppertrg),float(j+1),1.0)
            endif
*            write (6,*) j
            j=j+2
         enddo
*            if (ipre .eq. 0 .and. ipost .eq. 0) 
*     +        write (6,*)'************* ',EEMCLayer0(k*16)
*         write (6,*) EEMCLayer0(k*16)
      enddo
*      write(12,*) '-------------------------------------------'

      dsmsort = 1.
*
      END











