*CMZ : 2.04/00 23/11/94 14.26.06 by Charles F. Maguire *CMZU: 2.01/00 22/03/93 13.54.31 by John P. Sullivan *-- Author : John P. Sullivan 23/12/92 SUBROUTINE VER_HITS ( ILAYER,NAME,VMUL ) C C DESCRIPTION: C C Extracts all of the hits from the geant hit banks, then saves some of C that information in the MVD-specific hits banks (VMAP or VCAL). C Code to make sure the zebra bank is not overflowed and to issue a warning C message if it is was added. Also use only integers for 'VMAP' data bank -- C that's the way it is defined but real numbers for the energy loss were C being put into it. In addition, fix one bug where OFVC_DEV was used where C OFVM_DEV was intended -- it did not matter for now since the two C parameters are equal. C C__________________________________________________________ C C ARGUMENTS: C ILAYER = the layer (1=inner, 2=outer) of the vertex detector C NAME = geant detector identifier of the layer being checked. C VMUL = current number of hits on input, updated number on output. C C MAP: C 1) CALLED BY: VER_DIGI C 2) CALLS: GFHITS, GMEDIA, GMTOD, TRKSTACK C C AUTHOR: JPSullivan, Dec 3-4 and 23, 1992 from code originally written C by Ju Kang. C C REVISIONS: DATE NAME MODIFICATION C ------ ------ ------------------------------------- C Jan 4, '93 JPS Remove fortran STOP statement when C an odd number of hits is encountered. C For details see comment in code below. C Mar 22,'93 JPS Minor changes for compatibility with C pisa coding standards. Some changes to C the call to GETSTRIPS were made last week. C Pass more arguements to avoid potential C bugs from inconsistent geometry assumptions. C The previous version of GETSTRIPS had some C constants hardwired in it. C Jul 27, '94 JPS Change the information which is saved in the C output banks to be closer to the raw hits C information. Subroutine GETSTRIPS was removed C because the strip numbers which are hit are C no longer calculated here. C Jul 30, '97 CFM Add call to TRKSTACK ; has no effect on C other code in VER_HITS. MVD catches partner C particles (e.g. Dalitz decay, meson decay) C which might otherwise be missed. C C Apr 16, '98 CFM Make TRKSTACK call optional with STCK in C fifth position over VER control line C C Sep 13, '00 JPS Modified to use new hit banks, but C it should return the same results C (or at least in the same format). C C Sep 27, '00 JPS Fixed bug in calculation of N_WAFER on C east side. C_____________________________________________________________________ C IMPLICIT NONE C C GLOBAL SPECIFICATIONS: C C GUPHNX contains "variables of general interest", data-card defs, flags. C in particular, CVOLU_OPT is used in this subroutine. C Unfortunately, this also defines the local variable HIT_ALL, C which is not used here and therefore results in an undefined C variable warning message when this is compiled. C *KEEP,GUPHNX. include 'guphnx.inc' *KEND. C C FSTORE has the common where the detector specific data are stored. *KEEP,FSTORE. include 'fstore.inc' *KEND. C C FPVLINK contains the zebra links for the vertex detector. In particular C it has the pointers into the common inside FSTORE where the vertex C detector event data and geometry parameters are stored. C It also contains various offset parameters related the the C structure of the vertex detector data banks. *KEEP,SUBLINK. include 'sublink.inc' *KEEP,FPVLINK. include 'fpvlink.inc' *KEND. C C SUBEVT (not used here) contains data related to the sub-event C structure, for example, the sub-event number and C the true event number. C +CDE,SUBEVT. C C INTERNAL SPECIFICATIONS: c CHARACTER*4 CUDET INTEGER*4 IUDET EQUIVALENCE (IUDET, CUDET) C CHARACTER*4 SET_ID c INTEGER LF_V C C Taken from file "VER.FOR" for the hit indices: C VNH is a special NH for VER C Note: VNH is used to define the # of elements in C the hits arrays, but when VER is called to define C the hits banks, it is called with "NH" which is usually C 6, not 11(=VNH). This means that in general, not all C 11 of the hits parameters are really defined. C INTEGER VNH , & IX_IX , IX_IY , IX_IZ , & IX_DE , IX_TF , IX_ID , & IX_PX , IX_PY , IX_PZ , IX_PL, IX_ET PARAMETER ( VNH = 11 ) ! number of elements per hit PARAMETER ( IX_IX = 1 ) !indices of entrance position PARAMETER ( IX_IY = 2 ) !in local coord. (cm) PARAMETER ( IX_IZ = 3 ) PARAMETER ( IX_DE = 4 ) !dE/dx (keV) PARAMETER ( IX_TF = 5 ) !TOF (ns) PARAMETER ( IX_ID = 6 ) !particle ID (GEANT) PARAMETER ( IX_PX = 7 ) !local momentum components PARAMETER ( IX_PY = 8 ) ! (GeV/c) PARAMETER ( IX_PZ = 9 ) ! PARAMETER ( IX_PL =10 ) !path length (cm) PARAMETER ( IX_ET =11 ) !Total energy (GeV) C INTEGER NUMLEV ! Number of levels INTEGER NUMLMX ! max # levels in any case INTEGER NUMLMX2 ! max # levels for pads INTEGER HITDIM ! Dimension of HIT vector INTEGER NHMAX ! Maximum numb of hits to return C PARAMETER ( NUMLMX = 3 ) ! Three volume descriptors PARAMETER ( NUMLMX2= 1 ) ! One volume descriptor for pads PARAMETER ( HITDIM = VNH ) ! Record standard 11 things PARAMETER ( NHMAX =6000) ! Max. numb. of hits to return C INTEGER IH ! Loop index for hits INTEGER NUVS ( NUMLMX ) ! Number of levels down to go INTEGER ITRAH ( NHMAX ) ! Track number of each hit INTEGER NUBV ( NUMLMX, NHMAX ) ! volume descriptor numbers barrel INTEGER NUBV2 ( NUMLMX2,NHMAX ) ! volume descriptor numbers pads INTEGER NHITS ! Returned number of hits C REAL XIN(3),XOUT(3) ! entr. & exit position, local coord REAL DELE ! dE/dx REAL HITSH ( HITDIM, NHMAX ) ! GEANT's set identifier REAL LXIN(3), LXOUT(3), XMID(3) ! test arrays INTEGER NUMED ! test medium return LOGICAL LOGWARN ! wrong medium warning switch SAVE LOGWARN ! save for repeated calls C INTEGER N_TYPE ! 1=regular or 2=longer strip INTEGER N_LADDER ! Ladder number INTEGER N_WAFER ! Wafer number INTEGER WFR_ADR ! overall address for the wafer C INTEGER LVER_OUT ! lun for output C INTEGER I C C_______________________________________________ C C input variables: C INTEGER*4 ILAYER,VMUL CHARACTER*4 NAME C C***************************************************************************** C DATA LOGWARN /.TRUE./ ! initialize as true DATA LVER_OUT / 6/ DATA SET_ID / 'VER '/ C C _________________________________________________________________ C THE EXECUTABLE STATEMENTS FOLLOW BELOW C _________________________________________________________________ C CUDET=NAME ! namesv variable in VER subroutine C C extract hit information from Zebra/Geant Hit Banks C In the call below: C SET_ID = set identifier C CUDET = detector identifier C NUMLEV = dimension of path identification C HITDIM = dimension of hit array C NHMAX = maximum number of returned hits C 0 = take all tracks C NUVS = volume descriptor C ITRAH = array of hit producing tracks C NUBV = volume descriptor numbers on output C HITSH = hit values C NHITS = number of hits in this detector C c CALL GPHITS ( SET_ID, CUDET ) c IF ( ILAYER.LE.3 ) THEN NUMLEV = 3 !for strip detector CALL GFHITS(SET_ID, CUDET, NUMLEV, HITDIM, NHMAX, & 0, NUVS, ITRAH, NUBV, HITSH, NHITS) ELSE NUMLEV = 1 !for pad detectors CALL GFHITS(SET_ID, CUDET, NUMLEV, HITDIM, NHMAX, & 0, NUVS, ITRAH, NUBV2, HITSH, NHITS) END IF c write ( 6,1234 ) SET_ID, CUDET, NHITS c1234 format ( ' ver_hits: set_id=',a4,' cudet=',A4, c & ' nhits=',I5) C IF(NHITS.GT.0) THEN C c WRITE(LVER_OUT,994) NHITS,NUVS(1),(HITSH(I,1),I=1,11), C 1 (HITSH(I,2),I=1,11) C994 FORMAT(2X,'NHITS in set "VER " = ',I4,3x,'NUVS ',I12, C & ' hit #1 values:',/,1X,6(E12.4,1X),/1X,5(E12.4,1X), C 1 /,1X,6(E12.4,1X),/1X,5(E12.4,1X)) C C Check for an even number of hits. The number of hits C should always be even because each track has an extrance C hit in the active volume and an exit hit: C IF(NHITS-2*(NHITS/2).NE.0)THEN C WRITE(LVER_OUT,992)CUDET,NHITS 992 FORMAT(/,2X,'VER_HITS : For detector ',A4, 1 ' odd number of', 1 ' hits = ',I8,/,10X,'Pair logic fails?') C C JPSullivan replaced a fortran stop statement with the C following lines, Jan 4, 1993. If the number of hits is C too large, there are two possibilites. One is that C something we do not understand has happened to make the C number odd -- in that case, write a message, then return C without analyzing this set of hits. The other possibility C is one that I noticed experimentally -- if the number of C hits is too large for the arrays being used (dimension C NHMAX) then NHITS is returned as NHMAX+1 -- in this C case, the first NHMAX hits stored in the hits arrays C should be good, so analyze them, but issue a warning C message that some hits have been ignored. C IF ( NHITS.EQ.(NHMAX+1) ) THEN NHITS=NHMAX WRITE(LVER_OUT,996) NHMAX 996 FORMAT ( ' VER_HITS: NHITS truncated NHMAX=',I7) ELSE WRITE(LVER_OUT,993) 993 FORMAT ( ' VER_HITS: return, these hits ignored') RETURN END IF C ENDIF C DO IH = 1,NHITS,2 ! loop on pairs of stored hits /module C IF ( ILAYER.LE.2 ) THEN N_TYPE = ILAYER ! Different strip length inner/outer C C the following illogical phi numbering convention is C retained from older code for backward compatibility C IF ( NUBV(1,IH+1).LE.12 ) THEN C West side N_LADDER = NUBV(2,IH+1)+1 ! phi segment N_WAFER = NUBV(1,IH+1) ! (1 - 12 for west side) ELSE C East side N_WAFER = NUBV(1,IH+1) - 12 ! (13 - 24 for east side) IF ( NUBV(2,IH+1).EQ.1 ) THEN N_LADDER = 1 ELSE IF ( NUBV(2,IH+1).EQ.2 ) THEN N_LADDER = 6 ELSE N_LADDER = 5 END IF END IF IF ( N_WAFER.LE.0 .OR. N_WAFER.GT.12 .OR. x N_TYPE .LE.0 .OR. N_TYPE .GT. 2 .OR. x N_LADDER.LE.0 .OR. N_LADDER.GT. 6 ) THEN WRITE ( 6,* ) ' ver_hits: error, hit out of range', x ' N_WAFER=',N_WAFER, ' N_TYPE=', x N_TYPE, ' N_LADDER=',N_LADDER END IF WFR_ADR = N_TYPE*10000 + N_LADDER*1000 + N_WAFER c WRITE ( 6,* ) ' VER_HITS: strips hit N_WAFER=',N_WAFER, c x ' N_TYPE=', N_TYPE, ' N_LADDER=',N_LADDER, c x ' WFR_ADR=', WFR_ADR ELSE WFR_ADR = NUBV2(1,IH+1)*10000 + 20000 !30000,40000 = two pad detectors c WRITE ( 6,* ) ' VER_HITS: pads hit WFR_WDR=',WFR_ADR END IF C XIN(1) = HITSH(IX_IX,IH) ! Entrance position XIN(2) = HITSH(IX_IY,IH) ! in local coord. XIN(3) = HITSH(IX_IZ,IH) ! XOUT(1) = HITSH(IX_IX,IH+1) ! Exit position XOUT(2) = HITSH(IX_IY,IH+1) ! in local coord. XOUT(3) = HITSH(IX_IZ,IH+1) ! c c Check the daughter coordinates c CALL GMEDIA(XIN,NUMED) c c Check for vertex medium (sensitive Silicon = 105) c IF(NUMED.NE.105)THEN c c Try midpoint (possible round off errors in XIN) c XMID(1)=0.5*(XIN(1)+XOUT(1)) XMID(2)=0.5*(XIN(2)+XOUT(2)) XMID(3)=0.5*(XIN(3)+XOUT(3)) CALL GMEDIA(XMID,NUMED) c c Still not Silicon, so issue one time warning c IF(NUMED.NE.105.AND.LOGWARN)THEN WRITE(LVER_OUT,888)NUMED,CUDET,XIN,XOUT 888 FORMAT(/,3X,'VER_HITS Medium number = ',I3, 1 ' for VER ',A4, 1 ' does not correspond to Silicon', 1 /,3X,'XYZ_IN = ', 2 3E13.5,/,3X,'XYZ_OUT = ',3E13.5) LOGWARN=.FALSE. ENDIF ! end mid-point check ENDIF ! end NUMED = 105 check C C GMTOD converts the "HALL" system coordinates to the local C coordinate system used inside each detector wafer C CALL GMTOD(XIN,LXIN,1) CALL GMTOD(XOUT,LXOUT,1) C C To maintain backwards compatibility, which the "z" C dimension in local coordinates to run in the +z direction C of the phenix coordinate system for both sides of the C beam axis -- this means switching the sign of z local C for the east side of the detector (x < 0). C IF ( XIN (1).LE.0. ) LXIN (3) = -LXIN (3) IF ( XOUT(1).LE.0. ) LXOUT(3) = -LXOUT(3) C c WRITE(LVER_OUT,886)XIN,LXIN,XOUT,LXOUT c886 FORMAT(3X,' XIN: ',3E13.5,/, c 1 3X,' LXIN: ',3E13.5,/,3X,' XOUT: ',3E13.5,/, c 2 3X,'LXOUT: ',3E13.5) C VMUL = VMUL + 1 ! increment output multiplicity DELE = HITSH(IX_DE,IH+1) ! energy deposition from exit hit C C feed into Zebra output bank, options are: C VMAP: (raw numbers) C VCAL: (also raw numbers -- they are the same here) C IF ( VMUL.GT.MFV_ALLDETS ) THEN WRITE ( LVER_OUT, 910 ) VMUL,MFV_ALLDETS 910 FORMAT( /' ************************************'/ & ' VER_HITS: ERROR out of room in Zebra', & ' banks'/ & ' next hit would be VMUL # ',I7/ & ' only have room for (MFV_ALLDETS)',I7/ & ' parameter MFV_ALLDETS in keep FPVLINK', & ' must be increased to change this'/ & ' RETURN without finishing all hits'/ & ' *********************************') VMUL = MFV_ALLDETS RETURN END IF IF(CVOLU_OPT(5,1).EQ.'STCK')THEN CALL TRKSTACK(ITRAH(IH)) ENDIF IF(CVOLU_OPT(4,1).EQ.'VMAP')THEN !simulate mapped ADC/TDC data LF_V = LFV_MAP(1) + (VMUL-1)*MFV_MAP + 2 ! offset into mother IQF(LF_V + OFVM_WAFER ) = WFR_ADR ! store into data bank QF(LF_V + OFVM_DEV ) = DELE ! dE in GeV IQF(LF_V + OFVM_NTRK ) = ITRAH(IH) ! track number QF(LF_V + OFVM_XIN ) = LXIN(1) ! x_in (local coords.) QF(LF_V + OFVM_YIN ) = LXIN(2) ! x_in (local coords.) QF(LF_V + OFVM_ZIN ) = LXIN(3) ! x_in (local coords.) QF(LF_V + OFVM_XOUT ) = LXOUT(1) ! x_out (local coords.) QF(LF_V + OFVM_YOUT ) = LXOUT(2) ! x_out (local coords.) QF(LF_V + OFVM_ZOUT ) = LXOUT(3) ! x_out (local coords.) IQF(LFV_MAP(1) + 1 ) = VMUL !put length into mother ELSEIF(CVOLU_OPT(4,1).EQ.'VCAL') THEN !simulate mapped calibra LF_V = LFV_CAL(1) + (VMUL-1)*MFV_MAP + 2 ! offset into mother IQF(LF_V + OFVC_WAFER ) = WFR_ADR ! store into data bank QF(LF_V + OFVC_DEV ) = DELE ! dE in GeV IQF(LF_V + OFVC_NTRK ) = ITRAH(IH) ! track number QF(LF_V + OFVC_XIN ) = LXIN(1) ! x_in (local coords.) QF(LF_V + OFVC_YIN ) = LXIN(2) ! x_in (local coords.) QF(LF_V + OFVC_ZIN ) = LXIN(3) ! x_in (local coords.) QF(LF_V + OFVC_XOUT ) = LXOUT(1) ! x_out (local coords.) QF(LF_V + OFVC_YOUT ) = LXOUT(2) ! x_out (local coords.) QF(LF_V + OFVC_ZOUT ) = LXOUT(3) ! x_out (local coords.) IQF(LFV_CAL(1) + 1 ) = VMUL ! put length into mother ENDIF ! check on VMAP or VCAL ENDDO ! loop on pairs of NHITS /module end ELSE C WRITE(LVER_OUT,995) ILAYER C995 FORMAT(//,3X,'No hits from layer',I5,' in set "VER "') ENDIF ! condition on NHITS > 0 end C RETURN END