* * $Id; $ * * $Log: tpc_FADC_response.F,v $ * Revision 1.1 2004/05/28 16:09:46 dpp * -> NEW * -> replaces tpc_time_response * -> move constants to common, initialized in tpc_init_det_response * -> builds FADC time bin response, clusters in time, * supercedes input hit list with cluster result * * * #include "sys/CLEO_machine.h" #include "pilot.h" SUBROUTINE TPC_FADC_RESPONSE(INPlayer,INPwire) C....................................................................... C. C. TPC_FADC_RESPONSE - generate a FADC response from the input hits C. C. COMMON : C. CALLS : C. CALLED : C. AUTHOR : D. Peterson C. C. VERSION : 1.00 C. CREATED : 25-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 INPlayer,INPwire INTEGER CELL_TO_HOLD REAL Z_LENGTH_FADC REAL T_LENGTH_FADC INTEGER FADC_TIME_BINS INTEGER ILCD INTEGER ILTF INTEGER IWIR INTEGER IADR INTEGER IHIT,JHIT INTEGER KillHit REAL USEcharge INTEGER FIRST_BIN INTEGER INTER_BIN INTEGER IBIN,JBIN INTEGER HI_CONTIB(M_FADC_TIME_BINS) REAL AREA_NORM REAL TIME_DIFF REAL EXPON_TAIL LOGICAL DUMPIT REAL ZTEST REAL TTEST CHARACTER*1 IGO LOGICAL PROCESSHIT LOGICAL DIAGNOSTIC LOGICAL HOLD_THIS_CELL INTEGER print_EvntHitMax INTEGER IDUM C to compile in solaris, must be deleted in OSF #if defined(CLEO_SunOS) REAL RAN(2) #endif c23456789 123456789 123456789 123456789 123456789 123456789 123456789 12 * ----------Executable code starts here--------------------------------- print 1001,EvntHit_Num,INPlayer,INPwire 1001 FORMAT(' TPC_FADC_RESPONSE: ENTER: number of hits=',I7, 2 ' INPUT L=',I4,' wire=',I8) DIAGNOSTIC=(INPlayer.NE.0) FADC_CELL_HOLD=0 FADC_LYR_HOLD=0 FADC_WIR_HOLD=0 CELL_TO_HOLD=0 #if defined(CLEO_SFDIAG) IF(.NOT.DIAGNOSTIC)THEN print 1002 1002 format(' TPC_FADC_RESPONSE: enter the cell to hold for display') read *,CELL_TO_HOLD print 1003,CELL_TO_HOLD 1003 format(' TPC_FADC_RESPONSE: cell_to_hold=',I10) ENDIF #endif C length of the measured region in meters Z_LENGTH_FADC=2.*(TPC_haflen+TPC_FADC_LENGTH_XTR) C length of the measured region in picosec T_LENGTH_FADC=Z_LENGTH_FADC/TPC_DRIFT_VEL C number of time bins FADC_TIME_BINS=T_LENGTH_FADC/TPC_FADC_BIN_TIME IF(FADC_TIME_BINS.GE.M_FADC_TIME_BINS)THEN print 1004,Z_LENGTH_FADC,FADC_TIME_BINS 1004 FORMAT(' TPC_FADC_RESPONSE: TROUBLE: not enough time bins:', 2 ' Z_LENGTH=',F6.2,' require time bins=',I7) ELSE TPC_FADC_BIN_OFFSET=FADC_TIME_BINS/2 IF(EvntHit_Num.GT.0)THEN C----------------------------------------------------------------------- C loop layers C demand TPC layer C demand multihit layer C loop over cells in layer c check cell id hit pointer C test nMult C----------------------------------------------------------------------- C header of loop over layer IF(DIAGNOSTIC)THEN ILCD=INPlayer ELSE ILCD=0 ENDIF C loop over layer 111 CONTINUE IF(.NOT.DIAGNOSTIC)THEN ILCD=ILCD+1 ENDIF IF(ILCD.LE.NLYRCD)THEN C code executed for the layer IF(IDVCCD(ILCD).EQ.ITPC1)THEN ILTF=ILCDTF(ILCD) IF(ILTF.GT.0)THEN IF(MultiHitLayer(ILTF))THEN C header of loop over wire IF(DIAGNOSTIC)THEN IWIR=INPwire ELSE IWIR=-1 ENDIF C loop over wire 121 CONTINUE IF(.NOT.DIAGNOSTIC)THEN IWIR=IWIR+1 ENDIF IF(IWIR.LT.NWIRCD(ILCD))THEN C code executed for the wire IADR=INDXCD(ILCD)+IWIR IHIT=EvntHit_MapDet(IADR) IF(IHIT.GT.0)THEN IF(EvntHit_nMult(IHIT).GE.1)THEN C----------------------------------------------------------------------- c DUMPIT=DIAGNOSTIC DUMPIT= 2 (current_event.eq.19).and. 3 (ILCD.eq.25).and. 4 (IWIR.eq.2) IF(dumpit)THEN JHIT=IHIT 151 IF(JHIT.GT.0)THEN PRINT 1005, 1 ILCD,IWIR,IADR,IHIT,JHIT, 4 EvntHit_Charge(JHIT), 3 EvntHit_rawTIM(JHIT), 2 EvntHit_Z(JHIT), 5 EvntHit_corTIM(JHIT) 1005 FORMAT(' tpc_FADC_response:', 2 ' L=',I3,' W=',I5, 3 ' CELL=',I7,'Ih=',I7,'Jh=',I7, 4 ' ph=',F8.2, 5 ' t=',F11.0,' Z=',F8.4, 6 ' dt=',F11.0) JHIT=EvntHit_NxtMlt(JHIT) GO TO 151 ENDIF ENDIF C----------------------------------------------------------------------- C primary loop over all of the hits on the multihit pad C fill the FADC bin array with pulse heights C----------------------------------------------------------------------- CALL VZERO(FADC_PH, M_FADC_TIME_BINS) CALL VZERO(FADC_TAG, M_FADC_TIME_BINS) CALL VZERO(HI_CONTIB,M_FADC_TIME_BINS) JHIT=IHIT 210 IF(JHIT.GT.0)THEN C code executed for each hit on a wire IF(DIAGNOSTIC)THEN USEcharge=-EvntHit_Charge(JHIT) PROCESSHIT=(USEcharge.GT.0.) ELSE USEcharge=EvntHit_Charge(JHIT) PROCESSHIT=(USEcharge.GT.0.) ENDIF IF(PROCESSHIT)THEN C----------------------------------------------------------------------- C this uses the stored z position of the hit, not the rawTDC nor rawTIM C----------------------------------------------------------------------- FIRST_BIN= 1 (EvntHit_Z(JHIT)/TPC_DRIFT_VEL) 2 /TPC_FADC_BIN_TIME 3 +TPC_FADC_BIN_OFFSET if(dumpit)print 1006,JHIT,FIRST_BIN 1006 format(' tpc_FADC_response:', 2 ' Jh=',I7,' FIRST_BIN=',I8) INTER_BIN=FIRST_BIN 1 +EvntHit_corTIM(JHIT) 2 /TPC_FADC_BIN_TIME if(dumpit)print 1007,JHIT,INTER_BIN 1007 format(' tpc_FADC_response:', 2 ' Jh=',I7,' INTER_BIN=',I8) AREA_NORM=1.+INTER_BIN-FIRST_BIN 2 +TPC_TIME_AMP_BINS if(dumpit)print 1008,JHIT,AREA_NORM 1008 format(' tpc_FADC_response:', 2 ' Jh=',I7,' AREA_NORM=',F10.4) DO 215 IBIN=FIRST_BIN,INTER_BIN IF( 1 (IBIN.GE.1).and. 2 (IBIN.LE.M_FADC_TIME_BINS))THEN FADC_PH(IBIN)=FADC_PH(IBIN)+ 2 USEcharge/AREA_NORM IF(USEcharge.GT.HI_CONTIB(IBIN))THEN HI_CONTIB(IBIN)=USEcharge FADC_TAG(IBIN)=EvntHit_Tag(JHIT) ENDIF ENDIF 215 CONTINUE if(dumpit)print 1009,JHIT 1009 format(' tpc_FADC_response:', 2 ' Jh=',I7,' complete loop 215') IBIN=INTER_BIN 217 IBIN=IBIN+1 IF( 1 (IBIN.GE.1).and. 2 (IBIN.LE.M_FADC_TIME_BINS))THEN TIME_DIFF=(IBIN-INTER_BIN) 2 *TPC_FADC_BIN_TIME EXPON_TAIL=USEcharge 2 *EXP(-TIME_DIFF/TPC_TIME_AMP) IF(EXPON_TAIL.GT.TPC_EXPON_TAIL_CUT)THEN FADC_PH(IBIN)=FADC_PH(IBIN)+ 2 EXPON_TAIL/AREA_NORM IF(USEcharge.GT.HI_CONTIB(IBIN))THEN HI_CONTIB(IBIN)=USEcharge FADC_TAG(IBIN)=EvntHit_Tag(JHIT) ENDIF GO TO 217 ENDIF ENDIF if(dumpit)print 1010,JHIT 1010 format(' tpc_FADC_response:', 2 ' Jh=',I7,' complete loop 217') C----------------------------------------------------------------------- C deactivate the initial charge deposition C----------------------------------------------------------------------- IF(.NOT.DIAGNOSTIC)then EvntHit_Charge(JHIT)= 2 -ABS(EvntHit_Charge(JHIT)) KillHit=JHIT else KillHit=0 endif C----------------------------------------------------------------------- C end of condition: IF(PROCESSHIT) C----------------------------------------------------------------------- ELSE KillHit=0 ENDIF C----------------------------------------------------------------------- C end of primary loop over the hits on the multihit pad C----------------------------------------------------------------------- JHIT=EvntHit_NxtMlt(JHIT) if(KillHit.ne.0)call tpc_drop_hit(KillHit) GO TO 210 ENDIF C----------------------------------------------------------------------- C add low level noise C----------------------------------------------------------------------- DO 229 IBIN=1,M_FADC_TIME_BINS FADC_PH(IBIN)=FADC_PH(IBIN)+ 2 TPC_FADC_NOISE_TO_SIGNAL*RAN(IDUM) 3 *TPC_FADC_SCALE_SINGLE_CELL_MAX 229 CONTINUE C----------------------------------------------------------------------- C save the selected cell for plotting, C----------------------------------------------------------------------- IF(DIAGNOSTIC)THEN HOLD_THIS_CELL=.TRUE. ELSE HOLD_THIS_CELL=(IADR.eq.CELL_TO_HOLD) ENDIF IF(HOLD_THIS_CELL)THEN FADC_CELL_HOLD=IADR FADC_LYR_HOLD=ILCD FADC_WIR_HOLD=IWIR CALL UCOPY( 1 FADC_PH, 2 FADC_PH_HOLD, M_FADC_TIME_BINS) CALL UCOPY( 1 FADC_TAG, 2 FADC_TAG_HOLD, M_FADC_TIME_BINS) ENDIF C----------------------------------------------------------------------- C dump C----------------------------------------------------------------------- IF(dumpit.and.(.false.))THEN DO 245 IBIN=1,M_FADC_TIME_BINS IF(FADC_PH(IBIN).GT.0.)THEN TTEST=(IBIN-TPC_FADC_BIN_OFFSET) 2 *TPC_FADC_BIN_TIME ZTEST=TTEST 3 *TPC_DRIFT_VEL PRINT 1011,ILCD,IWIR,IADR,IHIT, 2 IBIN,FADC_PH(IBIN),TTEST,ZTEST 1011 FORMAT(' tpc_FADC_response:', 2 ' L=',I3,' W=',I5, 3 ' CELL=',I7,' Ih=',I7, 4 ' ph(',I6,')=',F8.2, 5 ' t=',F11.0,' Z=',F8.4) ENDIF 245 CONTINUE c READ 1012,IGO 1012 FORMAT(A1) ENDIF C----------------------------------------------------------------------- C cluster and add new hit C----------------------------------------------------------------------- if(dumpit)print 1013 1013 format(' tpc_FADC_response:', 2 ' will call TPC_FADC_CLUSTER') CALL TPC_FADC_CLUSTER(ILCD,IADR, 2 HOLD_THIS_CELL,DIAGNOSTIC) if(dumpit)print 1014 1014 format(' tpc_FADC_response:', 2 ' back from TPC_FADC_CLUSTER') C----------------------------------------------------------------------- C end of cell conditions C----------------------------------------------------------------------- C end of condition (EvntHit_nMult(IHIT).GE.1) ENDIF C end of condition that MapDet points to hit; IHIT>0 ENDIF C end of condition (IWIR.LT.NWIRCD(ILCD)); end of loop over wire in layer IF(.NOT.DIAGNOSTIC)GO TO 121 ENDIF C end of condition (MultiHitLayer(ILTF)) ENDIF C end of condition (ILTF.GT.0) ENDIF C end of condition (IDVCCD(ILCD).EQ.ITPC1) ENDIF print_EvntHitMax=EvntHitMax print 1015,ILCD, 2 print_EvntHitMax,EvntHit_Num, 3 EvntHit_OpnLocS,EvntHit_OpnLoc1, 4 EvntHit_OpnLocN(EvntHit_OpnLoc1), 5 EvntHit_OpnLocL, 6 FADC_CELL_HOLD 1015 FORMAT(' TPC_FADC_RESPONSE:AftLayr',I4, 2 ' loc=',I7,' EvntHit_Num=',I7, 3 ' _OpnLocS=',I7,' _OpnLoc1=',I7, 4 ' _OpnLocN=',I7, 5 ' _OpnLocL=',I7, 6 ' ..HOLD cell=',I7) C end of condition(ILCD.LE.NLYRCD); end of loop over CD layers ILCD IF(.NOT.DIAGNOSTIC)GO TO 111 ENDIF C end of condition (EvntHit_Num.GT.0) ENDIF C----------------------------------------------------------------------- C end of condition that there are sufficient time bins C----------------------------------------------------------------------- ENDIF RETURN END