      subroutine hec_geo_oct97
************************************************************************
*     fill geometry table and physics database array                   *
*     October 1997                                                     *
*                                                                      *
*     mod01: iz=1, pad 1  .. 24                                        *
*            iz=2, pad 25 .. 47  (pad 48     absent)                   *
*            iz=3, pad 51 .. 72  (pad 49, 50 absent)                   *
*     mod02: only dummy was present for FRONT and REAR                 *
*            no readout present for this "module"                      *
*                                                                      *
*     lookup table read fromm file:                                    *
*            lookup(ADC#,1) = ADC#                                     *
*            lookup(ADC#,2) = PAD#                                     *
*            lookup(ADC#,3) = i_pad                                    *
*            lookup(ADC#,4) = i_z                                      *
*            lookup(ADC#,5) = i_eta                                    *
*            lookup(ADC#,6) = i_phi                                    *
*            lookup(ADC#,7) = i_mod                                    *
*            lookup(ADC#,8) = i_seg                                    *
*                                                                      *
*     author:  06.11.97   Dieter Striegel                              *
************************************************************************
      implicit none

      include'hec_par.inc'     ! parameter common
      include'hec_geo.inc'     ! geometry common
c
c local variable
c
      integer i, j, ic, i_mod, i_seg, i_pad, i_eta, i_phi, i_z, i_adc
      integer lookup(i_adc_dim,8) 		! lookup table
      integer fnum, ios
      logical DEBUG
      character fname*11, substr*20
      parameter (fnum=20, fname='hec_geo.dat')
      parameter (substr=' *** HEC_GEO_OCT97: ', DEBUG=.FALSE.)
c
c reset geometry
c
      call vzero (ictodb,3*i_adc_dim)
      call vzero (ictoph,3*i_adc_dim)
      call vzero (dbtoic,i_mod_max*i_seg_max*i_pad_max)
      call vzero (phtoic,i_mod_max*i_seg_max*i_pad_max)
      call vzero (lookup,8*i_adc_dim)

      i_adc_used = 128 				! 128 read out, but 72 connected
      i_tim_used = 16

      i_mod_used = 1
      i_seg_used = 3
      i_pad_used = 24

      i_eta_used = 14
      i_phi_used = 2
      i_z_used   = 3
c
c read database file
c
      open (UNIT=fnum,IOSTAT=ios,ERR=100,FILE=fname,
     &                STATUS='OLD',
     &                ACCESS='SEQUENTIAL',FORM='FORMATTED')
 100  if (ios.ne.0) then
        write(*,*) substr,'problems opening file: ', fname
        STOP
      endif 						! if (ios.ne.0) then

      do i=1, 8 					! read comment
ccc        read(fnum,FMT=*,IOSTAT=ios,ERR=110) dummy
        read(fnum,FMT=*,IOSTAT=ios,ERR=110) 
 110    if (ios.ne.0) then
          write(*,*) substr,'problems reading file: ', fname
          STOP
        endif 						! if (ios.ne.0) then
      enddo 						! do i=1, 8
c
      do i=1, i_adc_used

        read(fnum,FMT='(8I7)',IOSTAT=ios,ERR=200,END=300)
     &                            ( lookup(i,j), j=1, 8 )
 200    if (ios.ne.0) then
          write(*,*) substr,'problems reading file: ', fname
          STOP
        endif 						! if (ios.ne.0) then
        if (i.ne.lookup(i,1)) then 			! check lookup table
          write(*,*) substr,'inconsistent database file at ADC#', i
          write(*,*) substr,'database: ',(lookup(i,j) ,j=1, 8)
          STOP
        endif 						! if (i.ne.lookup(i,1)) then

      enddo 						! do i=1, i_adc_used

 300  close(fnum) 					! close database file

      if (DEBUG) then
        write(*,*) substr,'lookup table October 1997:'
        write(*,*) '     ADC#   PAD#  i_pad   i_z   ',
     &                   'i_eta  i_phi  i_mod  i_seg'
        do i=1, i_adc_used
          write(*,'(8I7)') (lookup(i,j), j=1, 8)
        enddo 						! do i=1, i_adc_used
      endif 						! if (DEBUG) then

      do ic=1, i_adc_used

        i_mod = lookup(ic,7)
        i_seg = lookup(ic,8)
        i_pad = lookup(ic,3)

        ictodb(ic,1) = i_mod
        ictodb(ic,2) = i_seg
        ictodb(ic,3) = i_pad
        if ((i_mod.eq.0).or.(i_seg.eq.0).or.(i_pad.eq.0)) then
          continue 					! unconnected ADC
        else
          dbtoic(i_mod,i_seg,i_pad) = ic
        endif 						! if ((i_mod.eq.0).or.(i

        i_eta = lookup(ic,5)
        i_phi = lookup(ic,6)
        i_z   = lookup(ic,4)

        ictoph(ic,1) = i_eta
        ictoph(ic,2) = i_phi
        ictoph(ic,3) = i_z
        if ((i_eta.eq.0).or.(i_phi.eq.0).or.(i_z.eq.0)) then
          continue					! unconnected ADC
        else
          phtoic(i_eta,i_phi,i_z) = ic
        endif 						! if ((i_eta.eq.0).or...

      enddo 						! do ic=1, i_adc_used

      if (DEBUG) then
        write(*,*) substr,'correpondence table October 1997:'
        write(*,*) '     ADC#  i_pad  i_mod  i_seg  ',
     &                    'i_eta  i_phi   i_z    adc'
        do ic=1, i_adc_used
          i_eta = ictoph(ic,1)
          i_phi = ictoph(ic,2)
          i_z   = ictoph(ic,3)
          i_pad = ictodb(ic,3)
          i_mod = ictodb(ic,1)
          i_seg = ictodb(ic,2)
          if ((i_eta.eq.0).or.(i_phi.eq.0).or.(i_z.eq.0)) then
            continue
          else
            i_adc = phtoic(i_eta,i_phi,i_z)
          endif 					! if ((i_eta.eq.0).or....
          write(*,'(8I7)') ic,i_pad,i_mod,i_seg,i_eta,i_phi,i_z,i_adc
        enddo 						! do ic=1, i_adc_used
      endif 						! if (DEBUG) then

      print *, ' *** October 97 geometry correspondence tables filled'

      return
      end


