subroutine h_one_ev_geometry
*
* This routine will get the detector position and size information from CTP,
* then use this information for defining the different GEANT geometry structures
*
* August, 1994, Pat Welch, Oregon State University, tpw@physics.orst.edu
*
* Note: Subdivided volumes won't work for doing coordinate transforms.  Or
*	at least I didn't see a method around them.  So I have defined all
*	the subvolumes explicitly. (TPW)
* $Log: h_one_ev_geometry.f,v $
* Revision 1.8  1996/11/22 15:36:37  saw
* (SAW) Some code cleanup
*
* Revision 1.7  1996/04/30 14:09:54  saw
* (JRA) Some new code
*
* Revision 1.6  1996/01/17 16:35:37  cdaq
* (DVW) Tweak hodoscale
*
* Revision 1.5  1995/10/06 18:39:36  cdaq
* (DVW) Changed to ctp geometry variables and eliminated call to h_one_ev.par.
*
* Revision 1.4  1995/09/18 14:35:22  cdaq
* (DVW) Improvements
*
* Revision 1.3  1995/05/22  18:58:03  cdaq
* (SAW) Split gen_data_data_structures into gen, hms, sos, and coin parts
*
* Revision 1.2  1995/01/27  19:31:37  cdaq
* (SAW) Change file names to be hms specific.
*
c Revision 1.1  1995/01/10  18:43:44  cdaq
c Initial revision
c
*
      implicit none

      include 'hms_data_structures.cmn'
      include 'hms_geometry.cmn'
      include 'hms_calorimeter.cmn'
      include 'hms_scin_parms.cmn'

      real*4    HHUT_WIDTH,HHUT_HEIGHT
      parameter (HHUT_WIDTH = 100.)     ! full width of the det. hut
      parameter (HHUT_HEIGHT = 800.)    ! full height of the det. hut

      integer HHUTMEDIA                 ! non-sensitive tracking media
      integer DETMEDIA                  ! sensitive tracking media
      parameter (HHUTMEDIA = 1, DETMEDIA = 2)
      real*4 hodoscale
      parameter (hodoscale = 2.)
      real*4 wcscale
      parameter (wcscale = 1.)
      real*4 xwirelength
      real*4 ywirelength
      real*4 uwirelength
      real*4 vwirelength

      real*4 numxwires           ! add 1 to the number of x, u, and v wires
      real*4 numywires           ! for ease in looping over the wires...
      real*4 numuwires
      real*4 numvwires

      character*5 scinname       
      character*5 layername
      character*5 planename
      character*5 plane
      character*5 wire
      character*5 blockname
      integer isector
      integer iplane
      integer iwire
      integer ichamber
      integer ilayer
      integer irow

      integer ivolu			! internal volume number
      real par(10)			! geometry parameters
      real x, y, z			! offset position for placement of dets
      integer i                         ! index variable
      real wspace                       ! Wire spacing temp variable
      real*4 raddeg
      parameter (raddeg = 3.14159265/180.)


* First define two general media that everything is made of
* one is insensitive, and the other is sensitive

      call gstmed (HHUTMEDIA, 'air', 15, 0, 0,0.,20.,1.,0.5,1.,1.,0,0)
      call gstmed (DETMEDIA, 'det', 15, 1, 0,0.,20.,1.,0.5,1.,1.,0,0)

* Now define the mother volume that the detectors sit in

      par(1) = HHUT_WIDTH / 2.          ! half width in x of mother volume
      par(2) = HHUT_WIDTH / 2.          ! half width in y of mother volume
      par(3) = HHUT_HEIGHT / 2.         ! half height in z of mother volume
      call g_ugsvolu ('HHUT', 'BOX ', HHUTMEDIA, par, 3, ivolu)
      call gsatt ('HHUT', 'SEEN', 0)	! can't see the hut

* Get the number of wires from the ctp file, and add one to the x, u, and v for
* ease in looping over the wires
* See the file "displaynumbering.help" for a description of the numbering of the
* various detector elements
*

      numxwires = hdc_nrwire(1) + 1.
      numywires = hdc_nrwire(2)
      numuwires = hdc_nrwire(3) + 1.
      numvwires = hdc_nrwire(4) + 1.
      xwirelength = numywires*hdc_pitch(2)
      ywirelength = numxwires * hdc_pitch(1)
      uwirelength = xwirelength / SIN(hdc_alpha_angle(3))
      vwirelength = xwirelength / SIN(hdc_alpha_angle(4))

* Now define the wire chambers as a collection of 6 planes

      par(1) = numxwires*hdc_pitch(1)/ 2. ! half width of chamber planes
      par(2) = numywires*hdc_pitch(2)/ 2. ! half width of chamber planes
      par(3) = wcscale * (hdc_zpos(2) - hdc_zpos(1))/ 2. 
      do ichamber = 1,2
         do iplane = 1,2
            write(planename,'(a,a,a,a)') "W",char(64+ichamber),char(64+iplane),"X"
            call g_ugsvolu (planename, 'BOX ', DETMEDIA, par, 3, ivolu) 
            write(planename,'(a,a,a,a)') "W",char(64+ichamber),char(64+iplane),"Y"
            call g_ugsvolu (planename, 'BOX ', DETMEDIA, par, 3, ivolu) 
            write(planename,'(a,a,a,a)') "W",char(64+ichamber),char(64+iplane),"U"
            call g_ugsvolu (planename, 'BOX ', DETMEDIA, par, 3, ivolu) 
            write(planename,'(a,a,a,a)') "W",char(64+ichamber),char(64+iplane),"V"
            call g_ugsvolu (planename, 'BOX ', DETMEDIA, par, 3, ivolu) 
         enddo
      enddo

* make a volumes for 6 planes
      par(3) = wcscale * (6./5. * (hdc_zpos(6) - hdc_zpos(1))) / 2.
      call g_ugsvolu ('WCHA', 'BOX ', DETMEDIA, par, 3, ivolu) ! Wire chamber
      call g_ugsvolu ('WCHB', 'BOX ', DETMEDIA, par, 3, ivolu) ! Wire chamber

* Now place the planes within the wire chamber, start with X

      z = -(5. / 2.) * (hdc_zpos(2) -hdc_zpos(1))
      call gspos ('WAAX', 1, 'WCHA', 0., 0., z, 0, 'ONLY') ! X plane
      z =  (5. / 2.) * (hdc_zpos(2) -hdc_zpos(1))
      call gspos ('WABX', 1, 'WCHA', 0., 0., z, 0, 'ONLY') ! X plane
      z = -(5. / 2.) * (hdc_zpos(2) -hdc_zpos(1))
      call gspos ('WBAX', 1, 'WCHB', 0., 0., z, 0, 'ONLY') ! X plane
      z =  (5. / 2.) * (hdc_zpos(2) -hdc_zpos(1))
      call gspos ('WBBX', 1, 'WCHB', 0., 0., z, 0, 'ONLY') ! X plane

* Now place the planes within the wire chamber, now the Y's

      z = -(3. / 2.) * (hdc_zpos(2) -hdc_zpos(1))
      call gspos ('WAAY', 1, 'WCHA', 0., 0., z, 0, 'ONLY') ! Y plane
      z =  (3. / 2.) * (hdc_zpos(2) -hdc_zpos(1))
      call gspos ('WABY', 1, 'WCHA', 0., 0., z, 0, 'ONLY') ! Y plane
      z = -(3. / 2.) * (hdc_zpos(2) -hdc_zpos(1))
      call gspos ('WBAY', 1, 'WCHB', 0., 0., z, 0, 'ONLY') ! Y plane
      z =  (3. / 2.) * (hdc_zpos(2) -hdc_zpos(1))
      call gspos ('WBBY', 1, 'WCHB', 0., 0., z, 0, 'ONLY') ! Y plane

* Now place the planes within the wire chamber, now the U's

      z = -(1. / 2.) * (hdc_zpos(2) -hdc_zpos(1))
      call gspos ('WAAU', 1, 'WCHA', 0., 0., z, 0, 'ONLY') ! U plane
      z = -(1. / 2.) * (hdc_zpos(2) -hdc_zpos(1))
      call gspos ('WBAU', 1, 'WCHB', 0., 0., z, 0, 'ONLY') ! U plane

* Now place the planes within the wire chamber, now the V's

      z =  (1. / 2.) * (hdc_zpos(2) -hdc_zpos(1))
      call gspos ('WAAV', 1, 'WCHA', 0., 0., z, 0, 'ONLY') ! V plane
      z =  (1. / 2.) * (hdc_zpos(2) -hdc_zpos(1))
      call gspos ('WBAV', 1, 'WCHB', 0., 0., z, 0, 'ONLY') ! V plane


* Now place the wire chambers in the mother volume

      x = hdc_xcenter(1)
      y = - hdc_ycenter(1)
      z = hdc_1_zpos
      call gspos ('WCHA', 1, 'HHUT', x, y, z, 0, 'ONLY') ! upper chamber
      x = hdc_xcenter(2)
      y = - hdc_ycenter(2)
       z = hdc_2_zpos
      call gspos ('WCHB', 1, 'HHUT', x, y, z, 0, 'ONLY') ! bottom chamber
*
* Define the individual wire cells
* See the file "displaynumbering.help" for a description of the numbering of the
* various detector elements
*
*****
*XXXX
*****
      par(1) = hdc_pitch(1) / 2./1000.        ! make the cells "wire" thin
      par(2) = xwirelength/ 2. ! half width of chamber planes
      par(3) = (hdc_zpos(2) - hdc_zpos(1))/ 2. /1000. ! half width of chamber planes

      wspace = hdc_pitch(1)
*
* Now position the X wires plane by plane
*
      do ichamber=1,2
        iplane = 1
        x = - (numxwires) /2. * wspace
        do isector=1,12
          if (isector.eq.7)  then
            iplane = 2
            x = - (numxwires) /2. * wspace
          endif
          write (plane,'(a,a,a,a)') 'W',char(64+ichamber),char(64+iplane),'X'
          do iwire=1,19
            x = x + wspace
            write (wire,'(a,a,a,a)') char(64+ichamber),"X",
     $           char(64 + isector),char(64 + iwire)
            call g_ugsvolu (wire, 'BOX ', DETMEDIA, par, 3, ivolu) ! X cell
            call gsatt (wire, 'SEEN', 0) ! can't see the wire cells
            call gspos (wire, 1, plane, x, 0., 0., 0, 'ONLY')
          enddo
        enddo
      enddo
*

*****
*YYYY
*****
      par(1) = ywirelength/ 2. ! half width of chamber planes
      par(2) = hdc_pitch(2) / 2. / 1000.       ! half width of cell
      par(3) = (hdc_zpos(3) - hdc_zpos(2))/ 2./1000. ! half width of chamber planes
      wspace = hdc_pitch(2)
*
* Now position the Y wires plane by plane
*
      do ichamber=1,2
        iplane = 1
        y = -(numywires + 1.) / 2. * wspace
        do isector=1,4
          if(isector.eq.3) then
            iplane = 2
            y = -(numywires + 1.) / 2. * wspace
          endif
          write (plane,'(a,a,a,a)') 'W',char(64+ichamber),char(64+iplane),'Y'
          do iwire=1,26
            y = y + wspace
            write (wire,'(a,a,a,a)') char(64+ichamber),"Y",
     $           char(64 + isector),char(64 + iwire)
            call g_ugsvolu (wire, 'BOX ', DETMEDIA, par, 3, ivolu) ! Y cell
            call gsatt (wire, 'SEEN', 0) ! can't see the wire cells
            call gspos (wire, 1, plane, 0., y, 0., 0, 'ONLY')
          enddo
         enddo
      enddo
*
*****
*UUUU
*****
      par(1) = hdc_pitch(1) / 2./1000.        ! make the cells "wire" thin
      par(2) = uwirelength/2.
      par(3) = (hdc_zpos(2) - hdc_zpos(1))/ 2. /1000. ! half width of chamber planes
      wspace = hdc_pitch(3) / SIN (hdc_alpha_angle(3))

* Now position the U wires plane by plane...
      do ichamber=1,2
        x = -(numuwires) / 2. * wspace
        write (plane,'(a,a,a)') "W",char(64+ichamber),"AU"
        do isector=1,6
          do iwire=1,18
            x = x + wspace
            write (wire,'(a,a,a,a)') char(64+ichamber),"U",
     $           char(64 + isector),char(64 + iwire)
            call g_ugsvolu (wire, 'BOX ', DETMEDIA, par, 3, ivolu) ! U cell
            call gsatt (wire, 'SEEN', 0) ! can't see the wire cells
            call gspos (wire, 1, plane, x, 0.0 , 0., 4, 'ONLY')
          enddo
        enddo
      enddo
*****
*VVVV
*****
      par(1) = hdc_pitch(1) / 2./1000.        ! make the cells "wire" thin
      par(2) = vwirelength/2.
      par(3) = (hdc_zpos(2) - hdc_zpos(1))/ 2. /1000. ! half width of chamber planes

      wspace = hdc_pitch(4) / SIN (hdc_alpha_angle(4))

* Now position the V wires plane by plane...
      do ichamber=1,2
        x = - (numvwires) / 2. * wspace
        write (plane,'(a,a,a)') "W",char(64+ichamber),"AV"
        do isector=1,6
          do iwire=1,18
            x = x + wspace
            write (wire,'(a,a,a,a)') char(64+ichamber),"V",
     $           char(64 + isector),char(64 + iwire)
            call g_ugsvolu (wire, 'BOX ', DETMEDIA, par, 3, ivolu) ! V cell
            call gsatt (wire, 'SEEN', 0) ! can't see the wire cells
            call gspos (wire, 1, plane, x, 0., 0., 3, 'ONLY')
          enddo
        enddo
      enddo
*
* Now define the hodoscope layers
* See the file "displaynumbering.help" for a description of the numbering of the
* various detector elements

      par(1) = hscin_1x_size * hscin_1x_nr / 2.    ! half width of X strips
      par(2) = hscin_1y_size * hscin_1y_nr / 2.    ! half width of Y strips
      par(3) = hscin_1x_dzpos * hodoscale / 2. !half thickness of hodoscope in z
      call g_ugsvolu ('HDX1', 'BOX ', DETMEDIA, par, 3, ivolu) ! X plane hodo
      call g_ugsvolu ('HDY1', 'BOX ', DETMEDIA, par, 3, ivolu) ! Y plane hodo

      call gsatt ('HDX1', 'SEEN', 0)   ! can't see the hodo box
      call gsatt ('HDY1', 'SEEN', 0)   ! can't see the hodo box
      par(1) = hscin_2x_size * hscin_2x_nr / 2.    ! half width of X strips
      par(2) = hscin_2y_size * hscin_2y_nr / 2.    ! half width of Y strips
      par(3) = hscin_2x_dzpos * hodoscale / 2. !half thickness of hodoscope in z
      call g_ugsvolu ('HDX2', 'BOX ', DETMEDIA, par, 3, ivolu) ! X plane hodo
      call g_ugsvolu ('HDY2', 'BOX ', DETMEDIA, par, 3, ivolu) ! Y plane hodo
      call gsatt ('HDX2', 'SEEN', 0)   ! can't see the hodo box
      call gsatt ('HDY2', 'SEEN', 0)   ! can't see the hodo box
     
! box for front hodos
      par(1) = hscin_1x_size * hscin_1x_nr / 2.
      par(2) = hscin_1y_size * hscin_1y_nr / 2.
      par(3) = hscin_1x_dzpos*hodoscale + (hscin_1y_zpos-hscin_1x_zpos)/2.
      call g_ugsvolu ('HOD1', 'BOX ', DETMEDIA, par, 3, ivolu) ! hodoscope box
      call gsatt ('HOD1', 'SEEN', 0)	! can't see the hodo box
*                                         added by Derek
! box for back hodos
      par(1) = hscin_2x_size * hscin_2x_nr / 2.
      par(2) = hscin_2y_size * hscin_2y_nr / 2.
      par(3) = hscin_2x_dzpos*hodoscale + (hscin_2y_zpos-hscin_2x_zpos)/2.
      call g_ugsvolu ('HOD2', 'BOX ', DETMEDIA, par, 3, ivolu) ! hodoscope box
      call gsatt ('HOD2', 'SEEN', 0)	! can't see the hodo box

      x = -hscin_1x_offset
      y = hscin_1y_offset
      z = hscin_1x_zpos
      call gspos ('HOD1', 1, 'HHUT', x, y, z, 0, 'ONLY') ! lower hodo
      x = -hscin_2x_offset
      y = hscin_2y_offset
      z = hscin_2x_zpos
      call gspos ('HOD2', 1, 'HHUT', x, y, z, 0, 'ONLY') ! upper hodo

      z= -(hscin_1x_dzpos*hodoscale + (hscin_1y_zpos-hscin_1x_zpos))/2.
      call gspos ('HDX1', 1, 'HOD1', 0., 0., z, 0, 'ONLY') ! X plane
      call gspos ('HDY1', 1, 'HOD1', 0., 0., -z, 0, 'ONLY') ! Y plane
      z= -(hscin_2x_dzpos*hodoscale + (hscin_2y_zpos-hscin_2x_zpos))/2.
      call gspos ('HDX2', 1, 'HOD2', 0., 0., z, 0, 'ONLY') ! X plane
      call gspos ('HDY2', 1, 'HOD2', 0., 0., -z, 0, 'ONLY') ! Y plane

* Now define the strips for the hodoscopes

      x = (hscin_1x_nr + 1.) * hscin_1x_size / 2. ! starting loci
      do i = 1, hscin_1x_nr
         x = x - hscin_1x_size
         write (scinname,'(a,a)') "H1X",char(64 + i)
         par(1) = hscin_1x_size / 2.  !half width of X strips
         par(2) = hscin_1y_size * hscin_1y_nr / 2.
         par(3) = hscin_1x_dzpos * hodoscale / 2.
         call g_ugsvolu (scinname, 'BOX ', DETMEDIA, par, 3, ivolu)
         call gspos (scinname, 1, 'HDX1', x, 0., 0., 0, 'ONLY')
      enddo
      y = (hscin_1y_nr + 1.) * hscin_1y_size / 2. ! starting loci
      do i = 1, hscin_1y_nr
         y = y - hscin_1y_size
         write (scinname,'(a,a)') "H1Y",char(64 + i)
         par(1) = hscin_1x_size * hscin_1x_nr / 2.
         par(2) = hscin_1y_size / 2.  !half width of X strips
         par(3) = hscin_1y_dzpos * hodoscale / 2.
         call g_ugsvolu (scinname, 'BOX ', DETMEDIA, par, 3, ivolu)
         call gspos (scinname, 1, 'HDY1', 0., y, 0., 0, 'ONLY')
      enddo
      x = (hscin_2x_nr + 1.) * hscin_2x_size / 2. ! starting loci
      do i = 1, hscin_2x_nr
         x = x - hscin_2x_size
         write (scinname,'(a,a)') "H2X",char(64 + i)
         par(1) = hscin_2x_size / 2.  !half width of X strips
         par(2) = hscin_2y_size * hscin_2y_nr / 2.
         par(3) = hscin_2x_dzpos * hodoscale / 2.
         call g_ugsvolu (scinname, 'BOX ', DETMEDIA, par, 3, ivolu)
         call gspos (scinname, 1, 'HDX2', x, 0., 0., 0, 'ONLY')
      enddo
      y = (hscin_2y_nr + 1.) * hscin_2y_size / 2. ! starting loci
      do i = 1, hscin_2y_nr
         y = y - hscin_2y_size
         write (scinname,'(a,a)') "H2Y",char(64 + i)
         par(1) = hscin_2x_size * hscin_2x_nr / 2.
         par(2) = hscin_2y_size / 2.  !half width of X strips
         par(3) = hscin_2y_dzpos * hodoscale / 2.
         call g_ugsvolu (scinname, 'BOX ', DETMEDIA, par, 3, ivolu)
         call gspos (scinname, 1, 'HDY2', 0., y, 0., 0, 'ONLY')
      enddo

* Now define the shower detector
* See the file "displaynumbering.help" for a description of the numbering of the
* various detector elements

! half width of the shower in x
      par(1) = hmax_cal_rows * hcal_block_zsize / 2.
! half width of the shower in y
      par(2) = hcal_block_ysize / 2.
! half height of the shower detector
      par(3) = hmax_cal_columns * hcal_block_xsize / 2.
      call g_ugsvolu ('SHOW', 'BOX ', DETMEDIA, par, 3, ivolu)

!for the x offset, we take the center of the top and bottom blocks
!This assumes that all the blocks are
!the same heighth and width as scal_1pr

      x = -(hcal_block_xc(1) + hcal_block_xc(hmax_cal_rows))/2
      y = hcal_block_yc(1)
      z = hcal_1pr_zpos + hmax_cal_columns*hcal_block_xsize/2.
      call gspos ('SHOW', 1, 'HHUT', x, y, z, 0, 'ONLY')
      call gsatt ('SHOW', 'SEEN',0)


      par(1) = hmax_cal_rows * hcal_block_zsize / 2. ! half width of shower in x
      par(2) = hcal_block_ysize / 2.    ! half width of the shower in y
      par(3) = hcal_block_xsize / 2.    ! half height of the shower detector

      z = -(hmax_cal_columns + 1.) / 2. * hcal_block_xsize
      do ilayer = 1,hmax_cal_columns
        z = z + hcal_block_xsize

        write (layername,'(a,i1)') 'LAY',ilayer

        par(1) = hmax_cal_rows * hcal_block_zsize / 2.
        call g_ugsvolu (layername, 'BOX ', DETMEDIA, par, 3, ivolu)
        call gspos(layername, 1, 'SHOW', 0., 0., z, 0, 'ONLY')

        par(1) = hcal_block_zsize / 2.  ! half width of a block
        x = (hmax_cal_rows - 1.) / 2. * hcal_block_zsize
        do irow = 1, hmax_cal_rows
          write (blockname,'(a,i1,a)') 'BL',ilayer,char(64 + irow)
          call g_ugsvolu (blockname, 'BOX ', DETMEDIA, par, 3, ivolu)
          call gspos(blockname,1,layername, x, 0., 0., 0, 'ONLY')
          x = x - hcal_block_zsize
        enddo
      enddo
        
      end