*file member=alt_eca_calib_channel library=snoman language=fortran
*file date=6:Oct:2000
<<< subroutine alt_eca_calib_channel( ccc, cell,
+ q_lx, q_hl, q_hs, tim, mask, mode )
* Apply ECA calibration constants to a given channel
* Contact: J.Cameron (Oxford).
* Parameters:-
* ==========
* ccc in Card/Crate/Channel
* or -(Card/Crate/Channel+1) to uncalibrate
* cell in Cell number
* q_lx in Uncalibrated low gain charge
* out Calibrated low gain charge
* q_hl in Uncalibrated high gain long charge
* out Calibrated high gain long charge
* q_hs in Uncalibrated low gain long charge
* out Calibrated low gain long charge
* tim in Uncalibrated time
* out Calibrated time
* 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 eg 13
* First digit- Charge
* 0 counts above pedastel
* 1 counts above intercept
* 2 linear charge correction
* 3 Old ECA - quadratic charge correction
* New ECA - linear charge correction
* 4 counts above pedastel for PCA
* Second digit- Time
* 0 counts above pedastel
* 1 counts above intercept
* 2 Old ECA - linear time correction
* New ECA - full ECA time correction
* 3 full ECA time correction
* 4 full ECA time correction for PCA
* Note: q_lx, q_hl, q_hs, ti must be reals on input!
* Common Block Access:-
* ===================
* (ignoring internal and environmental access)
* /CAL_CONST0/ in/out *.
* /CAL_CONST1/ in/out *.
* /MT/ in/out Banks: TCAL, Q1SL, Q1AV, Q2SL, Q2AV,
* Q3SL, Q3AV, TMSL, TMAV
* Q1SQ, Q2SQ, Q3SQ, TMSQ,
* Q1FL, Q2FL, Q3FL, TMFL,
* Q1SI, Q2SI, Q3SI, TMSI,
* Q1QC, Q2QC, Q3QC, TMQC,
* TMCC
* Specification:-
* =============
* o On first entry, load titles control bank TCAL.
* o Load titles banks for ECA and PCA calibration, selecting reference
* version (bank number 1000001) if dictated by TCAL.
* o On each entry, calibrate data as selected by mask using the calibration
* mode flags from the TCAL bank.
* Program Notes:-
* =============
* This is a utility that can be used from any software unit. However,
* it uses calibration mode information from the control bank of CAL (TCAL).
* Revision History:-
* ================
* 3.02 N. West First version extracted from cal_calibration_ini
* and cal_calibration_pmt.
* D. Wark Change sign of charge for linear calibrations.
* D. Wark Add mode for cubic T's and ped. corr. raw ADC Q's.
* D. Wark Trap zero slopes.
* M. Thorman Add another mode for linear T, ped corrected Q. For
* linear T, use correct sign of slope and include offset.
* S. Biller Re-dubbed as an alternate application of calibration
* constants using files generated by older version of ECA
* S. Biller TCAL, QTCA and CST0 now loaded previously
* S. Biller Algorithm made more compact
* and a negative CCC now results in an uncalibration
* N. West Use -(CCC+1) to signal uncalibration to allow for ccc=0
* Add support for reference constants.
* J. Cameron Allow a more flexible numbering scheme in the TCAL bank.
* J. Cameron Hardwire the uncalibration to go from counts above
* pedastel to ADC counts for charges and from ECA ns
* to ADC counts for time
* J. Cameron Add mode to allow overriding the TCAL bank
* N. Tagg Bug fix, symptoms seen on linux systems.
* J. Cameron Remove hardwired uncalibration mode.
* Remove nint()s from 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)
IMPLICIT NONE
INCLUDE 'id_errors.inc'
INCLUDE 'mt_mnemonics.inc'
INCLUDE 'su_mnemonics.inc'
INCLUDE 'cal_com.inc'
INCLUDE 'cal_const0.inc'
INCLUDE 'cal_const1.inc'
INCLUDE 'mt.inc'
INCLUDE 'q_t_calib.inc'
INCLUDE 'zunit.inc'
real c_fit(4)
common /bcubefit/ c_fit
* Argument Declarations:-
* =====================
integer ccc, cell, mask, mode
real q_lx, q_hl, q_hs, tim
* Local Variable Declarations:-
* ===========================
integer loc, loc_lcn,map_ccc_lcn,n,
+ lnkfl,lnksq,lnkav,lnksi,lnksl,lnkqc,
+ i_bkno
integer qcal_mode,tcal_mode
logical first,btest,cal,uncal,requested_banks(10)
real aq, bq, cq, tim_org,eca_t_fn_dig,xx
save first,i_bkno
data first/ .true. /
data requested_banks/ .false. , .false. , .false. ,
+ .false. , .false. , .false. ,
+ .false. , .false. , .false. ,
+ .false. /
** On every entry, calibrate data as required.
cal=.true.
uncal=.false. ! See whether calibration
if(ccc.lt.0) then ! or uncalibration
cal=.false. ! is requested
uncal=.true.
ccc=-ccc-1
endif
** On first entry, load required titles banks
if ( first ) then
first = .false.
* Select standard or reference set.
i_bkno = 1
if ( ICONS(LDTCAL+KTCAL_REF_CONSTS) .eq. 1 ) i_bkno = 1000001
* * Translate the modes in TCAL bank
* * into the following two numbers:
c tcal_mode setting
c 0 counts above pedastel
c 1 counts above intercept
c 2 linear time correction (old ECA)
c 3 full ECA time correction
c qcal_mode setting
c 0 counts above pedastel
c 1 counts above intercept
c 2 linear charge correction
c 3 quadratic charge correction (old ECA)
* Get the mode in the TCAL bank
call cal_mode(qcal_mode,tcal_mode)
* provide the right charge and time for the pca
if (qcal_mode.eq.4) qcal_mode=0
if (tcal_mode.eq.4) tcal_mode=3
*** Check to see if the calibration mode is in the right limits
if (qcal_mode.lt.0 .or. qcal_mode.gt.3 .or.
+ tcal_mode.lt.0 .or. tcal_mode.gt.3 ) then
if (qcal_mode.lt.0) qcal_mode=0
if (qcal_mode.gt.3) qcal_mode=3
if (tcal_mode.lt.0) tcal_mode=0
if (tcal_mode.gt.3) tcal_mode=3
call add_warning(' CAL: The calibration requested in the'//
+ ' TCAL bank is not provided by the old ECA')
endif
endif
* Set the calibration mode according to mode request
if (mode.eq.KCAL_TCAL) then
call cal_mode(qcal_mode,tcal_mode)
* provide the right charge and time for the pca
if (qcal_mode.eq.4) qcal_mode=0
if (tcal_mode.eq.4) tcal_mode=3
else
qcal_mode=mode/10
tcal_mode=mode-qcal_mode*10
*** Check to see if the calibration mode is in the right limits
if (qcal_mode.lt.0 .or. qcal_mode.gt.3 .or.
+ tcal_mode.lt.0 .or. tcal_mode.gt.3 ) then
if (qcal_mode.lt.0) qcal_mode=0
if (qcal_mode.gt.3) qcal_mode=3
if (tcal_mode.lt.0) tcal_mode=0
if (tcal_mode.gt.3) tcal_mode=3
call add_warning(' CAL: The calibration requested in the'//
+ ' TCAL bank is not provided by the old ECA')
endif
endif
c Get charge pedastel and quality flag
if (qcal_mode.eq.0.and.(.not.requested_banks(1))) then
requested_banks(1)=.false.
LAQ1AV(8) = 0
CALL MT_REQUEST_TITLES( 'Q1AV', i_bkno, KMTT_COMPULSORY,
+ LAQ1AV , KSU_UCL )
LAQ2AV(8) = 0
CALL MT_REQUEST_TITLES( 'Q2AV', i_bkno, KMTT_COMPULSORY,
+ LAQ2AV , KSU_UCL )
LAQ3AV(8) = 0
CALL MT_REQUEST_TITLES( 'Q3AV', i_bkno, KMTT_COMPULSORY,
+ LAQ3AV , KSU_UCL )
LAQ1FL(8) = 0
CALL MT_REQUEST_TITLES( 'Q1FL', i_bkno, KMTT_COMPULSORY,
+ LAQ1FL , KSU_UCL )
LAQ2FL(8) = 0
CALL MT_REQUEST_TITLES( 'Q2FL', i_bkno, KMTT_COMPULSORY,
+ LAQ2FL , KSU_UCL )
LAQ3FL(8) = 0
CALL MT_REQUEST_TITLES( 'Q3FL', i_bkno, KMTT_COMPULSORY,
+ LAQ3FL , KSU_UCL )
endif
c Get charge slope intercepts
if (qcal_mode.ge.1.and.(.not.requested_banks(2))) then
requested_banks(2)=.false.
LAQ1SI(8) = 0
CALL MT_REQUEST_TITLES( 'Q1SI', i_bkno, KMTT_COMPULSORY,
+ LAQ1SI , KSU_UCL )
LAQ2SI(8) = 0
CALL MT_REQUEST_TITLES( 'Q2SI', i_bkno, KMTT_COMPULSORY,
+ LAQ2SI , KSU_UCL )
LAQ3SI(8) = 0
CALL MT_REQUEST_TITLES( 'Q3SI', i_bkno, KMTT_COMPULSORY,
+ LAQ3SI , KSU_UCL )
endif
c Get charge slopes
if (qcal_mode.ge.2.and.(.not.requested_banks(3))) then
requested_banks(3)=.false.
LAQ1SL(8) = 0
CALL MT_REQUEST_TITLES( 'Q1SL', i_bkno, KMTT_COMPULSORY,
+ LAQ1SL , KSU_UCL )
LAQ2SL(8) = 0
CALL MT_REQUEST_TITLES( 'Q2SL', i_bkno, KMTT_COMPULSORY,
+ LAQ2SL , KSU_UCL )
LAQ3SL(8) = 0
CALL MT_REQUEST_TITLES( 'Q3SL', i_bkno, KMTT_COMPULSORY,
+ LAQ3SL , KSU_UCL )
endif
c Get quadratic charge terms
if (qcal_mode.eq.3.and.(.not.requested_banks(4))) then
requested_banks(4)=.false.
LAQ1QC(8) = 0
CALL MT_REQUEST_TITLES( 'Q1QC', i_bkno, KMTT_COMPULSORY,
+ LAQ1QC , KSU_UCL )
LAQ2QC(8) = 0
CALL MT_REQUEST_TITLES( 'Q2QC', i_bkno, KMTT_COMPULSORY,
+ LAQ2QC , KSU_UCL )
LAQ3SQ(8) = 0
CALL MT_REQUEST_TITLES( 'Q3QC', i_bkno, KMTT_COMPULSORY,
+ LAQ3QC , KSU_UCL )
endif
c Get charge quality integer
if (qcal_mode.ge.1.and.(.not.requested_banks(5))) then
requested_banks(5)=.false.
LAQ1SQ(8) = 0
CALL MT_REQUEST_TITLES( 'Q1SQ', i_bkno, KMTT_COMPULSORY,
+ LAQ1SQ , KSU_UCL )
LAQ2SQ(8) = 0
CALL MT_REQUEST_TITLES( 'Q2SQ', i_bkno, KMTT_COMPULSORY,
+ LAQ2SQ , KSU_UCL )
LAQ3SQ(8) = 0
CALL MT_REQUEST_TITLES( 'Q3SQ', i_bkno, KMTT_COMPULSORY,
+ LAQ3SQ , KSU_UCL )
endif
c Get time pedastel and quality flag
if (tcal_mode.eq.0.and.(.not.requested_banks(6))) then
requested_banks(6)=.false.
LATMAV(8) = 0
CALL MT_REQUEST_TITLES( 'TMAV', i_bkno, KMTT_COMPULSORY,
+ LATMAV , KSU_UCL )
LATMFL(8) = 0
CALL MT_REQUEST_TITLES( 'TMFL', i_bkno, KMTT_COMPULSORY,
+ LATMFL , KSU_UCL )
endif
c Get time intercept
if (tcal_mode.ge.1.and.(.not.requested_banks(7))) then
requested_banks(7)=.false.
LATMSI(8) = 0
CALL MT_REQUEST_TITLES( 'TMSI', i_bkno, KMTT_COMPULSORY,
+ LATMSI , KSU_UCL )
endif
c Get linear time term
if (tcal_mode.ge.2.and.(.not.requested_banks(8))) then
requested_banks(8)=.false.
LATMSL(8) = 0
CALL MT_REQUEST_TITLES( 'TMSL', i_bkno, KMTT_COMPULSORY,
+ LATMSL , KSU_UCL )
endif
c Get quadratic and cubic time terms
if (tcal_mode.eq.3.and.(.not.requested_banks(9))) then
requested_banks(9)=.false.
LATMQC(8) = 0
CALL MT_REQUEST_TITLES( 'TMQC', i_bkno, KMTT_COMPULSORY,
+ LATMQC , KSU_UCL )
LATMCC(8) = 0
CALL MT_REQUEST_TITLES( 'TMCC', i_bkno, KMTT_COMPULSORY,
+ LATMCC , KSU_UCL )
endif
c Get time quality integer
if (tcal_mode.ge.1.and.(.not.requested_banks(10))) then
requested_banks(10)=.false.
LATMSQ(8) = 0
CALL MT_REQUEST_TITLES( 'TMSQ', i_bkno, KMTT_COMPULSORY,
+ LATMSQ , KSU_UCL )
endif
* Get index into banks by converting to logical circuit no and adding
* one (as lcn starts at zero.
loc_lcn = map_ccc_lcn(ccc)
* Change to allow for 16 cells
loc = 16*(loc_lcn) + cell + 1
do N=1,3
if(.not.btest(mask,N-1)) goto 100
if(N.eq.1) then ! Calibrate low gain charge
lnkfl=ldq3fl
lnksq=ldq3sq
lnkav=LDQ3AV
lnksi=LDQ3SI
lnksl=LDQ3SL
lnkqc=LDQ3QC
XX=Q_LX
elseif(N.eq.2) then ! Calibrate high gain long charge
lnkfl=ldq2fl
lnksq=ldq2sq
lnkav=LDQ2AV
lnksi=LDQ2SI
lnksl=LDQ2SL
lnkqc=LDQ2QC
XX=Q_HL
elseif(N.eq.3) then ! Calibrate high gain short charge
lnkfl=ldq1fl ! pedastel quality flag
lnksq=ldq1sq ! slope quality flag
lnkav=LDQ1AV ! pedastel value
lnksi=LDQ1SI ! intercept
lnksl=LDQ1SL ! linear term
lnkqc=LDQ1QC ! quadratic term
XX=Q_HS
endif
if(uncal.and.XX.eq.-9999.) goto 100
if( (qcal_mode.eq.0 .and. icons(lnkfl+loc).ne.0) .or.
+ icons(lnksq+loc).ne.0 ) then
XX= -9999.
call ztell(IDZT_CAL_MISSING_CAL,0)
else
if(cal) then
if(qcal_mode.eq.0) then
XX=XX-RCONS(LNKAV+LOC)
else
XX=XX-RCONS(LNKSI+LOC)
endif
endif
if(qcal_mode.eq.2) then
if(abs(RCONS(LNKSL+LOC)).gt.0.1) then
if(cal) XX = XX/RCONS(LNKSL+LOC)
if(uncal) XX = XX*RCONS(LNKSL+LOC)
else
XX = -9999.
call ztell(idzt_cal_zero_slope,0)
endif
else if(qcal_mode.eq.3) then
if(abs(RCONS(LNKSL+LOC)).lt.0.1) then
XX = -9999.
call ztell(idzt_cal_zero_slope,0)
else
if(cal) then
cq = -XX
bq = RCONS(LNKSL+LOC)
aq = RCONS(LNKQC+LOC)
XX = bq**2 - 4.*aq*cq
if(XX .lt. 0.) then
XX = 0.
else
XX = 2*cq/(-bq - sqrt(XX))
endif
elseif(uncal) then
XX=RCONS(LNKSL+LOC)*XX+RCONS(LNKQC+LOC)*XX*XX
endif
endif
endif
if(uncal) then
if(qcal_mode.eq.0) then
XX=XX+RCONS(LNKAV+LOC)
else
XX=XX+RCONS(LNKSI+LOC)
endif
endif
endif
if(N.eq.1) Q_LX=XX
if(N.eq.2) Q_HL=XX
if(N.eq.3) Q_HS=XX
100 continue
end do
** Calibrate time
if ( btest( mask, 3 ) ) then
tim_org = tim
if(uncal.and.tim.eq.-9999.) return
if(uncal) tim=rcons(ldtcal+ktcal_time_offset)-tim
if((tcal_mode.eq..0.and.icons(ldtmfl+loc).ne.0) .or.
+ icons(ldtmsq+loc).ne.0) then
TIM = -9999.
call ztell(IDZT_CAL_MISSING_CAL,0)
else
if(tcal_mode.eq.0) then
if(cal) TIM = TIM-RCONS(LDTMAV+LOC)
c_fit(1) = RCONS(LDTMAV+LOC)
else
if(cal) TIM = TIM-RCONS(LDTMSI+LOC)
c_fit(1) = RCONS(LDTMSI+LOC)
endif
if(tcal_mode.ge.2) then
if(abs(RCONS(LDTMSL+LOC)).gt.1.) then
if(cal) TIM = TIM/RCONS(LDTMSL+LOC)
if(uncal) TIM = TIM*RCONS(LDTMSL+LOC) + c_fit(1)
else
TIM = -9999.
call ztell(idzt_cal_zero_slope,0)
endif
else if(tcal_mode.ge.3) then
c_fit(2) = RCONS(LDTMSL+LOC)
c_fit(3) = RCONS(LDTMQC+LOC)
c_fit(4) = RCONS(LDTMCC+LOC)
if(cal) TIM = ECA_T_FN_DIG(tim_org)
if(uncal) TIM=c_fit(1)+c_fit(2)*TIM+
+ c_fit(3)*TIM*TIM+c_fit(4)*TIM*TIM*TIM
endif
if(cal.and.TIM.gt.-9998) then
if (tcal_mode.ge.2) then
TIM = rcons(ldtcal+ktcal_time_offset) - TIM
else
TIM = -TIM
endif
endif
endif
endif
RETURN
END
*ENDFILE MEMBER=ALT_ECA_CALIB_CHANNEL