* * $Id; $ * * $Log: tpc_FADC_cluster.F,v $ * Revision 1.1 2004/05/28 16:10:11 dpp * -> NEW * -> time clustering of a FADC channel * * * #include "sys/CLEO_machine.h" #include "pilot.h" SUBROUTINE TPC_FADC_CLUSTER(ILCD,IADR,HOLD,DIAGNOSTIC) C....................................................................... C. C. TPC_FADC_CLUSTER - cluster the FADC ph bins C. supercede current hit structure with new hit structure C. C. COMMON : C. CALLS : C. CALLED : C. AUTHOR : D. Peterson C. C. VERSION : 1.00 C. CREATED : 27-Feb-2004 C. C....................................................................... #if defined(CLEO_TYPCHK) IMPLICIT NONE #endif SAVE #include "doit/duseq/tfconspa.inc" #include "doit/duseq/tfindpar.inc" C which includes C #include "cl3seq/cdgm3/cdgeompa.inc" C #include "doit/duseq/tfgeompa.inc" #include "doit/duseq/tfctlcde.inc" #include "doit/duseq/tfgeomcd.inc" #include "cl3seq/cdgm3/cdgeomcd.inc" #include "doit/duseq/cdscrtcd.inc" #include "doit/sfseq/sfextra.inc" #include "doit/duseq/runev.inc" #include "doit/duseq/tpccom.inc" INTEGER ILCD INTEGER IADR LOGICAL HOLD LOGICAL DIAGNOSTIC INTEGER ILTF INTEGER IWIR INTEGER IHIT,JHIT INTEGER IBIN LOGICAL HAVE_open_cluster LOGICAL CLOSE_the_cluster LOGICAL START_new_cluster REAL Pedistal REAL PulseHeight INTEGER FIRST_BIN REAL PH_high INTEGER BINScontribute INTEGER TAG_high REAL Z_NOW REAL Z_DIF REAL PH_HIT INTEGER TAG LOGICAL DUMPIT REAL ZTEST REAL TTEST CHARACTER*1 IGO character*1 openC c23456789 123456789 123456789 123456789 123456789 123456789 123456789 12 * ----------Executable code starts here--------------------------------- C----------------------------------------------------------------------- DUMPIT=.FALSE. IF(HOLD)dumpit=.true. C----------------------------------------------------------------------- IF(M_FADC_TIME_BINS.GT.1)THEN HAVE_open_cluster=.false. CLOSE_the_cluster=.false. START_new_cluster=.false. FIRST_BIN=0 DO 225 IBIN=1,M_FADC_TIME_BINS C FADC_PH_SUM is the sum of the last TPC_FADC_N_SMOOTH values IF(IBIN.EQ.1)THEN FADC_PH_SUM(IBIN)=FADC_PH(IBIN)*TPC_FADC_N_SMOOTH FADC_PH_PED_SUM(IBIN)=0. ELSEIF(IBIN.LE.TPC_FADC_N_SMOOTH)THEN FADC_PH_SUM(IBIN)=FADC_PH_SUM(IBIN-1) 2 +FADC_PH(IBIN)-FADC_PH(1) ELSE FADC_PH_SUM(IBIN)=FADC_PH_SUM(IBIN-1) 2 +FADC_PH(IBIN)-FADC_PH(IBIN-TPC_FADC_N_SMOOTH) ENDIF PulseHeight=FADC_PH_SUM(IBIN)/TPC_FADC_N_SMOOTH -Pedistal C a cluster is open (a cluster is opened with TPC_FADC_N_SMOOTH bins) IF(HAVE_open_cluster)THEN C FADC_PH_CLUS_SUM is the sum over the full cluster, pedistal subtracted FADC_PH_CLUS_SUM(IBIN)=FADC_PH_CLUS_SUM(IBIN-1) 2 +FADC_PH(IBIN)-Pedistal C pulse height is large enough to continue IF(PulseHeight.GE. 2 TPC_FADC_PED_C*TPC_FADC_SCALE_SINGLE_CELL_MAX)THEN C identify new cluster while still in an old cluster C this can be tested only if the cluster is large enough to C establish a previous value IF( 1 ((IBIN-FIRST_BIN).GE.TPC_FADC_PERSIST).AND. 2 ((TPC_FADC_PED_FRAC*PulseHeight).GE. 2 FADC_PH_PED_SUM(IBIN)/TPC_FADC_N_SMOOTH) 3 )THEN CLOSE_the_cluster=.true. START_new_cluster=.true. IF(dumpit)THEN print 1002, 1 ILCD,IADR,IBIN, 2 FADC_PH(IBIN), 2 IBIN,FIRST_BIN, 2 TPC_FADC_PERSIST, 3 TPC_FADC_PED_FRAC, 3 PulseHeight, 4 IBIN,FADC_PH_PED_SUM(IBIN), 4 TPC_FADC_N_SMOOTH 1002 FORMAT(' tpc_FADC_cluster:', 2 ' L=',I3, 3 ' CELL=',I7, 3 ' NewCluster(in old)', 4 ' ph(',I6,')=',F8.2, 4 ' (IBIN=',I7, 4 ' -', 4 ' FIRST_BIN=',I7,')', 4 ' >/=', 4 ' TPC_FADC_PERSIST=',I5,')' 4 ' and'/56x, 5 ' (TPC_FADC_PED_FRAC=',F6.3, 5 ' *', 6 ' PulseHeight=',F8.2,')', 6 ' >/=', 7 ' (FADC_PH_PED_SUM(',I7,')=',F8.2, 7 ' /' 8 ' TPC_FADC_N_SMOOTH=',I5,')') ENDIF C continue in the current cluster ELSE IF(PulseHeight.GT.PH_high)THEN PH_high=PulseHeight TAG_high=FADC_TAG(IBIN) ENDIF BINScontribute=BINScontribute+1 IF(IBIN.LT.M_FADC_TIME_BINS)THEN FADC_PH_PED_SUM(IBIN+1)= 1 FADC_PH_SUM(IBIN+1-TPC_FADC_N_SMOOTH) ENDIF ENDIF C identify end of cluster by dropping below threshold ELSE CLOSE_the_cluster=.true. IF(dumpit)THEN print 1004, 1 ILCD,IADR,IBIN, 2 FADC_PH(IBIN), 3 PulseHeight, 4 TPC_FADC_PED_C, 4 TPC_FADC_SCALE_SINGLE_CELL_MAX 1004 FORMAT(' tpc_FADC_cluster:', 2 ' L=',I3, 3 ' CELL=',I7, 3 ' close the cluster ', 4 ' ph(',I6,')=',F8.2, 6 ' (PulseHeight=',F8.2,')', 6 ' < ', 7 ' (TPC_FADC_PED_C=',F6.3, 7 ' *' 8 ' TPC_FADC_SCALE_SINGLE_CELL_MAX=',F6.1,')') ENDIF ENDIF C a cluster is not open ELSE FADC_PH_CLUS_SUM(IBIN)=0. C identify a new cluster (no current open cluster) C do no allow new cluster until pedistal is established IF( 1 (IBIN.GT.TPC_FADC_N_SMOOTH).AND. 2 (PulseHeight.GE. 2 (TPC_FADC_PED_I*TPC_FADC_SCALE_SINGLE_CELL_MAX)))THEN START_new_cluster=.true. IF(dumpit)THEN print 1003, 1 ILCD,IADR,IBIN, 2 FADC_PH(IBIN), 3 PulseHeight, 4 TPC_FADC_PED_I, 4 TPC_FADC_SCALE_SINGLE_CELL_MAX 1003 FORMAT(' tpc_FADC_cluster:', 2 ' L=',I3, 3 ' CELL=',I7, 3 ' NewCluster(fresh) ', 4 ' ph(',I6,')=',F8.2, 6 ' (PulseHeight=',F8.2,')', 6 ' >/=', 7 ' (TPC_FADC_PED_I=',F6.3, 7 ' *' 8 ' TPC_FADC_SCALE_SINGLE_CELL_MAX=',F6.1,')') ENDIF C continue under pedistal ELSE IF(IBIN.LT.M_FADC_TIME_BINS)THEN FADC_PH_PED_SUM(IBIN+1)= 1 FADC_PH_SUM(IBIN+1-TPC_FADC_N_SMOOTH) Pedistal=FADC_PH_PED_SUM(IBIN+1)/TPC_FADC_N_SMOOTH ENDIF ENDIF ENDIF C----------------------------------------------------------------------- c close the cluster IF(CLOSE_the_cluster)THEN Z_NOW=(FIRST_BIN 2 -TPC_FADC_BIN_OFFSET) 3 *TPC_FADC_BIN_TIME 4 *TPC_DRIFT_VEL Z_DIF=BINScontribute 3 *TPC_FADC_BIN_TIME 4 *TPC_DRIFT_VEL PH_HIT=FADC_PH_CLUS_SUM(IBIN) TAG=TAG_high IF(dumpit)THEN PRINT 1007, 1 ILCD,IADR,IBIN, 2 FADC_PH_CLUS_SUM(IBIN), 3 Z_NOW,Z_DIF, 4 PH_HIT,TAG 1007 FORMAT(' tpc_FADC_cluster:', 2 ' L=',I3, 3 ' CELL=',I7, 4 ' close the cluster' 4 ' clusSUM(',I6,')=',F8.2, 5 ' Z=',F8.3,' Z_DIF=',F8.3, 6 ' PH=',F8.2,' TAG=',I6) ENDIF IF(.NOT.DIAGNOSTIC)THEN CALL TPC_ADD_HIT(ILCD,IADR,Z_NOW,Z_DIF,PH_HIT,TAG) ENDIF CLOSE_the_cluster=.false. HAVE_open_cluster=.false. FIRST_BIN=0 IF(IBIN.LT.M_FADC_TIME_BINS)THEN FADC_PH_PED_SUM(IBIN+1)= 2 FADC_PH_SUM(IBIN) Pedistal=FADC_PH_PED_SUM(IBIN+1)/TPC_FADC_N_SMOOTH ENDIF ENDIF C----------------------------------------------------------------------- C start new cluster IF(START_new_cluster)THEN FIRST_BIN=IBIN FADC_PH_CLUS_SUM(IBIN)=PulseHeight PH_high=PulseHeight TAG_high=FADC_TAG(IBIN) BINScontribute=TPC_FADC_N_SMOOTH START_new_cluster=.false. HAVE_open_cluster=.true. IF(IBIN.LT.M_FADC_TIME_BINS)THEN FADC_PH_PED_SUM(IBIN+1)= 2 FADC_PH_SUM(IBIN+1-TPC_FADC_N_SMOOTH) Pedistal=FADC_PH_PED_SUM(IBIN+1)/TPC_FADC_N_SMOOTH ENDIF ENDIF C----------------------------------------------------------------------- C dump at end of loop IF( 1 (dumpit).and. 2 (IBIN.gt.2760).and. 3 (IBIN.LT.2900))THEN IF(FADC_PH(IBIN).GT.0.)THEN if(HAVE_open_cluster)THEN openC='C' ELSE openC='-' ENDIF TTEST=(IBIN-TPC_FADC_BIN_OFFSET) 2 *TPC_FADC_BIN_TIME ZTEST=TTEST 3 *TPC_DRIFT_VEL PRINT 1005, 1 ILCD,IADR,IBIN, 2 FADC_PH(IBIN), 3 openC,FIRST_BIN, 4 FADC_PH_SUM(IBIN), 5 FADC_PH_CLUS_SUM(IBIN), 6 FADC_PH_PED_SUM(IBIN), 7 PulseHeight,Pedistal, 8 TTEST,ZTEST 1005 FORMAT(' tpc_FADC_cluster:', 2 ' L=',I3, 3 ' CELL=',I7, 4 ' ph(',I6,')=',F8.2, 5 ' ',A1,I5,' ', 6 ' phSUM(i)=',F8.2, 7 ' clusSUM(i)=',F8.2, 8 ' pedSUM(i)=',F8.2, 9 ' ph=',F8.2,' ped=',F8.2, 9 ' t=',F11.0,' Z=',F8.4) ENDIF ENDIF C----------------------------------------------------------------------- 225 CONTINUE IF(HOLD)THEN DO 285 IBIN=1, M_FADC_TIME_BINS FADC_PH_CLUS_SUM_HOLD(IBIN)= 2 FADC_PH_CLUS_SUM(IBIN) /TPC_FADC_N_SMOOTH 3 /TPC_TIME_AMP_BINS *3 FADC_PH_PED_SUM_HOLD(IBIN)= 2 FADC_PH_PED_SUM(IBIN) /TPC_FADC_N_SMOOTH 285 CONTINUE ENDIF IF(dumpit)THEN c READ 1006,IGO 1006 FORMAT(A1) ENDIF ENDIF RETURN END