Return to mc_shms_hut.f CVS log

Up to [HallC] / simc_gfortran / shms

Major changes
Implement SHMS detectors

	subroutine mc_shms_hut (m2,p,x_fp,dx_fp,y_fp,dy_fp,ms_flag,
     > wcs_flag,
     > decay_flag,dflag,resmult,spec,ok_hut,zinit,pathlen,
     > spectr)
C----------------------------------------------------------------------
C
C Monte-Carlo of SHMS detector hut.
C	Note that we only pass on real*4 variables to the subroutine.
C	This will make life easier for portability.
C----------------------------------------------------------------------

	implicit 	none

	include '../shms/struct_shms.inc'
	include '../spectrometers.inc'
	include '../shms/hut.inc'

C Math constants

	real*8 pi,d_r,r_d,root

	parameter (pi = 3.141592654)
	parameter (d_r = pi/180.)
	parameter (r_d = 180./pi)
	parameter (root = 0.707106781)		!square root of 1/2

	logical*4 cer_flag
	logical*4 vac_flag
        parameter (cer_flag = .true.) ! TRUE means 1st Cerenkov (Ar/Ne) is in front of chambers
        parameter (vac_flag = .false.) ! FALSE means helium bag replaces 1st Cerenkov (Ar/Ne) 

c	common /hutflag/ cer_flag,vac_flag

C all parameters, later to take from .parm files
C The arguments

	real*8	p,m2			!momentum and mass of particle
	real*8	x_fp,y_fp,dx_fp,dy_fp	!Focal plane values to return
	logical	ms_flag, wcs_flag	!particle, m_scat, wc_smear
	logical	ok_hut			!true if particle makes it
	logical decay_flag,dflag
	real*8	xcal,ycal		!Position of track at calorimeter.
	real*8 pathlen
	real*8 resmult				!DC resolution factor
	real*8 zinit
        real*4 spec(58)

c external function
	real*8 gauss1
C Local declarations.

	integer*4	spectr	!spectrometer number (for tune-dependent stuff)
	integer*4	i,iplane,jchamber,npl_off
	integer*4	chan	/1/

	real*8	radw,drift
c need real*4 for cernlib routine lfut
	real*4	xdc(12),ydc(12),zdc(12)		!positions at d.c. planes
	real*4	x0,y0,dx,dy			!track fitting temporaries
	real*4	badf				!temporaries

	real*8  tmpran1,tmpran2
	real*8   nsig_max
	real*8 hdc_del_plane
	parameter (nsig_max=99.0d0)
c mkj
	logical use_det_cut
	parameter (use_det_cut=.true.)
!	parameter (use_det_cut=.false.)

C ================================ Executable Code =============================

C Initialize some variables

!	write (6,*) x_fp, y_fp, dx_fp, dy_fp, cerflag
	hdc_del_plane = hdc_thick + hdc_wire_thick + hdc_cath_thick

C Initialize ok_hut to zero

	ok_hut = .false.
c
	resmult= 1.0


C Initialize the xdc and ydc arrays to zero

	do i=1,12
	  xdc(i) = 0.
	  ydc(i) = 0.
	enddo

C------------------------------------------------------------------------------C
C                           Top of loop through hut                            C
C------------------------------------------------------------------------------C


        if (cer_flag) then
	drift = hcer_1_zentrance
	call project(xs,ys,drift,.false.,dflag,m2,p,pathlen)
	   radw = hfoil_exit_thick/hfoil_exit_radlen
	   if(ms_flag) call musc(m2,p,radw,dydzs,dxdzs)
	 radw = hcer_entr_thick/hcer_entr_radlen
	 if(ms_flag) call musc(m2,p,radw,dydzs,dxdzs)
	 drift = hcer_1_zmirror - hcer_1_zentrance-hcer_mirglass_thick/2
	 radw = drift/hcer_1_radlen
	call project(xs,ys,drift,.false.,dflag,m2,p,pathlen)
	if(ms_flag ) call musc_ext(m2,p,radw,drift,
     > dydzs,dxdzs,ys,xs)


	radw = hcer_mirglass_thick/hcer_mirglass_radlen
	if(ms_flag) call musc(m2,p,radw,dydzs,dxdzs)
c
	drift = hcer_mirback1_thick/2+hcer_mirglass_thick/2
	call project(xs,ys,drift,.false.,dflag,m2,p,pathlen)
	radw = hcer_mirback1_thick/hcer_mirback1_radlen
	if(ms_flag) call musc(m2,p,radw,dydzs,dxdzs)
c
	drift = hcer_mirback2_thick/2+hcer_mirback1_thick/2
	call project(xs,ys,drift,.false.,dflag,m2,p,pathlen)
	radw = hcer_mirback2_thick/hcer_mirback2_radlen
	if(ms_flag) call musc(m2,p,radw,dydzs,dxdzs)
c
	drift = hcer_mirback3_thick/2+hcer_mirback2_thick/2
	call project(xs,ys,drift,.false.,dflag,m2,p,pathlen)
	radw = hcer_mirback3_thick/hcer_mirback3_radlen
	if(ms_flag) call musc(m2,p,radw,dydzs,dxdzs)
c
	drift = hcer_mirback4_thick/2+hcer_mirback3_thick/2
	call project(xs,ys,drift,.false.,dflag,m2,p,pathlen)
	radw = hcer_mirback4_thick/hcer_mirback4_radlen
	if(ms_flag) call musc(m2,p,radw,dydzs,dxdzs)

	drift = hcer_1_zexit - hcer_1_zmirror -hcer_mirglass_thick/2
     > -hcer_mirback1_thick-hcer_mirback2_thick-hcer_mirback3_thick-hcer_mirback4_thick/2
	radw = drift/hcer_1_radlen
	call project(xs,ys,drift,decay_flag,dflag,m2,p,pathlen)
	if(ms_flag) call musc_ext(m2,p,radw,drift,
     > dydzs,dxdzs,ys,xs)
	radw = hcer_exit_thick/hcer_exit_radlen
	if(ms_flag) call musc(m2,p,radw,dydzs,dxdzs)
        
       else
c  if vaccum pipe drift to pipe exit which is at same zpos as the cerenkov exit window. 
          if (vac_flag) then
   	   drift =  hcer_1_zexit 
 	   call project(xs,ys,drift,.false.,dflag,m2,p,pathlen)
	   radw = hfoil_exit_thick/hfoil_exit_radlen
	   if(ms_flag) call musc(m2,p,radw,dydzs,dxdzs)
          else ! helium bag
   	   drift = hcer_1_zentrance 
 	   call project(xs,ys,drift,.false.,dflag,m2,p,pathlen)
	   radw = hfoil_exit_thick/hfoil_exit_radlen
	   if(ms_flag) call musc(m2,p,radw,dydzs,dxdzs)
	   radw = helbag_al_thick/helbag_al_radlen ! assume no distance to Helium bag Al mylar
           ms_flag = .true.
	   if(ms_flag) call musc(m2,p,radw,dydzs,dxdzs)
	   radw = helbag_mylar_thick/helbag_mylar_radlen ! assume no distance to Helium bag Al mylar
	   if(ms_flag) call musc(m2,p,radw,dydzs,dxdzs)
	   drift = hcer_1_zexit - hcer_1_zentrance
	   radw = drift/helbag_hel_radlen
           call project(xs,ys,drift,.false.,dflag,m2,p,pathlen)
	   if(ms_flag) call musc_ext(m2,p,radw,drift,
     > dydzs,dxdzs,ys,xs)
	   radw = helbag_al_thick/helbag_al_radlen ! assume no distance to Helium bag Al mylar
	   if(ms_flag) call musc(m2,p,radw,dydzs,dxdzs)
	   radw = helbag_mylar_thick/helbag_mylar_radlen ! assume no distance to Helium bag Al mylar
	   if(ms_flag) call musc(m2,p,radw,dydzs,dxdzs)
           ms_flag = .false.
          endif
        endif

        

C Go to first drift chamber set
C For simplicity, perform air MS (probably negligeable) at before drift
C instead of 1/2 way through.

*	write (6,*) 'made it to the first drift chamber'
	drift = (hdc_1_zpos - 0.5*hdc_nr_plan*hdc_del_plane) 
     > - hcer_1_zexit
	radw = drift/hair_radlen
	call project(xs,ys,drift,.false.,dflag,m2,p,pathlen)
	if (ms_flag) call musc_ext(m2,p,radw,drift,dydzs,dxdzs,ys,xs)
c	if (1 .eq. 1) call musc_ext(m2,p,radw,drift,dydzs,dxdzs,ys,xs)

	jchamber = 1
	radw = hdc_entr_thick/hdc_entr_radlen
	if(ms_flag) call musc(m2,p,radw,dydzs,dxdzs)
	npl_off = (jchamber-1)*hdc_nr_plan
	do iplane = 1,hdc_nr_plan
	  radw = hdc_cath_thick/hdc_cath_radlen
	  if(ms_flag) call musc(m2,p,radw,dydzs,dxdzs)
	  drift = 0.5*hdc_thick
	  radw = drift/hdc_radlen
	  if(ms_flag) call musc(m2,p,radw,dydzs,dxdzs)
	  drift = drift + hdc_cath_thick
	  call project(xs,ys,drift,decay_flag,dflag,m2,p,pathlen)
	  radw = hdc_wire_thick/hdc_wire_radlen
	  if(ms_flag) call musc(m2,p,radw,dydzs,dxdzs)
	  if(wcs_flag) then
	    tmpran1 = gauss1(nsig_max)	!gaussian, truncated at 99 sigma.
	    tmpran2 = gauss1(nsig_max)
	  else
	    tmpran1 = 0.
	    tmpran2 = 0.
	  endif
	  xdc(npl_off+iplane) = xs + hdc_sigma(npl_off+iplane)
     > *tmpran1*resmult
	  ydc(npl_off+iplane) = ys + hdc_sigma(npl_off+iplane)
     > *tmpran2*resmult
	  if (iplane.eq.2 .or. iplane.eq.5) then
	    xdc(npl_off+iplane) = 0.   !y plane, no x information
	  else
c	     write(*,*) ' iplane = ',iplane
	    ydc(npl_off+iplane) = 0.   !x-like plane, no y info
	  endif
*	  write (6,*) 'i am still in the first drift chamber'
	  drift = 0.5*hdc_thick
	  radw = drift/hdc_radlen
	  if(ms_flag) call musc(m2,p,radw,dydzs,dxdzs)
	  drift = drift + hdc_wire_thick
	  call project(xs,ys,drift,decay_flag,dflag,m2,p,pathlen)
	enddo
	radw = hdc_exit_thick/hdc_exit_radlen
	if(ms_flag) call musc(m2,p,radw,dydzs,dxdzs)
	if (xs.gt.(hdc_1_bot-hdc_1x_offset) .or.
     >      xs.lt.(hdc_1_top-hdc_1x_offset) .or.
     >      ys.gt.(hdc_1_left-hdc_1y_offset) .or.
     >      ys.lt.(hdc_1_right-hdc_1y_offset) ) then
	  shmsSTOP_dc1 = shmsSTOP_dc1 + 1
c	  write(6,*) 'Lost in DC! delta,xp,yp',dpps,dxdzs,dydzs
	  if (use_det_cut) then
	     stop_id = 18
	     goto 500
	  endif
	endif
        spec(39)=xs
        spec(40)=ys
	radw = hdc_cath_thick/hdc_cath_radlen
	if(ms_flag) call musc(m2,p,radw,dydzs,dxdzs)

C at last cathode foil of first drift chamber set, drift to next

*	write (6,*) 'made it to the second drift chamber in the hut'
	drift = hdc_2_zpos - hdc_1_zpos - hdc_nr_plan*hdc_del_plane
C       Break this into 2 parts to properly account for decay.
C       We've already done decay up to the half-way point between the chambers.
	call project(xs,ys,drift/2.0,.false.,dflag,m2,p,pathlen)
	call project(xs,ys,drift/2.0,decay_flag,dflag,m2,p,pathlen)
	radw = drift/hair_radlen
	if(ms_flag) call musc_ext(m2,p,radw,drift,dydzs,dxdzs,ys,xs)

	jchamber = 2
	radw = hdc_entr_thick/hdc_entr_radlen
	if(ms_flag) call musc(m2,p,radw,dydzs,dxdzs)
	npl_off = (jchamber-1)*hdc_nr_plan
	do iplane = 1,hdc_nr_plan
	  radw = hdc_cath_thick/hdc_cath_radlen
	  if(ms_flag) call musc(m2,p,radw,dydzs,dxdzs)
	  drift = 0.5*hdc_thick
	  radw = drift/hdc_radlen
	  if(ms_flag) call musc(m2,p,radw,dydzs,dxdzs)
	  drift = drift + hdc_cath_thick
	  call project(xs,ys,drift,decay_flag,dflag,m2,p,pathlen)
	  radw = hdc_wire_thick/hdc_wire_radlen
	  if(ms_flag) call musc(m2,p,radw,dydzs,dxdzs)
	  if(wcs_flag) then
	    tmpran1 = gauss1(nsig_max)	!gaussian, truncated at 99 sigma.
	    tmpran2 = gauss1(nsig_max)
	  else
	    tmpran1 = 0.
	    tmpran2 = 0.
	  endif
	  xdc(npl_off+iplane) = xs + hdc_sigma(npl_off+iplane)
     > *tmpran1*resmult
	  ydc(npl_off+iplane) = ys + hdc_sigma(npl_off+iplane)
     > *tmpran2*resmult
	  if (iplane.eq.2 .or. iplane.eq.5) then
	    xdc(npl_off+iplane) = 0.   !y plane, no x information
	  else
	    ydc(npl_off+iplane) = 0.   !x-like plane, no y info
	  endif
	  drift = 0.5*hdc_thick
	  radw = drift/hdc_radlen
	  if(ms_flag) call musc(m2,p,radw,dydzs,dxdzs)
	  drift = drift + hdc_wire_thick
	  call project(xs,ys,drift,decay_flag,dflag,m2,p,pathlen)
	enddo
	radw = hdc_exit_thick/hdc_exit_radlen
	if(ms_flag) call musc(m2,p,radw,dydzs,dxdzs)
	if (xs.gt.(hdc_2_bot-hdc_2x_offset) .or.
     >      xs.lt.(hdc_2_top-hdc_2x_offset) .or.
     >      ys.gt.(hdc_2_left-hdc_2y_offset) .or.
     >      ys.lt.(hdc_2_right-hdc_2y_offset) ) then
	  shmsSTOP_dc2 = shmsSTOP_dc2 + 1
	  if (use_det_cut) then
	     stop_id = 19
	     goto 500
	  endif
	endif
        spec(41)=xs
        spec(42)=ys
	radw = hdc_cath_thick/hdc_cath_radlen
	if(ms_flag) call musc(m2,p,radw,dydzs,dxdzs)

C at last cathode foil of second drift chamber set, drift to the 1st hodoscope

	drift = hscin_1x_zpos - hdc_2_zpos - 0.5*hdc_nr_plan
     > *hdc_del_plane
	radw = drift/hair_radlen
	call project(xs,ys,drift,decay_flag,dflag,m2,p,pathlen)
	if(ms_flag) call musc_ext(m2,p,radw,drift,dydzs,dxdzs,ys,xs)
	if (ys.gt.(hscin_1x_left+hscin_1y_offset) .or.
     >      ys.lt.(hscin_1x_right+hscin_1y_offset)) then
	  shmsSTOP_s1 = shmsSTOP_s1 + 1
	  if (use_det_cut) then
	     stop_id=20
	     goto 500
	  endif
	endif
        spec(44)=ys
	radw = hscin_1x_thick/hscin_radlen
	if(ms_flag) call musc(m2,p,radw,dydzs,dxdzs)
	drift = hscin_1y_zpos - hscin_1x_zpos
	radw = drift/hair_radlen
	call project(xs,ys,drift,decay_flag,dflag,m2,p,pathlen)
	if(ms_flag) call musc_ext(m2,p,radw,drift,dydzs,dxdzs,ys,xs)
	if (xs.gt.(hscin_1y_bot+hscin_1x_offset) .or.
     >      xs.lt.(hscin_1y_top+hscin_1x_offset)) then
	  shmsSTOP_s1 = shmsSTOP_s1 + 1
	  if (use_det_cut) then
	     stop_id=21
	     goto 500
	  endif
	endif
        spec(43)=xs
 	radw = hscin_1y_thick/hscin_radlen
	if(ms_flag) call musc(m2,p,radw,dydzs,dxdzs)

C finished first hodoscope, drift to the second cherenkov

*	write (6,*) 'made it to the second cherenkov in the hut'
	drift = hcer_2_zentrance - hscin_1y_zpos
	radw = drift/hair_radlen
	call project(xs,ys,drift,decay_flag,dflag,m2,p,pathlen)
	if(ms_flag) call musc_ext(m2,p,radw,drift,dydzs,dxdzs,ys,xs)

	radw = hcer_2_entr_thick/hcer_2_entr_radlen
	if(ms_flag) call musc(m2,p,radw,dydzs,dxdzs)

	drift = hcer_2_zmirror - hcer_2_zentrance
	radw = drift/hcer_2_radlen
	call project(xs,ys,drift,decay_flag,dflag,m2,p,pathlen)
	if(ms_flag) call musc_ext(m2,p,radw,drift,dydzs,dxdzs,ys,xs)

	radw = hcer_mir_thick/hcer_mir_radlen

	if(ms_flag) call musc(m2,p,radw,dydzs,dxdzs)

	drift = hcer_2_zexit - hcer_2_zmirror
	radw = drift/hcer_2_radlen
	call project(xs,ys,drift,decay_flag,dflag,m2,p,pathlen)
	if(ms_flag) call musc_ext(m2,p,radw,drift,dydzs,dxdzs,ys,xs)

	radw = hcer_2_exit_thick/hcer_2_exit_radlen
	if(ms_flag) call musc(m2,p,radw,dydzs,dxdzs)

C drift to 2nd hodoscope

	drift = hscin_2x_zpos - hcer_2_zexit
	radw = drift/hair_radlen
	call project(xs,ys,drift,decay_flag,dflag,m2,p,pathlen)
	if(ms_flag) call musc_ext(m2,p,radw,drift,dydzs,dxdzs,ys,xs)
	if (ys.gt.(hscin_2x_left+hscin_2y_offset) .or.
     >      ys.lt.(hscin_2x_right+hscin_2y_offset)) then
	  shmsSTOP_s3 = shmsSTOP_s3 + 1
	  if (use_det_cut) then
	     stop_id = 22
	     goto 500
	  endif
	endif
        spec(46)=ys
	radw = hscin_2x_thick/hscin_radlen
	if(ms_flag) call musc(m2,p,radw,dydzs,dxdzs)
	drift = hscin_2y_zpos - hscin_2x_zpos
	radw = drift/hair_radlen
	call project(xs,ys,drift,decay_flag,dflag,m2,p,pathlen)
	if(ms_flag) call musc_ext(m2,p,radw,drift,dydzs,dxdzs,ys,xs)
	if (xs.gt.(hscin_2y_bot+hscin_2x_offset) .or.
     >      xs.lt.(hscin_2y_top+hscin_2x_offset)) then
	  shmsSTOP_s2 = shmsSTOP_s2 + 1
	  if (use_det_cut) then
	     stop_id=23
	     goto 500
	  endif
	endif
        spec(45)=xs
	radw = hscin_2y_thick/hscin_radlen
	if(ms_flag) call musc(m2,p,radw,dydzs,dxdzs)

C Don't need to drift to calorimeter unless it's required in your trigger.
C Note that even with the standard PID trigger, the calorimeter is NOT
C required, since the trigger needs either the cerenkov OR the calorimeter.
C There is a seperate fiducial cut needed if you require the calorimeter
C in you analysis.  That cut is applied AFTER fitting the track (see below).

	drift = hcal_4ta_zpos - hscin_2y_zpos
	radw = drift/hair_radlen
	call project(xs,ys,drift,decay_flag,dflag,m2,p,pathlen)
	if(ms_flag) call musc_ext(m2,p,radw,drift,dydzs,dxdzs,ys,xs)
	if (ys.gt.hcal_left .or. ys.lt.hcal_right .or.
     >	   xs.gt.hcal_bottom .or. xs.lt.hcal_top) then
	  shmsSTOP_cal = shmsSTOP_cal + 1
	  if (use_det_cut) then
	     stop_id=24
	     goto 500
	  endif
	endif
        spec(47)=xs
        spec(48)=ys




C and fit track to give new focal plane values, use LFIT from GENLIB

	do jchamber=1,hdc_nr_cham
	  npl_off = (jchamber-1)*hdc_nr_plan
	  do iplane=1,hdc_nr_plan
	    if (jchamber.eq.1) zdc(npl_off+iplane) = hdc_1_zpos +
     >          (iplane-0.5-0.5*hdc_nr_plan)*hdc_del_plane
	    if (jchamber.eq.2) zdc(npl_off+iplane) = hdc_2_zpos +
     >          (iplane-0.5-0.5*hdc_nr_plan)*hdc_del_plane
	  enddo
	enddo
	call lfit(zdc,xdc,12,0,dx,x0,badf)
	call lfit(zdc,ydc,12,0,dy,y0,badf)


	x_fp = x0
	y_fp = y0
	dx_fp = dx
	dy_fp = dy

C If you use a calorimeter cut in your analysis, the engine applied a
C a fiducial cut at the calorimeter.  This is based on the position of the
C TRACK at the calorimeter, not the real position of the event.  Go to the
C back of the calorimeter since engine uses a FID cut at the back.
C The standard fiducial cut is 5 cm from the edges of the block.

*	write (6,*) 'at the shower counter in the hut'
	xcal = x_fp + dx_fp * hcal_4ta_zpos
	ycal = y_fp + dy_fp * hcal_4ta_zpos
	if (ycal.gt.(hcal_left-5.0) .or. ycal.lt.(hcal_right+5.0) .or.
     >	   xcal.gt.(hcal_bottom-5.0) .or. xcal.lt.(hcal_top+5.0)) then
	  shmsSTOP_cal = shmsSTOP_cal + 1
	  if (use_det_cut) then
	     stop_id=25
	     goto 500
	  endif
	endif
        spec(49)=xs
        spec(50)=ys

	ok_hut = .true.

C We are done with this event, whether GOOD or BAD.

500	continue

C ALL done!
	close (unit=chan)

	return
	end