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