*file member=anxx_tubes_ini library=snoman language=fortran77 date=08:Nov:2004
<<< subroutine anxx_tubes_ini(mode,iretc)
* ANX: ANXX Banks Processor. Determine bad channels.
* Contact: M. Huang, Texas.
* Parameters:-
* ==========
* mode in Initialisation mode. One of:-
* KSU_CONFIRM_NOT_DUMMY
* KSU_SET_CONTEXT (not supported)
* KSU_INITIALISE
* KSU_REINITIALISE
* iretc out return code:-
* > 0 error
* <= 0 o.k.
* Common Block Access:-
* ===================
* (ignoring internal and environmental access)
* /ANX_CONTROL_COM/ out *.
* /MT/ out Banks: TFPS.
* Specification:-
* =============
* Initalise entries in the ANX_CONTROL_COM common block and load the
* ANCT titles bank.
* Revision History:-
* ================
* 5.01 M. Huang First version.
* N. McCauley Add some minor bug fixes.
* N. mcCauley Add improved orphan check
implicit none
include 'fio_mnemonics.inc'
include 'su_mnemonics.inc'
include 'mt_mnemonics.inc'
include 'mt.inc'
include 'su_com.inc'
include 'anxx_data_com.inc'
include 'anxx_count_com.inc'
include 'anxx_cut_com.inc'
include 'zunit.inc'
include 'io.inc'
* Argument Declarations:-
* =====================
integer mode, iretc
*endheader
* Local Variable Declarations:-
* ===========================
logical test, fio_query, ianx_hbk_set
integer ipmt, ios, iperiod
character hbook_file*(kfio_mxc_file_name)
* =======================================================================
iretc = KSU_OK
if ( mode .eq. KSU_CONFIRM_NOT_DUMMY ) then
call set_mask( isu_ssm(1,KSU_ANX), KSU_UPK )
call set_mask( isu_ssm(1,KSU_ANX), KSU_CAL )
return
endif
* ... This procesor does not set a context .....
if ( mode .eq. KSU_SET_CONTEXT ) return
* ... first time initialization .....
if ( mode .eq. KSU_INITIALISE ) then
write(iqprnt,90004)
write(iqlog,90004)
* .... Load titles bank ANCT 1 at compulsory request level.
laanct(8) = 0
call mt_request_titles('ANCT',1,KMTT_COMPULSORY,laanct,KSU_ANX)
* ... inialize variales for counting .....
do ipmt = 0, npmt
tot_hits(ipmt) = 0.0
tac_count(ipmt) = 0.0
qhs_count(ipmt) = 0.0
qhl_count(ipmt) = 0.0
qlx_count(ipmt) = 0.0
tac_lo_count(ipmt) = 0.0
tac_hi_count(ipmt) = 0.0
qhs_lo_count(ipmt) = 0.0
qhs_hi_count(ipmt) = 0.0
qhl_lo_count(ipmt) = 0.0
qhl_hi_count(ipmt) = 0.0
qlx_lo_count(ipmt) = 0.0
qlx_hi_count(ipmt) = 0.0
gr_count(ipmt) = 0.0
gr_occ(ipmt) = 0.0
occ_count(ipmt) = 0.0
high_occ_count(ipmt) = 0.0
orphan_hit_count(ipmt) = 0.0
do iperiod = 1, nperiod+1
low_occ_count(ipmt,iperiod) = 0.0
end do
do iperiod = 1,nperiod_orphan
non_orphan_hit_count_period(ipmt,iperiod)=0
orphan_hit_count_period(ipmt,iperiod)=0
enddo
sync_clear_err(1,ipmt) = 0.0
sync_clear_err(2,ipmt) = 0.0
sync_clear_err(3,ipmt) = 0.0
cell_err(ipmt) = 0.0
cell_correct(ipmt) = 0.0
cell_flag(ipmt) = .false.
first_cell_call(ipmt) = .true.
end do
event_low_occ_count = 0.0
event_high_occ_count = 0.0
iperiod_orphan_max = -1
iperiod_orphan = -1
* ... initialize cuts for first-stage and second-stage selection ....
tac_lo = rcons(ldanct+KANX_TAC_LO)
tac_up = rcons(ldanct+KANX_TAC_UP)
qhs_lo = rcons(ldanct+KANX_QHS_LO)
qhs_up = rcons(ldanct+KANX_QHS_UP)
qhl_lo = rcons(ldanct+KANX_QHL_LO)
qhl_up = rcons(ldanct+KANX_QHL_UP)
qlx_lo = rcons(ldanct+KANX_QLX_LO)
qlx_up = rcons(ldanct+KANX_QLX_UP)
tac_cut = rcons(ldanct+KANX_TAC_CUT)
qhs_cut = rcons(ldanct+KANX_QHS_CUT)
qhl_cut = rcons(ldanct+KANX_QHL_CUT)
qlx_cut = rcons(ldanct+KANX_QLX_CUT)
tac_lo_cut = rcons(ldanct+KANX_TAC_LO_CUT)
tac_hi_cut = rcons(ldanct+KANX_TAC_HI_CUT)
qhs_lo_cut = rcons(ldanct+KANX_QHS_LO_CUT)
qhs_hi_cut = rcons(ldanct+KANX_QHS_HI_CUT)
qhl_lo_cut = rcons(ldanct+KANX_QHL_LO_CUT)
qhl_hi_cut = rcons(ldanct+KANX_QHL_HI_CUT)
qlx_lo_cut = rcons(ldanct+KANX_QLX_LO_CUT)
qlx_hi_cut = rcons(ldanct+KANX_QLX_HI_CUT)
gr_cut = rcons(ldanct+KANX_GR_CUT)
low_occ_cut = rcons(ldanct+KANX_LOW_OCC_CUT)
orphan_cut = rcons(ldanct+KANX_ORPHAN_CUT)
sync_fail_cut = rcons(ldanct+KANX_SYNC_FAIL_CUT)
cell_cut = rcons(ldanct+KANX_CELL_CUT)
high_occ_cut = rcons(ldanct+KANX_HIGH_OCC_CUT)
time_interval = rcons(ldanct+KANX_TIME_INTERVAL)
flag_old_tubes = icons(ldanct+KANX_FLAG_OLD)
* .... Open output files for ANXX banks ......
test = fio_query(KSU_ANX,2,'FIRST_FILE',file_name)
if (.not. test) then
data_type = icons(ldanct+KANX_DATA_TYPE1)
if (data_type .eq. 1) then
file_name = 'anxx_pca.dat'
else if (data_type .eq. 2) then
file_name = 'anxx_n16.dat'
else if (data_type .eq. 3) then
file_name = 'anxx_neutrino.dat'
endif
endif
ianx_hbk_set = fio_query(KSU_ANX,1,'FIRST_FILE',hbook_file)
if (ianx_hbk_set) then
data_type = icons(ldanct+KANX_DATA_TYPE1)
frac1 = -0.5
if (data_type .eq. 1) then
frac2 = 500.5
else if (data_type .eq. 2) then
frac2 = 100.5
else if (data_type .eq. 3) then
frac2 = 99.5
endif
num_bin_low_occ = int(frac2-frac1)
call anxx_ini_ntp(hbook_file)
else
hbook_file = 'not requested'
write(iqprnt,90001) hbook_file
write(iqlog, 90001) hbook_file
endif
open ( err = 110,
+ file = file_name ,
+ form = 'formatted',
+ iostat = ios,
+ status = 'unknown',
+ unit = lun_anx_txt )
110 if (ios .ne. 0) then
write(iqprnt,90003) file_name, ios
write(iqlog, 90003) file_name, ios
call zend
endif
return
endif
if ( mode .eq. KSU_REINITIALISE ) then
write (iqlog,90002)
return
endif
90001 format('ANXX bank hbook file ',a)
90002 format(' ANX_INI: New ANXX bank received!')
90003 format(' Open error on file ',a,
+ ' IOSTAT = ',i10)
90004 format(' Initializing ANX ...')
return
end
*endfile member=anxx_tubes_ini