SUBROUTINE VER_DIGI C ============================================================ C C DESCRIPTION: C This subroutine saves hits in the sensitive part C of MVD detector. The MVD consists of the vertex detector C and the pad detector. C The vertex sdetector consists of inner and outer C layers of silicon strips detectors. Each layer also has C two ladders with different azimuthal angles. C Inner and outer strips have different effective strip C lengths since outer strips are wire-bonded. C So there are two different types of sensitive volumes C ("VSL1" for regular length and "VSL2" for longer one). C C Following values will be stored during the digitization: C (for details look inside VER_HITS) C C 1) Detector type, 1=regular(inner) or 2=longer(outer) strip C 2) Ladder number in each layer C 3) Wafer number in each silicon ladder C 4) Energy loss in the wafer C 5) track number causing the hit C 6) x,y,z of entrance hit C 7) x,y,z of exit hit C C Entries 1), 2) and 3) can be combined into a single C entry by spliting a single integer into the three C different numbers as following: C C New Entry = N_Type*10000 + N_ladder*1000 + N_wafer C C This new entry represents a overall address for the C wafer not specific to the ladder. C C C ARGUMENTS: (none) C C MAP: C 1) CALLED BY: GUDIGI C 2) CALLS : MZFORM, MZBOOK, MZPUSH, C VER_HITS C C AUTHOR: C JHK ( from CFM's template: 7-Apr-92 , and also C with JPS's help for the efficiency function ) C Creation Date: 17-Apr-1992 C =========================== C C Revisions:- C =========== C Date Name Description C ---- ---- ---------------------------------------- C Dec 3, 1992 JPS Replaced sections of nearly identical code C (one for inner and one for outer layer) with C a new subroutine VER_HITS. Gets hits out C of Geant banks and sets up Si hits. C Dec 4, 1992 JPS Modified to work with event splitting. C 1) only book zebra banks for hits on the first C sub-event, set multiplicity to zero then too. C 2) only call the last part of the subroutine C for the last sub-event -- this is the part of C the code that compares the total signal in a C strip to the threshold. It is not appropriate C to do this until the end of the whole event. C Dec 23, 1992 JPS Removed code (already commented out) to check C for previous hits on the same strip and to C apply the efficiency function to each strip. C This does not work properly when events are split C anyway. This type of code should go into VER_USER. C Also removed unused keeps. C Oct 4, 1993 JPS Send output to LOUT instead of LUN#6, LOUT is C in GCUNIT. 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. include 'guphnx.inc' C C +CDE,UDST. (not used here) contains dst I/O control parameters. C C +CDE,QUEST.(not used here) contains the "quest" array, which zebra used C to pass error flag and related information. C C FSTORE has the common where the detector specific data are stored. include 'fstore.inc' 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. C include 'sublink.inc' include 'fpvlink.inc' C C SUBEVT contains data related to the sub-event structure, for example, C the sub-event number and the true event number. include 'subevt.inc' C C GCUNIT contains Geant logical unit numbers include 'gcunit.inc' C C INTERNAL SPECIFICATIONS: C ====================== CHARACTER*4 CUDET INTEGER*4 IUDET EQUIVALENCE (IUDET, CUDET) c INTEGER ICALL SAVE ICALL C INTEGER BLEN, VMUL, IOVCAL, INCND CHARACTER*10 CHFORM C C***************************************************************************** C INTEGER NUMLEV ! Number of levels INTEGER NHMAX ! Maximum numb of hits to return INTEGER I,J INTEGER N_CAGES INTEGER CAGE_TYPE(24) SAVE N_CAGES, CAGE_TYPE INTEGER NUM_TYPE CHARACTER*4 LIST_OF_NAMES(12) INTEGER LIST_OF_LAYERS(12) INTEGER ILAYER INTEGER NFOUND C PARAMETER ( NUMLEV = 3 ) ! Three volume descriptors PARAMETER ( NHMAX = 5000) ! Max. numb. of hits to return C DATA ICALL / 0 / C C _________________________________________________________________ C THE EXECUTABLE STATEMENTS FOLLOW BELOW C _________________________________________________________________ c c JPSullivan added the following lines December 4, 1992 C This logic should be different depending on whether the Geant banks C are cleared between sub-events. This version of this subroutine assumes C that they are cleared. If they are not, then the best thing to do would C be to add a line to the beginning of this subroutine that said: c IF ( .NOT.END_EVTFLG ) RETURN C This means wait until all sub-events are finished (that's what the flag C end_evtflg tells us) then do all of this only once. C If this is done, the code that checks to see if this is sub-event 1 C before booking the zebra bank for the hits should be changed to make C sure it gets called. C This version of the subroutine is called once for each sub-event. C C Set sub-event multiplicity to zero C VMUL = 0 c C Initialize one time per run: C IF(ICALL.EQ.0) THEN ! Initialize WRITE(LOUT,999) CVOLU_OPT(2,1),CVOLU_OPT(4,1) 999 FORMAT(/,3x,'call to VER_DIGI'/' CVOLU_OPT(2,1)=',A4, & ' CVOLU_OPT(4,1)=',A4//) ICALL = 1 C C CVOLU_OPT(I,NSET) ith volume option for set number NSET C NSET: VER, PAD, INR, ITR, CRK, TRD, TOF, C EMC, PBG, MUO, CSI ( 1 ---> 11 ) C same for RVOLU_OPT and IVOLU_OPT C IF(CVOLU_OPT(2,1).NE.'P_ID') then WRITE(6,*) & ' VER_DIGI: inconsistent HIT structure - STOP !' STOP END IF IF(CVOLU_OPT(4,1).EQ.'VMAP') THEN ! simulate mapped ADC/TDC data ELSEIF(CVOLU_OPT(4,1).EQ.'VCAL') THEN ! simulate cal ADC/TDC data ELSE WRITE(6,*) & ' VER_DIGI: You will have a hard time getting output ' WRITE(6,*) & ' valid DIGI options are: VMAP, VCAL ' ENDIF c c book IO characteristic for event banks C CHFORM = '2I / 1F' CALL MZFORM('VCAL',CHFORM,IOVCAL) ! book characteristic CALL MZFORM('VMAP',CHFORM,IOVCAL) ! book characteristic C N_CAGES = NINT(QF(LFV_PARA + OFVA_N_CAGES)) DO I=1,N_CAGES CAGE_TYPE(I) = NINT(QF(LFV_PARA + OFVA_CAGE_TYPE+I-1)) END DO C DO I=1,6 NFOUND = 0 DO J=1,N_CAGES IF ( CAGE_TYPE(j).EQ.I ) NFOUND = NFOUND + 1 END DO IF ( NFOUND.GT.0 ) THEN NUM_TYPE = NUM_TYPE+1 WRITE ( LIST_OF_NAMES(NUM_TYPE),100 ) I 100 FORMAT ( 'VAI',I1) LIST_OF_LAYERS(NUM_TYPE) = 1 NUM_TYPE = NUM_TYPE+1 WRITE ( LIST_OF_NAMES(NUM_TYPE),110 ) I 110 FORMAT ( 'VAO',I1) LIST_OF_LAYERS(NUM_TYPE) = 2 END IF END DO ENDIF C C############################################################################# C C Reset Event Variables C C WRITE ( LOUT, * ) ' VER_DIGI: NSUB_EVT=',NSUB_EVT C IF(CVOLU_OPT(4,1).EQ.'VMAP') THEN ! simulate mapped ADC/TDC data BLEN = MFV_MAP*MFV_ALLDETS + 1 ! book bank with maximal size CALL MZBOOK(IXDIV_FE, LFV_MAP(1), LFV_MAP(1), 1, 'VMAP', 0, & 0, BLEN, 9, -1) ! mother bank IQF(LFV_MAP(1)+1) = VMUL ! preset C WRITE ( LOUT,1233 ) LFV_MAP(1) C1233 FORMAT ( ' VER_DIGI: LFV_MAP=(1)',I20 ) ELSEIF(CVOLU_OPT(4,1).EQ.'VCAL') then !simulate mapped calibrated data BLEN = MFV_CAL*MFV_ALLDETS + 1 ! book bank with maximal size CALL MZBOOK(IXDIV_FE, LFV_CAL(1), LFV_CAL(1), 1, 'VCAL', 0, & 0, BLEN, 9, -1) ! mother bank IQF(LFV_CAL(1)+1) = VMUL ! preset C WRITE ( LOUT,1234 ) LFV_CAL(1) C1234 FORMAT ( ' VER_DIGI: LFV_CAL=(1)',I20 ) ENDIF C C WRITE ( LOUT,* ) ' VER_DIGI begin: VMUL,IQF(LFV_CAL(1))=', C x VMUL,IQF(LFV_CAL(1)) c c---------------------------------------------------------------------------- c Check silicon strip detectors c---------------------------------------------------------------------------- c DO I=1,NUM_TYPE CUDET=LIST_OF_NAMES(I) ILAYER = LIST_OF_LAYERS(I) CALL VER_HITS ( ILAYER,CUDET,VMUL ) END DO c C------------------------------------------------------------------------------ c Check silicon pad detectors c---------------------------------------------------------------------------- c CUDET='VPAD' ! namesv variable in VER subroutine CALL VER_HITS ( 4,CUDET,VMUL ) C C------------------------------------------------------------------------------ C C Reduce the size of the output bank -- eliminating unused space at the C end C C WRITE ( LOUT,* ) ' VER_DIGI: VMUL=',VMUL IF(CVOLU_OPT(4,1).EQ.'VMAP') THEN ! simulate mapped ADC/TDC data INCND = (VMUL - MFV_ALLDETS)*MFV_MAP c WRITE ( LOUT,* ) ' MFV_MAP,INCND=',MFV_MAP,INCND c WRITE ( LOUT,* ) ' LFV_MAP(1)=',LFV_MAP(1) CALL MZPUSH(IXDIV_FE,LFV_MAP(1),0,INCND,'I') ELSEIF(CVOLU_OPT(4,1).EQ.'VCAL') THEN ! simulate mapped calibrated data INCND = (VMUL - MFV_ALLDETS)*MFV_CAL c WRITE ( LOUT,* ) ' MFV_CAL,INCND=',MFV_CAL,INCND c WRITE ( LOUT,* ) ' LFV_CAL(1)=',LFV_CAL(1) CALL MZPUSH(IXDIV_FE,LFV_CAL(1),0,INCND,'I') ENDIF C IF ( .NOT.END_EVTFLG) RETURN 9999 RETURN END