*FILE MEMBER=ALT_PCA_CALIB_CHANNEL LIBRARY=SNOMAN LANGUAGE=FORTRAN77
*FILE DATE=6:Oct:2000
<<< SUBROUTINE alt_pca_calib_channel(ccc,cell,q_ihs,
+ q_lx,q_hl,q_hs,tim,mask,mode)
IMPLICIT NONE
* ALT_PCA_CALIB_CHANNEL: Make the walk correction
* using the old pca constants
* Contact: J.Cameron (Oxford).
* Revision History:-
* ================
* 3.02 K. Frame updated to use group velocity (assumes 500 nm)
* Parameters:-
* ==========
* ccc in Card/Crate/Channel (if negative then just load banks)
* cell in cell
* q_ihs in Uncalibrated QHS charge
* q_lx in value with ECA applied
* out value with ECA + PCA applied.
* q_hl in value with ECA applied
* out value with ECA + PCA applied.
* q_hs in value with ECA applied
* out value with ECA + PCA applied.
* tim in value with ECA applied
* out value with ECA + PCA applied.
* mask in Set of 1-bit flags. Meaning if set:-
* B0 Calibrate q_lx
* B1 Calibrate q_hl
* B2 Calibrate q_hs
* B3 Calibrate tim
* mode in KCAL_TCAL Calibrate/Uncalibrate as set in
* the TCAL bank ( KCAL_TCAL is set
* in cal_com.inc )
* or a two digit code
* First digit- Charge
* 0-3 leave alone
* 4 convert counts above pedastel for pe
* Second digit- Time
* 0-3 leave alone
* 4 remove walk from full ECA time
* Common Block Access:-
* ===================
* (ignoring internal and environmental access)
* /CAL_WALK_CAP/ out stores vairable qhs_cap for use in PCA
* /CAL_CONST1/ in/out *.
* /MT/ in/out Banks: WALK GAIN
* Specification:-
* =============
* calibrate:
* Convert charge from ADC counts above pedastel (CAP) to pe
* Remove the walk from ECA time using the charge in CAP
* uncalibrate:
* Convert charge in pe back to CAP
* Add a walk to a time in ns
* Revision History:-
* ================
* 3.02 J. Cameron, First version.
* C. Okada Change lcn -> ccc to fix bug addressing RGE_PMT array.
* J. Cameron Update for new walk and gain formats
* Add mode, define the speed of light.
* bug fix.
* Remove hardwired uncalibration.
* 4.01 J. Cameron Get calibration mode from subroutine cal_mode.
* Removed local modes.
* Change -999 to KCAL_MODE (defined in cal_com.inc)
* 4.02 N. West Move up definition of loc_lcn (was used before
* being set for GAIN methods 1 & 3). For completeness
* set tube_num at same time.
* Argument Declarations:-
* =====================
integer ccc,cell,mode,mask
real q_ihs,q_lx,q_hl,q_hs,tim
include 'constants.inc'
include 'id_particles.inc'
include 'id_media.inc'
INCLUDE 'cal_com.inc'
INCLUDE 'cal_const1.inc'
INCLUDE 'q_t_calib.inc'
include 'ge_mnemonics.inc'
include 'ge_pmts.inc'
INCLUDE 'id_errors.inc'
include 'su_mnemonics.inc'
include 'mt_mnemonics.inc'
INCLUDE 'mt.inc'
include 'zunit.inc'
* Local Variable Declarations:-
* ===========================
* energy for 500 nm wavelength photon in MeV
real e500nm
parameter(e500nm = 2.47970818738E-6)
integer tube_num,iretc
integer header_length,loc_w,loc_g,i_bkoff
integer qcal_mode,tcal_mode
integer loc_lcn,map_ccc_lcn,map_ccc_tube
integer walk_method,gain_method
real q_walk,exp_fac,distance_pmt,cave,cd,ch,c_grp
logical first,cal,uncal,requested_gain,requested_walk
data first/.true./
data requested_gain/.false./
data requested_walk/.false./
save first,cave
save requested_gain,requested_walk
* ROUTINE:-
* =========
cal=.true.
uncal=.false. ! See whether calibration
if(ccc.lt.0) then ! or uncalibration
cal=.false. ! is requested
uncal=.true.
ccc=-ccc-1
endif
if (first) then
first=.false.
cd = c_grp(E500nm,0,100*idmd2o,iretc)
ch = c_grp(E500nm,0,100*idmh2o,iretc)
cave=(cd*6.+ch*2.4)/8.4
* Select standard or reference set.
i_bkoff = 0
if (ICONS(LDTCAL+KTCAL_REF_CONSTS).eq.1) i_bkoff=1000000
LAQTCA(8) = 0
CALL MT_REQUEST_TITLES( 'QTCA', i_bkoff+1, KMTT_COMPULSORY,
+ LAQTCA , KSU_UCL )
endif
*** Now for the calibration
* Set the calibration mode according to mode request
if (mode.eq.KCAL_TCAL) then
call cal_mode(qcal_mode,tcal_mode)
else
qcal_mode=mode/10
tcal_mode=mode-qcal_mode*10
endif
if (qcal_mode.eq.4.and.(.not.requested_gain)) then
requested_gain=.true.
c load old format of gain bank
LAGAIN(8) = 0
CALL MT_REQUEST_TITLES( 'GAIN', i_bkoff+1,
+ KMTT_OPTIONAL , LAGAIN , KSU_UCL )
if (ldgain.eq.0)
+ call add_warning('CAL: No valid gain banks found')
endif
if (tcal_mode.eq.4.and.(.not.requested_walk)) then
requested_walk=.true.
c load old format of walk bank
LAWALK(8) = 0
CALL MT_REQUEST_TITLES( 'WALK',i_bkoff+1,
+ KMTT_OPTIONAL , LAWALK , KSU_UCL )
if (ldwalk.eq.0)
+ call add_warning('CAL: No valid walk banks found')
endif
if (mask.eq.0) RETURN
** Do the calibration
gain_method=icons(ldtcal+KTCAL_GAIN_TYPE)
walk_method=icons(ldtcal+KTCAL_WALK_TYPE)
loc_lcn = map_ccc_lcn(ccc)
tube_num = map_ccc_tube(ccc)
if (tcal_mode.eq.4.and.btest(mask,3)) then
if (walk_method.eq.1) then
q_walk=q_ihs
call cal_eca_calib_channel(ccc,cell,0,0,q_walk,0,4,3)
elseif (walk_method.eq.3) then
q_walk=q_ihs
call cal_eca_calib_channel(ccc,cell,0,0,q_walk,0,4,0)
endif
endif
if (qcal_mode.eq.4) then
if (gain_method.eq.1) then
C GAIN METHOD 1
header_length=0
loc_g = header_length + 2*loc_lcn
if (rcons(ldgain+loc_g+1).gt.0.and.
& rcons(ldgain+loc_g+2).eq.0.) then
if (cal) then
if (btest(mask,0)) q_lx = q_lx/rcons(ldgain+loc_g+1)
if (btest(mask,1)) q_hl = q_hl/rcons(ldgain+loc_g+1)
if (btest(mask,2)) q_hs = q_hs/rcons(ldgain+loc_g+1)
else
if (btest(mask,0)) q_lx = q_lx*rcons(ldgain+loc_g+1)
if (btest(mask,1)) q_hl = q_hl*rcons(ldgain+loc_g+1)
if (btest(mask,2)) q_hs = q_hs*rcons(ldgain+loc_g+1)
endif
else
if (btest(mask,0)) q_lx = -9999.
if (btest(mask,1)) q_hl = -9999.
if (btest(mask,2)) q_hs = -9999.
endif
endif
if (gain_method.eq.3) then
C GAIN METHOD 3
header_length=0
loc_g = header_length + 2*loc_lcn
if (rcons(ldgain+loc_g+1).gt.0.and.
& rcons(ldgain+loc_g+2).eq.0.) then
if (cal) then
if (btest(mask,0)) q_lx = q_lx/rcons(ldgain+loc_g+1)
if (btest(mask,1)) q_hl = q_hl/rcons(ldgain+loc_g+1)
if (btest(mask,2)) q_hs = q_hs/rcons(ldgain+loc_g+1)
else
if (btest(mask,0)) q_lx = q_lx*rcons(ldgain+loc_g+1)
if (btest(mask,1)) q_hl = q_hl*rcons(ldgain+loc_g+1)
if (btest(mask,2)) q_hs = q_hs*rcons(ldgain+loc_g+1)
endif
else
if (btest(mask,0)) q_lx = -9999.
if (btest(mask,1)) q_hl = -9999.
if (btest(mask,2)) q_hs = -9999.
endif
endif
endif
if (tcal_mode.eq.4.and.btest(mask,3)) then
if (walk_method.eq.1) then
C WALK METHOD 1
header_length=8
loc_w = header_length + 8*loc_lcn
* quality word 0, walk param non-zero
if(rcons(ldwalk+LOC_w+8).eq.0.and.
& rcons(ldwalk+LOC_w+1).ne.0.and.
& q_walk.gt.-9998.) then
if ( q_walk .LT. 0.0 ) q_walk=0.2 ! fudge for flashers
exp_fac=-rcons(ldwalk+LOC_w+3)*
& ((q_walk/2.0)-rcons(ldwalk+LOC_w+2))
distance_pmt =
+ ((rge_pmt_xyz(1, tube_num) - rcons(ldwalk + 1))**2.0
+ + (rge_pmt_xyz(2, tube_num) - rcons(ldwalk + 2))**2.0
+ + (rge_pmt_xyz(3, tube_num) - rcons(ldwalk + 3))**2.0
+ )**0.5
c NB The following code assumes the laserball position is in the header
TIM=TIM-rcons(ldwalk+loc_w+1) - exp(exp_fac) +
& distance_pmt/cave + 100.0
else
TIM=-9999.
endif
endif
if (walk_method.eq.3) then
C WALK METHOD 3
header_length=8
loc_w = header_length + 8*loc_lcn
* quality word 0, walk param non-zero
if(rcons(ldwalk+LOC_w+8).eq.0.and.
& rcons(ldwalk+LOC_w+1).ne.0.and.
& q_walk.gt.-9998.) then
if ( q_walk .LT. 0.0 ) q_walk=5 ! fudge for flashers
q_walk=(q_walk/20.)+1.
distance_pmt =
+ ((rge_pmt_xyz(1, tube_num) - rcons(ldwalk + 1))**2.0
+ + (rge_pmt_xyz(2, tube_num) - rcons(ldwalk + 2))**2.0
+ + (rge_pmt_xyz(3, tube_num) - rcons(ldwalk + 3))**2.0
+ )**0.5
c NB The following code assumes the laserball position is in the header
TIM=TIM -
& ( rcons(ldwalk+loc_w+1) +
& rcons(ldwalk+loc_w+2)/q_walk +
& rcons(ldwalk+loc_w+3)/q_walk**2 +
& rcons(ldwalk+loc_w+4)/q_walk**3 )
& + distance_pmt/cave + 100.0
else
TIM=-9999.
endif
endif
endif
RETURN
END
*ENDFILE MEMBER=ALT_PCA_CALIB_CHANNEL