      PROGRAM HAPDMAIN

      IMPLICIT NONE

      INCLUDE 'DAQ_BUFFER.fi'
C      INCLUDE 'HAPD_DATA.fi'

c$$$      DATA TO /MAXNCH*0/
c$$$      DATA AO /MAXNCH*0/
c$$$      DATA AC /MAXNCH*0/
c$$$      DATA FP /(3*MAXNCH)*0. /


      INTEGER MEMPAW
      PARAMETER (MEMPAW=20000000)
      REAL HMEMOR
      COMMON /PAWC/ HMEMOR(MEMPAW)

      INTEGER ARGC,ARGL(0:10)
      CHARACTER*128 ARGV(0:10),DATA_FILE,HBOOK_FILE,INI_FILE
      CHARACTER*128 TMP,SS,CHTOP

      INTEGER I,LUN,RID
      LOGICAL OK

      CHTOP='HAPD'
      ARGC=0
      LUN=10
C      IOFFSET=0

      I=1
      DO WHILE(I.GT.0)
         CALL GETARG(ARGC,TMP)
         CALL SUB_STRING(TMP,SS,I)
         ARGL(ARGC)=I
         ARGV(ARGC)=SS(1:I)
         ARGC=ARGC+1
      ENDDO
      ARGC=ARGC-1

      IF (ARGC.LT.1) STOP 'uporaba: hapd datoteka'
      PRINT*,'NUMBER OF ARGUMENTS', ARGC

C      READ(ARGV(1),*,ERR=2,END=2) IFLAG

      DATA_FILE='data/'//ARGV(1)(1:ARGL(1))//'.dat'
      HBOOK_FILE='hbook/'//ARGV(1)(1:ARGL(1))//'.hbook'
      INI_FILE='ini/'//ARGV(1)(1:ARGL(1))//'.ini'

c$$$      OPEN(UNIT=22, FILE=INI_FILE, STATUS='OLD',
c$$$     +     ERR=11, FORM='FORMATTED')
c$$$      DO I=1,8
c$$$         READ (22,*) TO(I)
c$$$      ENDDO
c$$$      DO I=1,8
c$$$         READ (22,*) AO(I)
c$$$      ENDDO
c$$$      DO I=1,8
c$$$         READ (22,*) AC(I)
c$$$      ENDDO
c$$$      DO I=1,8
c$$$        READ (22,*) FP(1,I),FP(2,I),FP(3,I)
c$$$      ENDDO
c$$$      CLOSE(22)


      PRINT*,'DATA ',DATA_FILE
      CALL OPEN_FILE(LUN,DATA_FILE,OK)
      IF (.NOT.OK) STOP

      CALL HLIMIT(MEMPAW)
      CALL HISTO_BOOK

      DO WHILE (OK)
        CALL DECODE(LUN,OK,RID)
        SELECT CASE(RID)
          CASE(4)
            CALL HAPD
          CASE(3)
            PRINT *,POSR_XSET,POSR_YSET
          CASE DEFAULT
        END SELECT
      ENDDO

      CLOSE(LUN)
      CALL HISTO_OUT(LUN,CHTOP,HBOOK_FILE)

 11   CONTINUE

      STOP
      END

      SUBROUTINE SUB_STRING(TT,SS,L)

c     gets substring SS, shifts string TT left removing SS from it
c     delimiters are SPs or TABs
      IMPLICIT NONE

      CHARACTER*(*) TT, SS      ! string, substring
      INTEGER L                 ! LEN of substring

      INTEGER I,I1,I2,LT

      LT=LEN(TT)
      I=1
      DO WHILE(TT(I:I).EQ.' '.OR.TT(I:I).EQ.CHAR(9))
         I=I+1
         IF(I.GT.LT) THEN
            L=0
            SS=' '
            TT=' '
            RETURN
         ENDIF
      ENDDO
      I1=I
      DO WHILE(.NOT.(TT(I:I).EQ.' '.OR.TT(I:I).EQ.CHAR(9)))
         I=I+1
         IF(I.GT.LT) EXIT
      ENDDO
      I2=I-1
      L=I2-I1+1
      IF(L.EQ.0) THEN
         SS=' '
      ELSE
         SS=TT(I1:I2)
      ENDIF
      IF(I.GT.LT) THEN
         TT=' '
      ELSE
         TT=TT(I:LT)
      ENDIF
      RETURN
      END

      SUBROUTINE HISTO_OUT(LUN,PDIR_C,PIME_C)

c     shrani vse HBOOK histograme na file
      IMPLICIT NONE

      INTEGER LUN,LREC,ICYCLE
      CHARACTER*(*) PDIR_C,PIME_C

      DATA LREC /1024/
      DATA ICYCLE /9999/
c     LUN    stevilka logicne I/O enote
c     PDIR_C  direktorij
c     PIME_C  ime filea
      INTEGER ISTAT

      PRINT*,PIME_C
      CALL HROPEN(LUN,PDIR_C,PIME_C,'N',LREC,ISTAT)
      IF(ISTAT.NE.0) PRINT*,'I/O STAT.=',ISTAT
      CALL HROUT(0,ICYCLE,' ')
      CALL HREND(PDIR_C)

      RETURN
      END

      SUBROUTINE HISTO_BOOK

      IMPLICIT NONE

      INCLUDE 'DAQ_BUFFER.fi'

      INTEGER I
      REAL XLL,XUL,YLL,YUL
      REAL THLL,THUL
      CHARACTER*8 CHNUM

      XLL=FLOAT(RUNR_X0)-0.5*(FLOAT(RUNR_DX))
      XUL=XLL+FLOAT(RUNR_NX*RUNR_DX)
      YLL=FLOAT(RUNR_Y0)-0.5*(FLOAT(RUNR_DY))
      YUL=YLL+FLOAT(RUNR_NY*RUNR_DY)
      CALL HBOOK2(1200,'XY detected',RUNR_NX,XLL,XUL,RUNR_NY,YLL,YUL,0.)

      XLL=XSC*XLL
      XUL=XSC*XUL
      YLL=XSC*YLL
      YUL=XSC*YUL

      CALL HBOOK2(100,'DLY',144,-0.5,143.5,4,-0.5,3.5,0.)
      CALL HBOOK2(200,'XY',RUNR_NX,XLL,XUL,RUNR_NY,YLL,YUL,0.)
      CALL HBOOK2(201,'XY 1',RUNR_NX,XLL,XUL,RUNR_NY,YLL,YUL,0.)
      CALL HBOOK2(202,'XY 2',RUNR_NX,XLL,XUL,RUNR_NY,YLL,YUL,0.)
      CALL HBOOK2(203,'XY 3',RUNR_NX,XLL,XUL,RUNR_NY,YLL,YUL,0.)
      CALL HBOOK2(204,'XY 4',RUNR_NX,XLL,XUL,RUNR_NY,YLL,YUL,0.)

      DO I=1,144
        WRITE(CHNUM,'(A4,I2)') 'ch. ',I 
        CALL HBOOK2(1000+i,'XY '//CHNUM,
     +              RUNR_NX,XLL,XUL,RUNR_NY,YLL,YUL,0.)
      ENDDO

      THLL=FLOAT(RUNR_TH0)-0.5*(FLOAT(RUNR_DTH))
      THUL=THLL+FLOAT(RUNR_NTH*RUNR_DTH)
      CALL HBOOK2(110,'THR',144,-0.5,143.5,RUNR_NTH,THLL,THUL,0.)

c$$$  DO I=1,RUNR_NCH
c$$$        WRITE(CHNUM,'(A4,I2)') 'ch. ',I 
c$$$        CALL HBOOK1(1000+I,'TDC raw '//CHNUM,4096,-0.5,4095.5,0.)       
c$$$        CALL HBOOK1(10+I,'TDC '//CHNUM,1001,-200.5,800.5,0.)       
c$$$        CALL HBOOK1(20+I,'TDC max '//CHNUM,1001,-200.5,800.5,0.)       
c$$$        CALL HBOOK1(2000+I,'ADC raw '//CHNUM,4096,-0.5,4095.5,0.)      
c$$$        CALL HBOOK1(30+I,'ADC '//CHNUM,2001,-200.5,1800.5,0.)      
c$$$        CALL HBOOK1(40+I,'ADC max '//CHNUM,2001,-200.5,1800.5,0.)      
c$$$        CALL HBOOK1(50+I,'TC '//CHNUM,600,-1000.,5000.,0.)      
c$$$        CALL HBOOK1(60+I,'TC center '//CHNUM,600,-1000.,5000.,0.)      
c$$$        CALL HBOOK1(70+I,'TC max '//CHNUM,600,-1000.,5000.,0.)      
c$$$        CALL HBOOK1(80+I,'TC nmax '//CHNUM,600,-1000.,5000.,0.)      
c$$$        CALL HBOOK1(90+I,'TC only '//CHNUM,600,-1000.,5000.,0.)      
c$$$
c$$$        CALL HBOOK2(100+I,'TDC vs. ADC '//CHNUM,100,0.5,200.5,
c$$$     +                                      151,-30.5,120.5,0.)
c$$$        CALL HBOOK2(110+I,'TC vs. ADC '//CHNUM,100,0.5,200.5,
c$$$     +                                      100,-500.,2500.,0.)
c$$$
c$$$        CALL HBOOK2(200+I,'XY '//CHNUM,RUNR_NX,XLL,XUL,
c$$$     +                                 RUNR_NY,YLL,YUL,0.)
c$$$        CALL HBOOK2(210+I,'XY max '//CHNUM,RUNR_NX,XLL,XUL,
c$$$     +                                     RUNR_NY,YLL,YUL,0.)
c$$$        CALL HBOOK2(310+I,'XY nmax '//CHNUM,RUNR_NX,XLL,XUL,
c$$$     +                                      RUNR_NY,YLL,YUL,0.)
c$$$        CALL HBOOK2(220+I,'XY tc1 max '//CHNUM,RUNR_NX,XLL,XUL,
c$$$     +                                      RUNR_NY,YLL,YUL,0.)
c$$$        CALL HBOOK2(320+I,'XY tc1 nmax '//CHNUM,RUNR_NX,XLL,XUL,
c$$$     +                                      RUNR_NY,YLL,YUL,0.)
c$$$        CALL HBOOK2(230+I,'XY tc2 max '//CHNUM,RUNR_NX,XLL,XUL,
c$$$     +                                      RUNR_NY,YLL,YUL,0.)
c$$$        CALL HBOOK2(330+I,'XY tc2 nmax '//CHNUM,RUNR_NX,XLL,XUL,
c$$$     +                                      RUNR_NY,YLL,YUL,0.)
c$$$        CALL HBOOK2(240+I,'XY tc3 max '//CHNUM,RUNR_NX,XLL,XUL,
c$$$     +                                      RUNR_NY,YLL,YUL,0.)
c$$$        CALL HBOOK2(340+I,'XY tc3 nmax '//CHNUM,RUNR_NX,XLL,XUL,
c$$$     +                                      RUNR_NY,YLL,YUL,0.)
c$$$        CALL HBOOK2(250+I,'XY tc4 max '//CHNUM,RUNR_NX,XLL,XUL,
c$$$     +                                      RUNR_NY,YLL,YUL,0.)
c$$$        CALL HBOOK2(350+I,'XY tc4 nmax '//CHNUM,RUNR_NX,XLL,XUL,
c$$$     +                                      RUNR_NY,YLL,YUL,0.)
c$$$
c$$$        CALL HBOOK2(500+I,'TDC vs. X '//CHNUM,RUNR_NX,XLL,XUL,
c$$$     +                                      100,-500.,3500.,0.)
c$$$        CALL HBOOK2(510+I,'TDC vs. X max '//CHNUM,RUNR_NX,XLL,XUL,
c$$$     +                                      100,-500.,3500.,0.)
c$$$        CALL HBOOK2(520+I,'TDC vs. X nmax '//CHNUM,RUNR_NX,XLL,XUL,
c$$$     +                                      100,-500.,3500.,0.)
c$$$      ENDDO
c$$$      DO I=0,16
c$$$        WRITE(CHNUM,'(Z2)') I 
c$$$        CALL HBOOK2(400+I,'XY mask'//CHNUM,RUNR_NX,XLL,XUL,
c$$$     +                                 RUNR_NY,YLL,YUL,0.)
c$$$      ENDDO
c$$$      CALL HBOOK2(601,'ADC1/(1+2) vs. X'//CHNUM,RUNR_NX,XLL,XUL,
c$$$     +                                      120,-0.1,1.1,0.)

      RETURN
      END

      SUBROUTINE HAPD      

      IMPLICIT NONE

      INCLUDE 'DAQ_BUFFER.fi'
C      INCLUDE 'HAPD_DATA.fi'

      INTEGER I,J,IW,IO,IH
      REAL XR,YR
      
      XR=XSC*FLOAT(POSR_XSET)
      YR=XSC*FLOAT(POSR_YSET)

      DO I=0,143
         IW=1+I/8
         IO=MOD(I,8)
         IH=IAND(ISHFT(EVTR_DATA(IW),-4*IO),Z'F')
         IF (IH.NE.0) THEN
            CALL HFILL(110,FLOAT(I),FLOAT(THRR_TH),1.)
            CALL HFILL(1200,FLOAT(POSR_XSET),FLOAT(POSR_YSET),1.)
            CALL HFILL(200,XR,YR,1.)
            CALL HFILL(1001+I,XR,YR,1.)
            DO J=0,3
               IF (BTEST(IH,J)) THEN
                  CALL HFILL(201+J,XR,YR,1.)
                  CALL HFILL(100,FLOAT(I),FLOAT(J),1.)
               ENDIF
            ENDDO
         ENDIF
      ENDDO
      
      RETURN
      END
