Return to s_one_ev_geometry.f CVS log

Up to [HallC] / Analyzer / ONEEV

(SAW) Don't let U&V wires extend beyond chamber.  Some code cleanup.

      subroutine s_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)
*
* Modified from HMS version, h_one_ev_geometry, March 1995 by
* Derek van Westrum (vanwestr@cebaf.gov)
*
* $Log: s_one_ev_geometry.f,v $
* Revision 1.5  1996/11/22 15:37:10  saw
* (SAW) Don't let U&V wires extend beyond chamber.  Some code cleanup.
*
* Revision 1.4  1996/04/30 14:10:39  saw
* (DVW) Code update
*
* Revision 1.3  1996/01/17 16:37:48  cdaq
* (DVW) Tweak hodoscale
*
* Revision 1.2  1995/10/06 18:24:18  cdaq
* (DVW) Changed to ctp geometry variables and eliminated call to s_one_ev.par.
*
* Revision 1.1  1995/07/31 15:23:38  cdaq
* Initial revision
* h_one_ev_geometry.f,v $

      implicit none

      include 'sos_data_structures.cmn'
      include 'sos_geometry.cmn'
      include 'sos_calorimeter.cmn'
      include 'sos_scin_parms.cmn'

      real*4    SHUT_WIDTH,SHUT_HEIGHT
      parameter (SHUT_WIDTH = 100.)     ! full width of the det. hut
      parameter (SHUT_HEIGHT = 800.)    ! full height of the det. hut
      integer SHUTMEDIA                 ! non-sensitive tracking media
      integer DETMEDIA                  ! sensitive tracking media
      parameter (SHUTMEDIA = 1, DETMEDIA = 2)
      real*4 hodoscale
      parameter (hodoscale = 2.)
      real*4 wcscale
*      parameter (wcscale = 5.)
      parameter (wcscale = 1.)
      real*4 xwirelength                   
      real*4 ywirelength                   
      real*4 uwirelength
      real*4 vwirelength
      parameter(xwirelength = 40.0)
      parameter(ywirelength = 66.0)
      parameter(uwirelength = 80)   != xwirelength/sin(60 degrees)
      parameter(vwirelength = 80)   != xwirelength/sin(60 degrees)


      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 xtemp,ytemp                  ! Temporary variables for
      real xplus,yplus                  ! display correct wire lengths.
      real xminus,yminus
  
      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 (SHUTMEDIA, '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) = SHUT_WIDTH / 2.          ! half width in x of mother volume
      par(2) = SHUT_WIDTH / 2.          ! half width in y of mother volume
      par(3) = SHUT_HEIGHT / 2.         ! half height in z of mother volume
      call g_ugsvolu ('SHUT', 'BOX ', SHUTMEDIA, par, 3, ivolu)
      call gsatt ('SHUT', 'SEEN', 0)	! can't see the hut


* Now define the wire chambers as a collection of planes
* First the U and V planes.
*
      par(1) = ywirelength/2.
      par(2) = xwirelength/2.
      par(3) = wcscale * (sdc_zpos(2) - sdc_zpos(1))/ 2. ! half width of chamber planes
      do ichamber = 1,2
         do iplane = 1,2
           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
*
* Now do the X planes. 
*
      par(1) = ywirelength/2.
      par(2) = xwirelength/2.
      par(3) = wcscale * (sdc_zpos(2) - sdc_zpos(1))/ 2. ! half width of chamber planes
      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)
         enddo
       enddo

! make a volume for 6 planes.  The size here should be cool. DVW 18 jul 95
      par(1) = ywirelength/2.
      par(2) = xwirelength/2.
      par(3) = wcscale * (6./5. * (sdc_zpos(6) - sdc_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 U
      z = - wcscale * (5. / 2.) * (sdc_zpos(2) -sdc_zpos(1))
      call gspos ('WAAU', 1, 'WCHA', 0., 0., z, 0, 'ONLY') ! U plane
      z = - wcscale * (3. / 2.) * (sdc_zpos(2) -sdc_zpos(1))
      call gspos ('WABU', 1, 'WCHA', 0., 0., z, 0, 'ONLY') ! U plane
      z = - wcscale * (5. / 2.) * (sdc_zpos(2) -sdc_zpos(1))
      call gspos ('WBAU', 1, 'WCHB', 0., 0., z, 0, 'ONLY') ! U plane
      z = - wcscale * (3. / 2.) * (sdc_zpos(2) -sdc_zpos(1))
      call gspos ('WBBU', 1, 'WCHB', 0., 0., z, 0, 'ONLY') ! U plane
*
      z = - wcscale * (1. / 2.) * (sdc_zpos(2) -sdc_zpos(1))
      call gspos ('WAAX', 1, 'WCHA', 0., 0., z, 0, 'ONLY') ! X plane
      z =   wcscale * (1. / 2.) * (sdc_zpos(2) -sdc_zpos(1))
      call gspos ('WABX', 1, 'WCHA', 0., 0., z, 0, 'ONLY') ! X plane
      z = - wcscale * (1. / 2.) * (sdc_zpos(2) -sdc_zpos(1))
      call gspos ('WBAX', 1, 'WCHB', 0., 0., z, 0, 'ONLY') ! X plane
      z =   wcscale * (1. / 2.) * (sdc_zpos(2) -sdc_zpos(1))
      call gspos ('WBBX', 1, 'WCHB', 0., 0., z, 0, 'ONLY') ! X plane
*
      z =   wcscale * (3. / 2.) * (sdc_zpos(2) -sdc_zpos(1))
      call gspos ('WAAV', 1, 'WCHA', 0., 0., z, 0, 'ONLY') ! V plane
      z =   wcscale * (5. / 2.) * (sdc_zpos(2) -sdc_zpos(1))
      call gspos ('WABV', 1, 'WCHA', 0., 0., z, 0, 'ONLY') ! V plane
      z =   wcscale * (3. / 2.) * (sdc_zpos(2) -sdc_zpos(1))
      call gspos ('WBAV', 1, 'WCHB', 0., 0., z, 0, 'ONLY') ! V plane
      z =   wcscale * (5. / 2.) * (sdc_zpos(2) -sdc_zpos(1))
      call gspos ('WBBV', 1, 'WCHB', 0., 0., z, 0, 'ONLY') ! V plane

* Now place the wire chambers in the mother volume
*
      x = sdc_xcenter(1)
      y = - sdc_ycenter(1)
      z = sdc_1_zpos
      call gspos ('WCHA', 1, 'SHUT', x, y, z, 0, 'ONLY') ! upper chamber
      x = sdc_xcenter(2)
      y = - sdc_ycenter(2)
      z = sdc_2_zpos
      call gspos ('WCHB', 1, 'SHUT', 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
*
*****
*UUUU
*****
      par(1) = sdc_pitch(1) / 2./1000.        ! make the cells "wire" thin
      par(2) = uwirelength/2.
      par(3) = (sdc_zpos(2) - sdc_zpos(1))/ 2./1000. ! half width of chamber planes
      wspace = sdc_pitch(1) / SIN(sdc_alpha_angle(1))
*
* First define all the "boxes" for all the U wires in both chambers...
* Then position the U wires plane by plane
      do ichamber=1,2
        iplane = 1
        x = -(sdc_nrwire(1) + 1.) / 2. * wspace
        do isector=1,4
          if(isector.eq.3) then
            iplane = 2
            x = -(sdc_nrwire(1) + 1.) / 2. * wspace
          endif
          write(plane,'(a,a,a,a)') 'W',char(64 + ichamber),char(64+iplane),'U'
          do iwire = 1,24
            x = x + wspace
            ytemp = xwirelength/2.0
            xtemp = ytemp/tan(sdc_alpha_angle(1)) + x
            if(xtemp.gt.ywirelength/2.0) then
              xplus = ywirelength/2.0
              yplus = (xplus-x)*tan(sdc_alpha_angle(1))
            else
              xplus = xtemp
              yplus = ytemp
            endif
            ytemp = -xwirelength/2.0
            xtemp = ytemp/tan(sdc_alpha_angle(1)) + x
            if(xtemp.lt.-ywirelength/2.0) then
              xminus = -ywirelength/2.0
              yminus = (xminus-x)*tan(sdc_alpha_angle(1))
            else
              xminus = xtemp
              yminus = ytemp
            endif
            par(2) = sqrt((xplus-xminus)**2+(yplus-yminus)**2)/2.0
            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, (xminus+xplus)/2
     $           , (yminus+yplus)/2, 0., 3, 'ONLY')
          enddo
        enddo
      enddo
*

*****
*XXX
*****
      par(1) = sdc_pitch(3) / 2. /1000.       ! half width of cell
      par(2) = xwirelength/2.             ! the length of the xwirelengths
      par(3) = (sdc_zpos(4) - sdc_zpos(3))/ 2./1000. ! half width of chamber planes
      wspace = sdc_pitch(3)
*
* First define all the "boxes" for all the X wires in both chambers...
* Then position the X wires plane by plane...
*
      do ichamber=1,2
        iplane = 1
        x = -(sdc_nrwire(3) + 1.) / 2. * wspace
        do isector=1,8
          if(isector.eq.5) then
            iplane = 2
            x = -(sdc_nrwire(3) + 1.) / 2. * wspace
          endif
          write (plane,'(a,a,a,a)') 'W',char(64 + ichamber),char(64+iplane),'X'
          do iwire = 1,16
            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
*
*
*****
*VVVV
*****
      par(1) = sdc_pitch(5) / 2./1000.        ! half width of cell
      par(2) = vwirelength/2.
      par(3) = (sdc_zpos(6) - sdc_zpos(5))/ 2./1000. ! half width of chamber planes
*
      wspace = sdc_pitch(5) / SIN(sdc_alpha_angle(5))        

* First define all the "boxes" for all the V wires in both chambers...
* Then position the V wires plane by plane...
      do ichamber=1,2
        iplane =1
        x = -(sdc_nrwire(5) + 1.) / 2. * wspace
        do isector=1,4
          if(isector.eq.3) then
            iplane = 2
            x = -(sdc_nrwire(5) + 1.) / 2. * wspace
          endif
          write (plane,'(a,a,a,a)') 'W',char(64 + ichamber),char(64+iplane),'V'
          do iwire = 1,24
            x = x + wspace
            ytemp = -xwirelength/2.0
            xtemp = ytemp/tan(sdc_alpha_angle(5)) + x
            if(xtemp.gt.ywirelength/2.0) then
              xplus = ywirelength/2.0
              yplus = (xplus-x)*tan(sdc_alpha_angle(5))
            else
              xplus = xtemp
              yplus = ytemp
            endif
            ytemp = xwirelength/2.0
            xtemp = ytemp/tan(sdc_alpha_angle(5)) + x
            if(xtemp.lt.-ywirelength/2.0) then
              xminus = -ywirelength/2.0
              yminus = (xminus-x)*tan(sdc_alpha_angle(5))
            else
              xminus = xtemp
              yminus = ytemp
            endif
             par(2) = sqrt((xplus-xminus)**2+(yplus-yminus)**2)/2.0
            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) ! U cell
            call gsatt (wire, 'SEEN', 0) ! can't see the wire cells
             
c            write (wire,'(a,a,a,a)') char(64 + ichamber),'V',
c     $           char(64 + isector),char(64 + iwire)
            call gspos (wire, 1, plane, (xminus+xplus)/2
     $           , (yminus+yplus)/2, 0., 4, '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) = sscin_1x_size * sscin_1x_nr / 2.
      par(2) = sscin_1y_size * sscin_1y_nr / 2.
      par(3) = sscin_1x_dzpos * hodoscale / 2.
      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) = sscin_2x_size * sscin_2x_nr / 2.
      par(2) = sscin_2y_size * sscin_2y_nr / 2.
      par(3) = sscin_2x_dzpos * hodoscale /2.
      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) = sscin_1x_size * sscin_1x_nr / 2.
      par(2) = sscin_1y_size * sscin_1y_nr / 2.
      par(3) = sscin_1x_dzpos*hodoscale + (sscin_1y_zpos-sscin_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

! box for back hodos
      par(1) = sscin_2x_size * sscin_2x_nr / 2.
      par(2) = sscin_2y_size * sscin_2y_nr / 2.
      par(3) = sscin_2x_dzpos*hodoscale + (sscin_2y_zpos-sscin_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
*                                         added by Derek
*
      x = -sscin_1x_offset
      y = sscin_1y_offset
      z = sscin_1x_zpos
      call gspos ('HOD1', 1, 'SHUT', x, y, z, 0, 'ONLY') ! lower hodo
      x = -sscin_2x_offset
      y = sscin_2y_offset
      z = sscin_2x_zpos
      call gspos ('HOD2', 1, 'SHUT', x, y, z, 0, 'ONLY') ! upper hodo

      z= -(sscin_1x_offset*hodoscale + (sscin_1y_zpos-sscin_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= -(sscin_2x_offset*hodoscale + (sscin_2y_zpos-sscin_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 = (sscin_1x_nr + 1.) * sscin_1x_size / 2. ! starting loci
      do i = 1, sscin_1x_nr
        x = x - sscin_1x_size
        write (scinname,'(a,a)') 'H1X',char(64 + i)
        par(1) = sscin_1x_size / 2. ! half width of X strips
        par(2) = sscin_1y_size * sscin_1y_nr / 2.
        par(3) = sscin_1x_dzpos * hodoscale / 2. !half thickness of hodoscope in z
        call g_ugsvolu (scinname, 'BOX ', DETMEDIA, par, 3, ivolu) ! X plane hodo
        call gspos (scinname, i, 'HDX1', x, 0., 0., 0, 'ONLY')
      enddo
      y = (sscin_1y_nr + 1.) * sscin_1y_size / 2. ! starting loci
      do i = 1, sscin_1y_nr
        y = y - sscin_1y_size
        write (scinname,'(a,a)') 'H1Y',char(64 + i)
        par(1) = sscin_1x_size * sscin_1x_nr / 2.
                                        ! half width of hodoscope in x
        par(2) = sscin_1y_size / 2.	! half width of X strips
        par(3) = sscin_1y_dzpos * hodoscale / 2. !half thickness of hodoscope in z
        call g_ugsvolu (scinname, 'BOX ', DETMEDIA, par, 3, ivolu) ! Y plane hodo
        call gspos (scinname, i, 'HDY1', 0., y, 0., 0, 'ONLY')
      enddo
      x = (sscin_2x_nr + 1.) * sscin_2x_size / 2. ! starting loci
      do i = 1,sscin_2x_nr
        x = x - sscin_2x_size
        write (scinname,'(a,a)') 'H2X',char(64 + i)
        par(1) = sscin_2x_size / 2. ! half width of X strips
        par(2) = sscin_2y_size * sscin_2y_nr / 2.
        par(3) = sscin_2x_dzpos * hodoscale / 2. !half thickness of hodoscope in z
        call g_ugsvolu (scinname, 'BOX ', DETMEDIA, par, 3, ivolu) ! X plane hodo
        call gspos (scinname, i, 'HDX2', x, 0., 0., 0, 'ONLY')
      enddo
      y = (sscin_2y_nr + 1.) * sscin_2y_size / 2. ! starting loci
      do i = 1, sscin_2y_nr
        y = y - sscin_2y_size
        write (scinname,'(a,a)') 'H2Y',char(64 + i)
        par(1) = sscin_2x_size * sscin_2x_nr / 2.
        par(2) = sscin_2y_size / 2.	! half width of X strips
        par(3) = sscin_2y_dzpos * hodoscale / 2. !half thickness of hodoscope in z
        call g_ugsvolu (scinname, 'BOX ', DETMEDIA, par, 3, ivolu) ! Y plane hodo
        call gspos (scinname, i, '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) = smax_cal_rows * scal_block_zsize / 2.
! half width of the shower in y
      par(2) = scal_block_ysize / 2.
! half height of the shower detector
      par(3) = smax_cal_columns * scal_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 = -(scal_block_xc(1) + scal_block_xc(smax_cal_rows))/2
      y = scal_block_yc(1)
      z = scal_1pr_zpos + smax_cal_columns*scal_block_xsize/2.
      call gspos ('SHOW', 1, 'SHUT', x, y, z, 0, 'ONLY')
      call gsatt ('SHOW','SEEN',0)

      par(1) = smax_cal_rows * scal_block_zsize / 2.! half width of shower in x
      par(2) = scal_block_ysize / 2.    ! half width of the shower in y
      par(3) = scal_block_xsize / 2.    ! half height of the shower detector

      z = -(smax_cal_columns + 1.) / 2. * scal_block_xsize
      do ilayer =1,smax_cal_columns
        z = z + scal_block_xsize

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

        par(1) = smax_cal_rows * scal_block_zsize / 2. ! half width of shower
        call g_ugsvolu (layername, 'BOX ', DETMEDIA, par, 3, ivolu)
        call gspos(layername, 1, 'SHOW', 0., 0., z, 0, 'ONLY')

        par(1) = scal_block_zsize / 2.	! half width of a block
        x =  (smax_cal_rows - 1.) / 2. * scal_block_zsize
        do irow = 1, smax_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 - scal_block_zsize
        enddo
      enddo
*

      end